KIDS Distribution saved on Sep 09, 2013@14:28:28 Version 3.0 Patch 133 - VistARad Maintenance - 09/09/2013 02:28PM **KIDS**:MAG*3.0*133^ **INSTALL NAME** MAG*3.0*133 "BLD",3463,0) MAG*3.0*133^IMAGING^0^3130909^y "BLD",3463,1,0) ^^12^12^3130909 "BLD",3463,1,1,0) Version 3.0 Patch 133 - VistARad Maintenance "BLD",3463,1,2,0) "BLD",3463,1,3,0) "BLD",3463,1,4,0) Routines: "BLD",3463,1,5,0) MAGJEX1 new value = 73078692 "BLD",3463,1,6,0) MAGJMN1 new value = 98640707 "BLD",3463,1,7,0) MAGJRPT new value = 103626332 "BLD",3463,1,8,0) MAGJTU4V new value = 5405270 "BLD",3463,1,9,0) MAGJUPD1 new value = 64000428 "BLD",3463,1,10,0) MAGJUTL1 new value = 71279028 "BLD",3463,1,11,0) MAGJUTL3 new value = 139481284 "BLD",3463,1,12,0) MAGJUTL5 new value = 38140374 "BLD",3463,4,0) ^9.64PA^^0 "BLD",3463,6.3) V3.0p133Build5393_T3 "BLD",3463,"ABNS",0) ^9.66A^^ "BLD",3463,"ABPKG") n^n^G.IMAGING DEVELOPMENT TEAM@DOMAIN.EXT "BLD",3463,"INID") n^n^n "BLD",3463,"INIT") POSTINST^MAGJMN1 "BLD",3463,"KRN",0) ^9.67PA^8994^19 "BLD",3463,"KRN",.4,0) .4 "BLD",3463,"KRN",.401,0) .401 "BLD",3463,"KRN",.402,0) .402 "BLD",3463,"KRN",.403,0) .403 "BLD",3463,"KRN",.5,0) .5 "BLD",3463,"KRN",.84,0) .84 "BLD",3463,"KRN",3.6,0) 3.6 "BLD",3463,"KRN",3.8,0) 3.8 "BLD",3463,"KRN",9.2,0) 9.2 "BLD",3463,"KRN",9.8,0) 9.8 "BLD",3463,"KRN",9.8,"NM",0) ^9.68A^8^8 "BLD",3463,"KRN",9.8,"NM",1,0) MAGJEX1^^0^B73078692 "BLD",3463,"KRN",9.8,"NM",2,0) MAGJMN1^^0^B98640707 "BLD",3463,"KRN",9.8,"NM",3,0) MAGJRPT^^0^B103626332 "BLD",3463,"KRN",9.8,"NM",4,0) MAGJTU4V^^0^B5405270 "BLD",3463,"KRN",9.8,"NM",5,0) MAGJUPD1^^0^B64000428 "BLD",3463,"KRN",9.8,"NM",6,0) MAGJUTL1^^0^B71279028 "BLD",3463,"KRN",9.8,"NM",7,0) MAGJUTL3^^0^B139481284 "BLD",3463,"KRN",9.8,"NM",8,0) MAGJUTL5^^0^B38140374 "BLD",3463,"KRN",9.8,"NM","B","MAGJEX1",1) "BLD",3463,"KRN",9.8,"NM","B","MAGJMN1",2) "BLD",3463,"KRN",9.8,"NM","B","MAGJRPT",3) "BLD",3463,"KRN",9.8,"NM","B","MAGJTU4V",4) "BLD",3463,"KRN",9.8,"NM","B","MAGJUPD1",5) "BLD",3463,"KRN",9.8,"NM","B","MAGJUTL1",6) "BLD",3463,"KRN",9.8,"NM","B","MAGJUTL3",7) "BLD",3463,"KRN",9.8,"NM","B","MAGJUTL5",8) "BLD",3463,"KRN",19,0) 19 "BLD",3463,"KRN",19.1,0) 19.1 "BLD",3463,"KRN",101,0) 101 "BLD",3463,"KRN",409.61,0) 409.61 "BLD",3463,"KRN",771,0) 771 "BLD",3463,"KRN",870,0) 870 "BLD",3463,"KRN",8989.51,0) 8989.51 "BLD",3463,"KRN",8989.52,0) 8989.52 "BLD",3463,"KRN",8994,0) 8994 "BLD",3463,"KRN","B",.4,.4) "BLD",3463,"KRN","B",.401,.401) "BLD",3463,"KRN","B",.402,.402) "BLD",3463,"KRN","B",.403,.403) "BLD",3463,"KRN","B",.5,.5) "BLD",3463,"KRN","B",.84,.84) "BLD",3463,"KRN","B",3.6,3.6) "BLD",3463,"KRN","B",3.8,3.8) "BLD",3463,"KRN","B",9.2,9.2) "BLD",3463,"KRN","B",9.8,9.8) "BLD",3463,"KRN","B",19,19) "BLD",3463,"KRN","B",19.1,19.1) "BLD",3463,"KRN","B",101,101) "BLD",3463,"KRN","B",409.61,409.61) "BLD",3463,"KRN","B",771,771) "BLD",3463,"KRN","B",870,870) "BLD",3463,"KRN","B",8989.51,8989.51) "BLD",3463,"KRN","B",8989.52,8989.52) "BLD",3463,"KRN","B",8994,8994) "BLD",3463,"PRE") MAGJMN1 "BLD",3463,"REQB",0) ^9.611^1^1 "BLD",3463,"REQB",1,0) MAG*3.0*120^2 "BLD",3463,"REQB","B","MAG*3.0*120",1) "INIT") POSTINST^MAGJMN1 "MBREQ") 0 "PKG",454,-1) 1^1 "PKG",454,0) IMAGING^MAG^Imaging Release History "PKG",454,22,0) ^9.49I^1^1 "PKG",454,22,1,0) 3.0^3020328^3020328^.5 "PKG",454,22,1,"PAH",1,0) 133^3130909^.5 "PKG",454,22,1,"PAH",1,1,0) ^9.49011^11^11^3130909 "PKG",454,22,1,"PAH",1,1,1,0) Routines for Patch 133, Test Build 3. "PKG",454,22,1,"PAH",1,1,2,0) "PKG",454,22,1,"PAH",1,1,3,0) Routines: "PKG",454,22,1,"PAH",1,1,4,0) MAGJEX1 value = 73078692 "PKG",454,22,1,"PAH",1,1,5,0) MAGJMN1 value = 98640707 "PKG",454,22,1,"PAH",1,1,6,0) MAGJRPT value = 103626332 "PKG",454,22,1,"PAH",1,1,7,0) MAGJTU4V value = 5405270 "PKG",454,22,1,"PAH",1,1,8,0) MAGJUPD1 value = 64000428 "PKG",454,22,1,"PAH",1,1,9,0) MAGJUTL1 value = 71279028 "PKG",454,22,1,"PAH",1,1,10,0) MAGJUTL3 value = 139481284 "PKG",454,22,1,"PAH",1,1,11,0) MAGJUTL5 value = 38140374 "PRE") MAGJMN1 "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 8 "RTN","MAGJEX1") 0^1^B73078692 "RTN","MAGJEX1",1,0) MAGJEX1 ;WIRMFO/JHC - VistARad RPC calls ; 25 Mar 2013 5:22 PM "RTN","MAGJEX1",2,0) ;;3.0;IMAGING;**16,22,18,65,101,115,104,120,133**;Mar 19, 2002;Build 5393;Sep 09, 2013 "RTN","MAGJEX1",3,0) ;; Per VHA Directive 2004-038, this routine should not be modified. "RTN","MAGJEX1",4,0) ;; +---------------------------------------------------------------+ "RTN","MAGJEX1",5,0) ;; | Property of the US Government. | "RTN","MAGJEX1",6,0) ;; | No permission to copy or redistribute this software is given. | "RTN","MAGJEX1",7,0) ;; | Use of unreleased versions of this software requires the user | "RTN","MAGJEX1",8,0) ;; | to execute a written test agreement with the VistA Imaging | "RTN","MAGJEX1",9,0) ;; | Development Office of the Department of Veterans Affairs, | "RTN","MAGJEX1",10,0) ;; | telephone (301) 734-0100. | "RTN","MAGJEX1",11,0) ;; | The Food and Drug Administration classifies this software as | "RTN","MAGJEX1",12,0) ;; | a medical device. As such, it may not be changed in any way. | "RTN","MAGJEX1",13,0) ;; | Modifications to this software may result in an adulterated | "RTN","MAGJEX1",14,0) ;; | medical device under 21CFR820, the use of which is considered | "RTN","MAGJEX1",15,0) ;; | to be a violation of US Federal Statutes. | "RTN","MAGJEX1",16,0) ;; +---------------------------------------------------------------+ "RTN","MAGJEX1",17,0) ;; "RTN","MAGJEX1",18,0) Q "RTN","MAGJEX1",19,0) ; "RTN","MAGJEX1",20,0) ; "RTN","MAGJEX1",21,0) ERR N ERR S ERR=$$EC^%ZOSV S @MAGGRY@(0)="0^4~"_ERR "RTN","MAGJEX1",22,0) D @^%ZOSF("ERRTN") "RTN","MAGJEX1",23,0) Q:$Q 1 Q "RTN","MAGJEX1",24,0) ; "RTN","MAGJEX1",25,0) ;***** Open an exam. "RTN","MAGJEX1",26,0) ; RPC: MAGJ RADCASEIMAGES "RTN","MAGJEX1",27,0) ; "RTN","MAGJEX1",28,0) OPENCASE(MAGGRY,DATA) ; "RTN","MAGJEX1",29,0) ; MAGGRY holds $NA reference to ^TMP for rpc return "RTN","MAGJEX1",30,0) ; all ref's to MAGGRY use subscript indirection "RTN","MAGJEX1",31,0) ; input in DATA: "RTN","MAGJEX1",32,0) ; OPEN_FLAG ^ RADFN^RADTI^RACNI^RARPT ^ PSINDGET ^ ^ USETGA "RTN","MAGJEX1",33,0) ; OPEN_FLAG = 0: Open, view only "RTN","MAGJEX1",34,0) ; 1: Open, lock the case for status update "RTN","MAGJEX1",35,0) ; 2: Open, Reserve for Interpretation "RTN","MAGJEX1",36,0) ; VIX: Fetching metadata only; Jukebox retrieval occurs (P115 & earlier) "RTN","MAGJEX1",37,0) ; VIX-Metadata: Fetching metadata only; no JB Retrieval (P104,ff) "RTN","MAGJEX1",38,0) ; VIX-Open: Fetching metadata with JB Retrieval (P104,ff) "RTN","MAGJEX1",39,0) ; RADFN^RADTI^RACNI^RARPT = Exam ID string, specifies case of interest "RTN","MAGJEX1",40,0) ; PSINDGET= Presentation State indicators of interest to client "RTN","MAGJEX1",41,0) ; K/I/U for Key Image/ Interpretation/ User PS types "RTN","MAGJEX1",42,0) ; USETGA = 1: Open TGA (downsampled) file; 0: Open BIG file "RTN","MAGJEX1",43,0) ; "RTN","MAGJEX1",44,0) ; Details of Reply message are below tag OPENCASZ "RTN","MAGJEX1",45,0) ; "RTN","MAGJEX1",46,0) N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJEX1" "RTN","MAGJEX1",47,0) N RARPT,RADFN,RADTI,RACNI,RADIV "RTN","MAGJEX1",48,0) N DAYCASE,CURCASE,REPLY,CT,MAGS,STARTNOD,LOCKED,DATAOUT,RADATA,RIST,MDL "RTN","MAGJEX1",49,0) N IMAG,MAGXX,MAGFILE,MAGFILE1,MAGFILE2,MAGFILE3,MAGLST,MAGOBJT,MODALITY "RTN","MAGJEX1",50,0) N MAGSTRT,MAGEND,CURPATHS "RTN","MAGJEX1",51,0) N MIXEDUP,VIEWOK,USETGA,USELORES,IMGST,REMOTE,DIQUIET "RTN","MAGJEX1",52,0) N LOGDATA,MODIF,EXCAT,RADATA2,PSIND,RACPT,RASTCAT,RASTORD,ACQSITE,ALTPATH,PROCDT "RTN","MAGJEX1",53,0) N YNMAMMO,YNREVANN,PSINDGET,JBDISABLE,STANUM "RTN","MAGJEX1",54,0) S DIQUIET=1 D DT^DICRW "RTN","MAGJEX1",55,0) S (CT,MIXEDUP)=0,MODALITY="",DATAOUT="",DAYCASE="",MAGLST="MAGJOPENCASE",(ACQSITE,ALTPATH,PROCDT,STANUM)="" "RTN","MAGJEX1",56,0) S VIEWOK=1 "RTN","MAGJEX1",57,0) K MAGGRY S MAGGRY=$NA(^TMP($J,MAGLST)),STARTNOD=0 K @MAGGRY ; assign MAGGRY value "RTN","MAGJEX1",58,0) S CURCASE=$P(DATA,U),RARPT=+$P(DATA,U,5),PSINDGET=+$P(DATA,U,6) "RTN","MAGJEX1",59,0) S PSIND="" I PSINDGET]"" F I="K","I","U" I $F(PSINDGET,I) S PSIND(I)="" "RTN","MAGJEX1",60,0) S USETGA=+$P(DATA,U,8) "RTN","MAGJEX1",61,0) S RADFN=$P(DATA,U,2),RADTI=$P(DATA,U,3),RACNI=$P(DATA,U,4) "RTN","MAGJEX1",62,0) I RADFN,RADTI,RACNI D GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,"",.X) "RTN","MAGJEX1",63,0) I 'X S REPLY="4~Request Contains Invalid Case Pointer ("_RADFN_U_RADTI_U_RACNI_U_RARPT_")." G OPENCASZ "RTN","MAGJEX1",64,0) S RADATA=$G(^TMP($J,"MAGRAEX",1,1)),RADATA2=$G(^(2)) "RTN","MAGJEX1",65,0) K ^TMP($J,"MAGRAEX") "RTN","MAGJEX1",66,0) S RADIV=$P(RADATA2,U,5),MODIF=$P(RADATA2,U,8),RASTCAT=$P(RADATA2,U,11),RASTORD=$P(RADATA,U,15) "RTN","MAGJEX1",67,0) S RARPT=+$P(RADATA,U,10),DAYCASE=$P(RADATA,U,12),RACPT=$P(RADATA,U,17) "RTN","MAGJEX1",68,0) I 'RARPT!'$D(^RARPT(RARPT,2005)) S REPLY="4~This exam has no report entry for associating images; no images can be accessed." G OPENCASZ "RTN","MAGJEX1",69,0) D CKINTEG^MAGJRPT(.X,RADFN,RADTI,RACNI,RARPT,RADATA) "RTN","MAGJEX1",70,0) I X]"" S MIXEDUP=1,MIXEDUP("REPLY")=X ; DB corruption "RTN","MAGJEX1",71,0) S REPLY="4~Attempting to open/display case #"_DAYCASE "RTN","MAGJEX1",72,0) S JBDISABLE=0 "RTN","MAGJEX1",73,0) I CURCASE="VIX-Metadata" S JBDISABLE=1 ; metadata only, do not trigger JB fetches "RTN","MAGJEX1",74,0) ; "RTN","MAGJEX1",75,0) ; Note in several reply messages below the use of "2~" "RTN","MAGJEX1",76,0) ; This value triggers specific behaviors in vrad client and VIX "RTN","MAGJEX1",77,0) ; -- client displays an Information message box "RTN","MAGJEX1",78,0) ; -- VIX 'tags' the exam to refresh the file list metadata from the source "RTN","MAGJEX1",79,0) ; on any subsequent access for this exam "RTN","MAGJEX1",80,0) ; These respective behaviours are mutually appropriate for both parts of "RTN","MAGJEX1",81,0) ; the system for all the messages involved; avoid using "2~" unless the "RTN","MAGJEX1",82,0) ; same functionality applies for any given new functionality "RTN","MAGJEX1",83,0) ; "RTN","MAGJEX1",84,0) S IMGST=$$JBFETCH^MAGJUTL2(RARPT,.MAGS,USETGA,JBDISABLE) ; open only if NOT on JB "RTN","MAGJEX1",85,0) I +IMGST D G OPENCASZ ; some images are on JB "RTN","MAGJEX1",86,0) . I $D(MAGS("OFFLN")) N T,TT S T="",TT="" D "RTN","MAGJEX1",87,0) . . F S T=$O(MAGS("OFFLN",T)) Q:T="" S TT=TT_$S(TT="":"",1:", ")_T "RTN","MAGJEX1",88,0) . . S REPLY="2~Case #"_DAYCASE_"--Images for this exam are stored OFF-LINE. To view these images, contact your Imaging Coordinator, and request mounting of the following platters: "_TT "RTN","MAGJEX1",89,0) . E I JBDISABLE S REPLY="2~Case #"_DAYCASE_"--"_+IMGST_" Images are on Jukebox." "RTN","MAGJEX1",90,0) . E S REPLY="2~Case #"_DAYCASE_"--"_+IMGST_" Images have been requested from Jukebox; try again later." "RTN","MAGJEX1",91,0) I '$P(IMGST,U,2) S REPLY="2~No Images exist for Case #"_DAYCASE_"." G OPENCASZ "RTN","MAGJEX1",92,0) S USELORES=+$P(IMGST,U,3)_U_$P(IMGST,U,2) "RTN","MAGJEX1",93,0) S MAGSTRT=1,MAGEND=MAGS D IMGLOOP^MAGJEX1B "RTN","MAGJEX1",94,0) ; "RTN","MAGJEX1",95,0) I ACQSITE="" S ACQSITE=RADIV "RTN","MAGJEX1",96,0) ; "RTN","MAGJEX1",97,0) ; Conditionally support revising an unlocked exam's annotations as a function "RTN","MAGJEX1",98,0) ; of exam status and credentials of (current & original) interpreter (P101). "RTN","MAGJEX1",99,0) S YNREVANN=$$ZRUREVAN^MAGJUTL4(RADFN,RADTI,RACNI) "RTN","MAGJEX1",100,0) ; "RTN","MAGJEX1",101,0) ; Return flag to allow display of disclaimer text if ExamType="Mammogram". "RTN","MAGJEX1",102,0) ; Note the VRad client may override based on image metadata (P101). "RTN","MAGJEX1",103,0) S YNMAMMO=$$ZRUMAMMO^MAGJUTL4(RACPT) "RTN","MAGJEX1",104,0) ; "RTN","MAGJEX1",105,0) ; "RTN","MAGJEX1",106,0) S REPLY="0~Images for Case #"_DAYCASE "RTN","MAGJEX1",107,0) ; "RTN","MAGJEX1",108,0) OPENCASZ I 'CT,(REPLY["Attempting") S REPLY="4~Unable to retrieve images for Case #"_DAYCASE_"." "RTN","MAGJEX1",109,0) ; "RTN","MAGJEX1",110,0) ; Contents of successful reply = 4 pipe-delimited ("|") pieces: "RTN","MAGJEX1",111,0) ; 1: # Image nodes ^ Reply Msg Type ~ Reply Msg display text "RTN","MAGJEX1",112,0) ; 2: RADFN^RADTI^RACNI^RARPT --> Exam ID String "RTN","MAGJEX1",113,0) ; 3: Pt Name ^ CASE # ^ Proc. Name ^ Exam Date ^ Time ^ Modality ^ "RTN","MAGJEX1",114,0) ; SSN ^ ^ LOCKED Status ^ Modifier ^ Exam Status Category "RTN","MAGJEX1",115,0) ; 4: Is Radiologist? ^ Alt_Path Flag ^ Acquisition Site ^ Procedure Date ^ "RTN","MAGJEX1",116,0) ; Revise Annotations? ^ Mammography? ^ Station Number "RTN","MAGJEX1",117,0) ; "RTN","MAGJEX1",118,0) S REMOTE=+MAGJOB("REMOTE") "RTN","MAGJEX1",119,0) S LOCKED=0 "RTN","MAGJEX1",120,0) I MIXEDUP D "RTN","MAGJEX1",121,0) . N IMIX,XDFN,XPTS S VIEWOK=$S($D(MAGJOB("KEYS","MAGJ SEE BAD IMAGES")):1,1:0) "RTN","MAGJEX1",122,0) . I MIXEDUP>1 D "RTN","MAGJEX1",123,0) . . S XPTS="",XDFN=0 F IMIX=0:1 S XDFN=$O(MIXEDUP(XDFN)) Q:'XDFN S XPTS=XPTS_$S(IMIX:" and ",1:" ")_$$PNAM(XDFN) "RTN","MAGJEX1",124,0) . . S XPTS=$S(IMIX=1:" ",1:"s ")_XPTS "RTN","MAGJEX1",125,0) . . S REPLY=(7-VIEWOK)_"~This exam is registered for "_$$PNAM(RADFN)_"; however, it is linked to images for patient"_XPTS_". This is a serious problem--immediately report it to Radiology management and Imaging support staff!" "RTN","MAGJEX1",126,0) . E S REPLY=(7-VIEWOK)_"~"_MIXEDUP("REPLY") "RTN","MAGJEX1",127,0) . I CURCASE S REPLY=REPLY_" The exam is NOT Locked." S CURCASE=0 "RTN","MAGJEX1",128,0) I CT D "RTN","MAGJEX1",129,0) . S RIST=$S(+MAGJOB("USER",1):1,1:0),EXCAT="" "RTN","MAGJEX1",130,0) . S LOGDATA=RADFN_U_+$P(MAGS(1),U,4)_U_+MAGS_U_REMOTE ; for Img Access log "RTN","MAGJEX1",131,0) . I CURCASE D "RTN","MAGJEX1",132,0) . . I $G(MAGJOB("CONSOLIDATED")),'$D(MAGJOB("DIVSCRN",RADIV)) D S CURCASE=0 Q "RTN","MAGJEX1",133,0) . . . S REPLY="5~Exam is for Station #"_$$STATN(RADIV)_"; you are logged on to #"_$$STATN(DUZ(2))_". Exam is NOT Locked." "RTN","MAGJEX1",134,0) . . S XX=$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,3) "RTN","MAGJEX1",135,0) . . I '$D(^RA(72,"AVC","E",XX)) D S CURCASE=0 Q "RTN","MAGJEX1",136,0) . . . D LOCKACT^MAGJEX1A(RARPT,DAYCASE,100,.RESULT) ; between reserve and now, exam may have been Taken & Updated "RTN","MAGJEX1",137,0) . . . I +RESULT(1)!+RESULT(2) D LOCKACT^MAGJEX1A(RARPT,DAYCASE,101,.RESULT) ; so, cancel any lock/reserve "RTN","MAGJEX1",138,0) . . . S REPLY="5~For Case #"_DAYCASE_", current Status is "_$P(^RA(72,XX,0),U)_"; Lock or Reserve NOT allowed." "RTN","MAGJEX1",139,0) . . E S EXCAT="E" "RTN","MAGJEX1",140,0) . . I RIST,'USELORES D ; lock only for Current Case, Radiologist, & Full Res images "RTN","MAGJEX1",141,0) . . . ; save data needed to later log Interpreted event "RTN","MAGJEX1",142,0) . . . D LOCKACT^MAGJEX1A(RARPT,DAYCASE,CURCASE,.RESULT,.REPLY,LOGDATA) "RTN","MAGJEX1",143,0) . . . S LOCKED=$S(+RESULT:1,+$P(RESULT,U,2):2,1:0) "RTN","MAGJEX1",144,0) . I EXCAT="" D "RTN","MAGJEX1",145,0) . . I RASTORD=9 S EXCAT="C" Q ; Complete "RTN","MAGJEX1",146,0) . . E S EXCAT=RASTCAT "RTN","MAGJEX1",147,0) . . I EXCAT="D"!(EXCAT="T") S EXCAT="I" ; just display one value meaning Interpreted "RTN","MAGJEX1",148,0) . S DATAOUT=$P(RADATA,U,4)_U_DAYCASE_U_$P(RADATA,U,9) "RTN","MAGJEX1",149,0) . S X=$P(RADATA,U,6),T=$L(X," "),X=$P(X," ",1,T-1)_U_$P(X," ",T) "RTN","MAGJEX1",150,0) . S DATAOUT=DATAOUT_U_X "RTN","MAGJEX1",151,0) . S DATAOUT=DATAOUT_U_MODALITY_U_$P(RADATA,U,5)_U_U_LOCKED "RTN","MAGJEX1",152,0) . S DATAOUT=DATAOUT_U_MODIF_U_EXCAT_U_"|"_RIST_U_ALTPATH_U_ACQSITE_U_PROCDT_U_YNREVANN_U_YNMAMMO_U_STANUM "RTN","MAGJEX1",153,0) . I USELORES D "RTN","MAGJEX1",154,0) . . I +USELORES=+$P(USELORES,U,2) S X="All" "RTN","MAGJEX1",155,0) . . E S X=+USELORES_" of "_+$P(USELORES,U,2) "RTN","MAGJEX1",156,0) . . I $E(REPLY,1,8)="0~Images" S REPLY="3~" "RTN","MAGJEX1",157,0) . . E S REPLY=REPLY_" -- " "RTN","MAGJEX1",158,0) . . S REPLY=REPLY_"Note: "_X_" images for Case #"_DAYCASE_" are REDUCED RESOLUTION images, using parameters set by your site Imaging Manager; to view full-resolution images, disable the Reduced Resolution option setting. Exam NOT Locked." "RTN","MAGJEX1",159,0) S @MAGGRY@(STARTNOD)=CT_U_REPLY_"|"_RADFN_U_RADTI_U_RACNI_U_RARPT_"|"_DATAOUT "RTN","MAGJEX1",160,0) ; if mixedup & not have keys to see images, delete image refs "RTN","MAGJEX1",161,0) ; & send only reply msg "RTN","MAGJEX1",162,0) I MIXEDUP,('VIEWOK) S CT=0 K @MAGGRY S @MAGGRY@(0)=CT_U_REPLY "RTN","MAGJEX1",163,0) E S $P(@MAGGRY@(0),U)=CT+STARTNOD "RTN","MAGJEX1",164,0) I CT,(LOCKED'=2),(CURCASE'["VIX") D LOG^MAGJUTL3("VR-VW",LOGDATA,$$PSETLST(RADFN,RADTI,RACNI)) ; Image access log "RTN","MAGJEX1",165,0) Q "RTN","MAGJEX1",166,0) ; "RTN","MAGJEX1",167,0) PSETLST(RADFN,RADTI,RACNI) ; Return list of Printset Case #'s for exam "RTN","MAGJEX1",168,0) N I,MAGPSET,PSETLST,RAPRTSET,X "RTN","MAGJEX1",169,0) S PSETLST="" ; initialize return value "RTN","MAGJEX1",170,0) I +$G(RADFN),+$G(RADTI),+$G(RACNI) D "RTN","MAGJEX1",171,0) . D EN2^RAUTL20(.MAGPSET) "RTN","MAGJEX1",172,0) . Q:'RAPRTSET ; variable set by above call; stop if not a printset "RTN","MAGJEX1",173,0) . S X="" "RTN","MAGJEX1",174,0) . F I=0:1 S X=$O(MAGPSET(X)) Q:'X S PSETLST=PSETLST_$S(I:U,1:"")_$P(MAGPSET(X),U) "RTN","MAGJEX1",175,0) Q:$Q PSETLST Q "RTN","MAGJEX1",176,0) ; "RTN","MAGJEX1",177,0) PNAM(X) ; return pt name for input DFN "RTN","MAGJEX1",178,0) I X S X=$G(^DPT(+X,0)) I X]"" S X=$P(X,U) "RTN","MAGJEX1",179,0) E S X="UNKNOWN" "RTN","MAGJEX1",180,0) Q X "RTN","MAGJEX1",181,0) ; "RTN","MAGJEX1",182,0) STATN(X) ; get station #, else return input value "RTN","MAGJEX1",183,0) N T "RTN","MAGJEX1",184,0) I X]"" D GETS^DIQ(4,X,99,"","T") S T=$G(T(4,X_",",99,"E")) I T]"" S X=T "RTN","MAGJEX1",185,0) Q X "RTN","MAGJEX1",186,0) ; "RTN","MAGJEX1",187,0) END Q ; "RTN","MAGJEX1",188,0) ; "RTN","MAGJMN1") 0^2^B98640707 "RTN","MAGJMN1",1,0) MAGJMN1 ;WIRMFO/JHC - VRad Maint functions ; 3 May 2013 12:14 PM "RTN","MAGJMN1",2,0) ;;3.0;IMAGING;**16,9,22,18,65,76,101,90,115,120,133**;Mar 19, 2002;Build 5393;Sep 09, 2013 "RTN","MAGJMN1",3,0) ;; Per VHA Directive 2004-038, this routine should not be modified. "RTN","MAGJMN1",4,0) ;; +---------------------------------------------------------------+ "RTN","MAGJMN1",5,0) ;; | Property of the US Government. | "RTN","MAGJMN1",6,0) ;; | No permission to copy or redistribute this software is given. | "RTN","MAGJMN1",7,0) ;; | Use of unreleased versions of this software requires the user | "RTN","MAGJMN1",8,0) ;; | to execute a written test agreement with the VistA Imaging | "RTN","MAGJMN1",9,0) ;; | Development Office of the Department of Veterans Affairs, | "RTN","MAGJMN1",10,0) ;; | telephone (301) 734-0100. | "RTN","MAGJMN1",11,0) ;; | The Food and Drug Administration classifies this software as | "RTN","MAGJMN1",12,0) ;; | a medical device. As such, it may not be changed in any way. | "RTN","MAGJMN1",13,0) ;; | Modifications to this software may result in an adulterated | "RTN","MAGJMN1",14,0) ;; | medical device under 21CFR820, the use of which is considered | "RTN","MAGJMN1",15,0) ;; | to be a violation of US Federal Statutes. | "RTN","MAGJMN1",16,0) ;; +---------------------------------------------------------------+ "RTN","MAGJMN1",17,0) ;; "RTN","MAGJMN1",18,0) ENVCHK ; "Environment Check" for KIDS Install "RTN","MAGJMN1",19,0) I 'XPDENV Q ; Proceed only if in Install phase "RTN","MAGJMN1",20,0) N MAGJKIDS S MAGJKIDS=1 "RTN","MAGJMN1",21,0) D BGCSTOP "RTN","MAGJMN1",22,0) Q "RTN","MAGJMN1",23,0) ; "RTN","MAGJMN1",24,0) SVRLIST ; "RTN","MAGJMN1",25,0) W @IOF,!!?10,"Enter/Edit VistARad Exams List Definition",!! "RTN","MAGJMN1",26,0) N MAGIEN "RTN","MAGJMN1",27,0) K DIC S (DIC,DLAYGO)=2006.631,DIC(0)="ALMEQ" "RTN","MAGJMN1",28,0) D ^DIC I Y=-1 K DIC,DA,DR,DIE,DLAYGO Q "RTN","MAGJMN1",29,0) S X=$P(@(DIC_+Y_",0)"),U,2) "RTN","MAGJMN1",30,0) I X>9000 W !!,$C(7),"You may not edit System-Supplied files!" H 3 G SVRLIST "RTN","MAGJMN1",31,0) S DIE=2006.631,DA=+Y,DR="[MAGJ LIST EDIT]" "RTN","MAGJMN1",32,0) S MAGIEN=DA "RTN","MAGJMN1",33,0) D ^DIE I '$D(DA) G SVRLIST "RTN","MAGJMN1",34,0) D ENSRCH "RTN","MAGJMN1",35,0) D BLDDEF(MAGIEN) "RTN","MAGJMN1",36,0) S $P(^MAG(2006.631,MAGIEN,0),U,5)=$$NOW^XLFDT() "RTN","MAGJMN1",37,0) W !!,"List Definition complete!" R X:2 "RTN","MAGJMN1",38,0) G SVRLIST "RTN","MAGJMN1",39,0) Q "RTN","MAGJMN1",40,0) ENSRCH ; Invoke Search for 2006.631 def'n "RTN","MAGJMN1",41,0) N GREF,GLIN,GO,CT,DIARI,DIC,FNOD,TNOD,NCOND,NODE0 "RTN","MAGJMN1",42,0) ; GREF holds indirect ref to store search logic data: "RTN","MAGJMN1",43,0) ; @GREF@(3, ff -- conditional elements (fields/logic) "RTN","MAGJMN1",44,0) ; @GREF@(4, ff -- composite elements (ANDed conditions) "RTN","MAGJMN1",45,0) ; @GREF@(5, ff -- Human-readable search text "RTN","MAGJMN1",46,0) ; GLIN holds indirect ref to retrieve search logic data from ^DIBT "RTN","MAGJMN1",47,0) ; @GLIN@("DC", ff -- conditional elements "RTN","MAGJMN1",48,0) ; @GLIN@("DL", ff -- composite elements "RTN","MAGJMN1",49,0) ; @GLIN@("O", ff -- readable text "RTN","MAGJMN1",50,0) S GREF=$NA(^MAG(2006.631,MAGIEN,"DEF")) "RTN","MAGJMN1",51,0) S GO=1 I $D(@GREF@(5,1)) D ; show current logic "RTN","MAGJMN1",52,0) . W ! D DISPSRCH(GREF) "RTN","MAGJMN1",53,0) . S X=$$YN("Do you want to delete or re-enter the search logic?","NO") "RTN","MAGJMN1",54,0) . I X'="Y" S GO=0 Q "RTN","MAGJMN1",55,0) . W !!?7,"Re-entering the search logic requires first deleting the current",!?7,"definition, then entering the new definition from scratch." "RTN","MAGJMN1",56,0) . S X=$$YN("Are you sure you want to continue?","NO") "RTN","MAGJMN1",57,0) . I X'="Y" S GO=0 Q "RTN","MAGJMN1",58,0) I 'GO Q "RTN","MAGJMN1",59,0) W !!?7,"Now enter search logic for this List. To do this, the program" "RTN","MAGJMN1",60,0) W !?7,"will prompt you just as if you were going to run a Fileman Search." "RTN","MAGJMN1",61,0) W !?7,"When prompted STORE RESULTS OF SEARCH IN TEMPLATE:, answer with 'TEMP'" "RTN","MAGJMN1",62,0) W !?7,"If prompted ... OK TO PURGE? NO// answer 'YES'; don't bother specifying" "RTN","MAGJMN1",63,0) W !?7,"output print fields, but just RETURN through all the prompts to" "RTN","MAGJMN1",64,0) W !?7,"complete the process. The search definition will be saved as part" "RTN","MAGJMN1",65,0) W !?7,"of this List definition; you will test it out by running it from " "RTN","MAGJMN1",66,0) W !?7,"the workstation. If you need to modify the search logic, you will" "RTN","MAGJMN1",67,0) W !?7,"have to re-enter it in its entirety." "RTN","MAGJMN1",68,0) W !!?7,"NOTES: EXAM LOCK INDICATOR will not work for search logic;" "RTN","MAGJMN1",69,0) W !?14,"REMOTE CACHE INDICATOR only works for Null/Not Null logic." "RTN","MAGJMN1",70,0) S DIC=2006.634 D EN^DIS ; call Fman Search Logic routine. It will store search logic in ^DIBT "RTN","MAGJMN1",71,0) ; 2006.634 is intentional--don't change this! "RTN","MAGJMN1",72,0) I '$G(DIARI) W !!," Search logic NOT updated" D Q "RTN","MAGJMN1",73,0) . Q:'$D(@GREF@(5,1)) ; if no logic had existed, quit "RTN","MAGJMN1",74,0) . S X=$$YN("Do you want to DELETE the search logic?","NO") "RTN","MAGJMN1",75,0) . I X="Y" K @GREF@(3) K ^(4),^(5) W " -- Deleted!" "RTN","MAGJMN1",76,0) K @GREF@(3) K ^(4),^(5) "RTN","MAGJMN1",77,0) S GLIN=$NA(^DIBT(DIARI)) ; Copy logic to 2006.631 DEF nodes "RTN","MAGJMN1",78,0) S FNOD="DC",TNOD=3,CT=0 ; "DC" data--straight copy "RTN","MAGJMN1",79,0) S T=0 F S T=$O(@GLIN@(FNOD,T)) Q:T="" S X=^(T),CT=CT+1,@GREF@(TNOD,T)=X "RTN","MAGJMN1",80,0) S @GREF@(TNOD,0)=CT "RTN","MAGJMN1",81,0) S FNOD="DL",TNOD=4,CT=0 ; "DL" data--copy depends on storage scheme in DIBT: "RTN","MAGJMN1",82,0) ;Zero node null -- straight copy "RTN","MAGJMN1",83,0) ; Else 1) either only one condition is defined; "RTN","MAGJMN1",84,0) ; or, 2) the zero-node condition is ANDed with all defined conditions "RTN","MAGJMN1",85,0) ; Case 2: Var A -- Pre-pend zero node, then dup zero node "RTN","MAGJMN1",86,0) ; Var B -- Pre-pend zero node "RTN","MAGJMN1",87,0) S NCOND=+$G(@GLIN@(FNOD)) "RTN","MAGJMN1",88,0) I $G(@GLIN@(FNOD,0))]"" S NODE0=^(0) D "RTN","MAGJMN1",89,0) . S T=0 F S T=$O(@GLIN@(FNOD,T)) Q:T="" S X=^(T) I X]"" S CT=CT+1,@GREF@(TNOD,CT)=NODE0_X "RTN","MAGJMN1",90,0) . I CT'=NCOND S CT=CT+1,@GREF@(TNOD,CT)=NODE0_$S(CT=1:"",1:"^") "RTN","MAGJMN1",91,0) E D "RTN","MAGJMN1",92,0) . S T=0 F S T=$O(@GLIN@(FNOD,T)) Q:T="" S X=^(T) I X]"" S CT=CT+1,@GREF@(TNOD,CT)=X "RTN","MAGJMN1",93,0) S @GREF@(TNOD,0)=CT "RTN","MAGJMN1",94,0) ; readable text--straight copy "RTN","MAGJMN1",95,0) S TNOD=5,T=0 F S T=$O(@GLIN@("O",T)) Q:T="" S @GREF@(TNOD,T)=^(T,0) "RTN","MAGJMN1",96,0) Q "RTN","MAGJMN1",97,0) ; "RTN","MAGJMN1",98,0) BLDDEF(LSTID) ; build DEF nodes for Column/Sort defs "RTN","MAGJMN1",99,0) N X,QX,SS,STR,LSTHDR,T,T0,T8,T6,HASCASE,XT,HASDATE,HASNIMG,HASPRIO,HASLOCK,LISTYPE "RTN","MAGJMN1",100,0) S SS=0,HASCASE=0,HASDATE=0,HASNIMG=0,HASPRIO=0,HASLOCK=0 "RTN","MAGJMN1",101,0) S LISTYPE=$P($G(^MAG(2006.631,LSTID,0)),U,3) "RTN","MAGJMN1",102,0) ; columns/hdrs: Order in T array by the Relative Column Order "RTN","MAGJMN1",103,0) F S SS=$O(^MAG(2006.631,LSTID,1,SS)) D Q:'SS "RTN","MAGJMN1",104,0) . I 'SS D Q "RTN","MAGJMN1",105,0) . . I 'HASCASE S X=1 D BLDDEF2(X) ; Force CASE# "RTN","MAGJMN1",106,0) . . I 'HASDATE S X=7 D BLDDEF2(X) ; DATE/TIME "RTN","MAGJMN1",107,0) . . I 'HASNIMG S X=9 D BLDDEF2(X) ; NUMBER IMAGES "RTN","MAGJMN1",108,0) . . Q:LISTYPE'="U" ; force below only if for an Unread list "RTN","MAGJMN1",109,0) . . I 'HASLOCK S X=2 D BLDDEF2(X) ; EXAM LOCK IND. "RTN","MAGJMN1",110,0) . . I 'HASPRIO S X=5 D BLDDEF2(X) ; PRIORITY "RTN","MAGJMN1",111,0) . E S X=^MAG(2006.631,LSTID,1,SS,0) "RTN","MAGJMN1",112,0) . D BLDDEF2(X) "RTN","MAGJMN1",113,0) ; go thru T to build ordered field sequence for output columns "RTN","MAGJMN1",114,0) S QX="T",STR="",LSTHDR="" "RTN","MAGJMN1",115,0) F S QX=$Q(@QX) Q:QX="" S X=@QX D "RTN","MAGJMN1",116,0) . S STR=STR_$S(STR="":"",1:U)_$P(X,U) "RTN","MAGJMN1",117,0) . S LSTHDR=LSTHDR_$S(LSTHDR="":"",1:U)_$P(X,U,2) "RTN","MAGJMN1",118,0) S ^MAG(2006.631,LSTID,"DEF",.5)=LSTHDR,^(1)=STR "RTN","MAGJMN1",119,0) ; Sort values: "RTN","MAGJMN1",120,0) S SS=0,STR="" "RTN","MAGJMN1",121,0) F S SS=$O(^MAG(2006.631,LSTID,2,SS)) Q:'SS S X=^(SS,0) D "RTN","MAGJMN1",122,0) . S X=+X_$S($P(X,U,2):"-",1:"") "RTN","MAGJMN1",123,0) . S STR=STR_$S(STR="":"",1:U)_X "RTN","MAGJMN1",124,0) S ^MAG(2006.631,LSTID,"DEF",2)=STR "RTN","MAGJMN1",125,0) S $P(^MAG(2006.631,LSTID,"DEF",0),U)=$$NOW^XLFDT() "RTN","MAGJMN1",126,0) Q "RTN","MAGJMN1",127,0) ; "RTN","MAGJMN1",128,0) BLDDEF2(X) ; "RTN","MAGJMN1",129,0) S X=+X_$S($P(X,U,2):";"_+$P(X,U,2),1:"") "RTN","MAGJMN1",130,0) I 'HASCASE S HASCASE=(+X=1) "RTN","MAGJMN1",131,0) I 'HASDATE S HASDATE=(+X=7) "RTN","MAGJMN1",132,0) I 'HASNIMG S HASNIMG=(+X=9) "RTN","MAGJMN1",133,0) I 'HASLOCK S HASLOCK=(+X=2) "RTN","MAGJMN1",134,0) I 'HASPRIO S HASPRIO=(+X=5) "RTN","MAGJMN1",135,0) S T0=^MAG(2006.63,+X,0),T6=+$P(T0,U,6) S:'T6 T6=99 "RTN","MAGJMN1",136,0) S T8=$P(T0,U,8) I T8]"" S T8="~"_T8 "RTN","MAGJMN1",137,0) S XT=$S($P(T0,U,3)]"":$P(T0,U,3),1:$P(T0,U,2))_T8 "RTN","MAGJMN1",138,0) S $P(XT,"~",3)=+X "RTN","MAGJMN1",139,0) S T(T6,+X)=X_U_XT "RTN","MAGJMN1",140,0) Q "RTN","MAGJMN1",141,0) ; "RTN","MAGJMN1",142,0) POSTINST ; Patch installation inits, etc. "RTN","MAGJMN1",143,0) ; D BLDALL ; update list definitions <*> Use any time fields are added "RTN","MAGJMN1",144,0) D BGCSTRT ; re-start background compile "RTN","MAGJMN1",145,0) D POST ; install message, etc. "RTN","MAGJMN1",146,0) Q "RTN","MAGJMN1",147,0) ; "RTN","MAGJMN1",148,0) BLDALL ; Create "DEF" nodes, Button labels List Def'ns "RTN","MAGJMN1",149,0) ; Updates all lists after s/w update list defs are installed "RTN","MAGJMN1",150,0) N SS,LSTDAT,LSTNUM,BUTTON,LSTTYP "RTN","MAGJMN1",151,0) S SS=0 "RTN","MAGJMN1",152,0) F S SS=$O(^MAG(2006.631,SS)) Q:'SS S LSTDAT=$G(^(SS,0)) I LSTDAT]"" D "RTN","MAGJMN1",153,0) . S LSTNUM=$P(LSTDAT,U,2),BUTTON=$P(LSTDAT,U,7),LSTTYP=$P(LSTDAT,U,3) "RTN","MAGJMN1",154,0) . I LSTNUM>9900!$P(LSTDAT,U,6) D BLDDEF(SS) ; build DEF nodes for System Lists & any Enabled lists "RTN","MAGJMN1",155,0) . I BUTTON="",(LSTTYP]"") D ; Create Button Labels if needed "RTN","MAGJMN1",156,0) . . S BUTTON=$S(LSTTYP="U":"Unread #",LSTTYP="R":"Recent #",LSTTYP="A":"All Active #",LSTTYP="P":"Pending #",1:"List #")_LSTNUM "RTN","MAGJMN1",157,0) . . S $P(^MAG(2006.631,SS,0),U,7)=BUTTON "RTN","MAGJMN1",158,0) Q "RTN","MAGJMN1",159,0) ; "RTN","MAGJMN1",160,0) POST ; Install msg "RTN","MAGJMN1",161,0) D INS^MAGQBUT4(XPDNM,DUZ,$$NOW^XLFDT,XPDA) "RTN","MAGJMN1",162,0) Q "RTN","MAGJMN1",163,0) ; "RTN","MAGJMN1",164,0) YN(MSG,DFLT) ; get Yes/No reply "RTN","MAGJMN1",165,0) N X I $G(DFLT)="" S DFLT="N" "RTN","MAGJMN1",166,0) W ! "RTN","MAGJMN1",167,0) S DFLT=$E(DFLT),DFLT=$S(DFLT="N":"NO",1:"YES") "RTN","MAGJMN1",168,0) YN1 W !,MSG_" "_DFLT_"// " "RTN","MAGJMN1",169,0) R X:DTIME S:X="" X=DFLT S X=$E(X),X=$TR(X,"ynYN","YNYN") "RTN","MAGJMN1",170,0) I "YN"'[X W " ??? Enter YES or NO",! G YN1 "RTN","MAGJMN1",171,0) Q X "RTN","MAGJMN1",172,0) ; "RTN","MAGJMN1",173,0) LSTINQ ; Inq/Disp list def'n "RTN","MAGJMN1",174,0) N GREF,MAGIEN "RTN","MAGJMN1",175,0) W !!?15,"Display VistARad Exams List Definition",!! "RTN","MAGJMN1",176,0) N MAGIEN "RTN","MAGJMN1",177,0) S DIC=2006.631,DIC(0)="AMEQ" "RTN","MAGJMN1",178,0) D ^DIC I Y=-1 K DIC,DA,DR Q "RTN","MAGJMN1",179,0) K DR S DA=+Y,MAGIEN=DA "RTN","MAGJMN1",180,0) S GREF=$NA(^MAG(2006.631,MAGIEN,"DEF")) "RTN","MAGJMN1",181,0) W ! D EN^DIQ "RTN","MAGJMN1",182,0) R !,"Enter RETURN to display the Search Logic: ",X:DTIME W ! "RTN","MAGJMN1",183,0) D DISPSRCH(GREF) "RTN","MAGJMN1",184,0) G LSTINQ "RTN","MAGJMN1",185,0) Q "RTN","MAGJMN1",186,0) ; "RTN","MAGJMN1",187,0) DISPSRCH(GREF) ; GREF holds indirect ref for global holding search logic data "RTN","MAGJMN1",188,0) I $D(@GREF@(5,1)) W !,"List Exams where:",! D "RTN","MAGJMN1",189,0) . F I=1:1 Q:'$D(@GREF@(5,I)) W !?3,^(I) "RTN","MAGJMN1",190,0) E W !?3,"NO Search Logic defined!" "RTN","MAGJMN1",191,0) Q "RTN","MAGJMN1",192,0) ; "RTN","MAGJMN1",193,0) VRSIT ; "RTN","MAGJMN1",194,0) W @IOF,!!?10,"Enter/Edit VistARad Site Parameters",!! "RTN","MAGJMN1",195,0) S DIC=2006.69,DIC(0)="ALMEQ" "RTN","MAGJMN1",196,0) I '$D(^MAG(DIC,1)) S DLAYGO=DIC "RTN","MAGJMN1",197,0) D ^DIC I Y=-1 K DIC,DA,DR,DIE,DLAYGO Q "RTN","MAGJMN1",198,0) S DIE=2006.69,DA=+Y,DR=".01:20" "RTN","MAGJMN1",199,0) D ^DIE "RTN","MAGJMN1",200,0) K DIC,DA,DR,DIE,DLAYGO "RTN","MAGJMN1",201,0) N PLACE S DA="" "RTN","MAGJMN1",202,0) S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2))) "RTN","MAGJMN1",203,0) S:PLACE DA=PLACE "RTN","MAGJMN1",204,0) I DA D "RTN","MAGJMN1",205,0) . W !!,"Editing VistARad Timeout for division #",DUZ(2),! "RTN","MAGJMN1",206,0) . S DIE=2006.1,DR="123" D ^DIE "RTN","MAGJMN1",207,0) K DA,DR,DIE "RTN","MAGJMN1",208,0) Q "RTN","MAGJMN1",209,0) ; "RTN","MAGJMN1",210,0) ;+++++ OPTION: MAGJ E/E DEFAULT USER PROFILES "RTN","MAGJMN1",211,0) ; "RTN","MAGJMN1",212,0) ; FileMan ^DIE call to enter/edit IMAGING SITE PARAMETERS File (#2006.1), "RTN","MAGJMN1",213,0) ; fields #202: DEFAULT VISTARAD USERPREF RAD and "RTN","MAGJMN1",214,0) ; #203: DEFAULT VISTARAD USERPREF NON. "RTN","MAGJMN1",215,0) ; "RTN","MAGJMN1",216,0) ; These fields point to entries in the MAGJ USER DATA File (#2006.68), and "RTN","MAGJMN1",217,0) ; allow the VistARad client to initialize new VistARad users to the settings "RTN","MAGJMN1",218,0) ; held by the appropriate default user type ("Radiologist", "Non-rad'ist"). "RTN","MAGJMN1",219,0) ; "RTN","MAGJMN1",220,0) EEPRO ; "RTN","MAGJMN1",221,0) ; "RTN","MAGJMN1",222,0) ;--- Get IEN of IMAGING SITE PARAMETERS File. "RTN","MAGJMN1",223,0) N FIELD,SITEPIEN S SITEPIEN=+$$IMGSIT^MAGJUTL1(DUZ(2),1) "RTN","MAGJMN1",224,0) F FIELD=202,203 D "RTN","MAGJMN1",225,0) . ; "RTN","MAGJMN1",226,0) . ;--- Report field being edited. "RTN","MAGJMN1",227,0) . N PROMPT S PROMPT=$S(FIELD=202:"RADIOLOGIST",FIELD=203:"NON-RADIOLOGIST") "RTN","MAGJMN1",228,0) . W !!,"Editing default "_PROMPT_" profile ...",! "RTN","MAGJMN1",229,0) . N DA,DIE,DR "RTN","MAGJMN1",230,0) . S DIE=2006.1,DR=FIELD,DA=SITEPIEN D ^DIE "RTN","MAGJMN1",231,0) . Q "RTN","MAGJMN1",232,0) Q "RTN","MAGJMN1",233,0) EEPREF ; "RTN","MAGJMN1",234,0) W @IOF,!!?10,"Enter/Edit VistARad Prefetch Logic",!! "RTN","MAGJMN1",235,0) N MAGIEN "RTN","MAGJMN1",236,0) K DIC S (DIC,DLAYGO)=2006.65,DIC(0)="ALMEQ" "RTN","MAGJMN1",237,0) D ^DIC I Y=-1 K DIC,DIE,DR,DLAYGO Q "RTN","MAGJMN1",238,0) S DIE=2006.65,DA=+Y,DR="[MAGJ PRIOR EDIT]" "RTN","MAGJMN1",239,0) S MAGIEN=DA "RTN","MAGJMN1",240,0) D ^DIE I '$D(DA) G EEPREF "RTN","MAGJMN1",241,0) G EEPREF "RTN","MAGJMN1",242,0) Q "RTN","MAGJMN1",243,0) INPREF ; Inquire VRad PreFetch "RTN","MAGJMN1",244,0) W @IOF,!!?10,"Inquire VistARad Prefetch Logic",!! "RTN","MAGJMN1",245,0) N MAGIEN,BY,FR,TO "RTN","MAGJMN1",246,0) S DIC=2006.65,DIC(0)="AMEQ" "RTN","MAGJMN1",247,0) D ^DIC I Y=-1 K DIC Q "RTN","MAGJMN1",248,0) S DA=+Y,(FR,TO)=$P(Y,U,2),MAGIEN=DA,L=0 "RTN","MAGJMN1",249,0) S BY="[MAGJ PRIOR SORT]",DIS(0)="I D0=MAGIEN" "RTN","MAGJMN1",250,0) D EN^DIP "RTN","MAGJMN1",251,0) R !,"Enter RETURN to continue: ",X:DTIME W ! "RTN","MAGJMN1",252,0) G INPREF "RTN","MAGJMN1",253,0) Q "RTN","MAGJMN1",254,0) PRPREF ;Print VRad Prefetch "RTN","MAGJMN1",255,0) N BY "RTN","MAGJMN1",256,0) W !! S DIC=2006.65,L=0,BY="[MAGJ PRIOR SORT]" "RTN","MAGJMN1",257,0) D EN1^DIP "RTN","MAGJMN1",258,0) R !,"Enter RETURN to continue: ",X:DTIME W ! "RTN","MAGJMN1",259,0) Q "RTN","MAGJMN1",260,0) ; "RTN","MAGJMN1",261,0) BGCSTOP ; Stop Background Compile program "RTN","MAGJMN1",262,0) N MAGCSTRT,GO,NTRY,RETRY,X "RTN","MAGJMN1",263,0) S MAGCSTRT=0,GO=1 "RTN","MAGJMN1",264,0) S X=$G(^MAG(2006.69,1,0)) "RTN","MAGJMN1",265,0) I X]"",+$P(X,U,8) D ; Background compile switch; skip if already false "RTN","MAGJMN1",266,0) . S ^MAG(2006.69,"BGSTOP")=X ; save current settings for restore later "RTN","MAGJMN1",267,0) . S MAGCSTRT=1 "RTN","MAGJMN1",268,0) . S $P(X,U,8)=0 "RTN","MAGJMN1",269,0) . S ^MAG(2006.69,1,0)=X ; disable compile "RTN","MAGJMN1",270,0) . W !!,*7,"Wait for Background Compile program to stop;" "RTN","MAGJMN1",271,0) . W !," this might take up to a few minutes." "RTN","MAGJMN1",272,0) . S NTRY=60 "RTN","MAGJMN1",273,0) . F I=1:1:NTRY W "." L +^XTMP("MAGJ2","BKGND2","RUN"):3 I Q ; process maintains lock while running "RTN","MAGJMN1",274,0) . I D "RTN","MAGJMN1",275,0) . . L -^XTMP("MAGJ2","BKGND2","RUN") "RTN","MAGJMN1",276,0) . . W !!,"Background Compile Stopped" "RTN","MAGJMN1",277,0) . . I +$G(MAGJKIDS) W "; proceeding with install.",! H 2 "RTN","MAGJMN1",278,0) . E D "RTN","MAGJMN1",279,0) . . S X=$$YN("Background Compile NOT Stopped -- Try again?","Y") "RTN","MAGJMN1",280,0) . . S RETRY=("Y"[X),GO=0 "RTN","MAGJMN1",281,0) . . S ^MAG(2006.69,1,0)=^MAG(2006.69,"BGSTOP") K ^MAG(2006.69,"BGSTOP") "RTN","MAGJMN1",282,0) I 'GO G BGCSTOP:RETRY "RTN","MAGJMN1",283,0) I 'GO,+$G(MAGJKIDS) W !!,*7," * * * Exiting out of patch installation * * * ",! H 3 S XPDQUIT=1 "RTN","MAGJMN1",284,0) Q "RTN","MAGJMN1",285,0) BGCSTRT ; re-enable Background Compile "RTN","MAGJMN1",286,0) I $D(^MAG(2006.69,"BGSTOP")) S X=^("BGSTOP") W " ... Enabling background compile ." "RTN","MAGJMN1",287,0) E Q "RTN","MAGJMN1",288,0) S ^MAG(2006.69,1,0)=X "RTN","MAGJMN1",289,0) K ^MAG(2006.69,"BGSTOP") "RTN","MAGJMN1",290,0) W !!,"Background Compile Enabled.",! H 3 "RTN","MAGJMN1",291,0) Q "RTN","MAGJMN1",292,0) ; "RTN","MAGJMN1",293,0) END ; "RTN","MAGJRPT") 0^3^B103626332 "RTN","MAGJRPT",1,0) MAGJRPT ;WIRMFO/JHC - Display Rad reports ; 3 Jul 2013 10:48 AM "RTN","MAGJRPT",2,0) ;;3.0;IMAGING;**18,101,120,133**;Mar 19, 2002;Build 5393;Sep 09, 2013 "RTN","MAGJRPT",3,0) ;; Per VHA Directive 2004-038, this routine should not be modified. "RTN","MAGJRPT",4,0) ;; +---------------------------------------------------------------+ "RTN","MAGJRPT",5,0) ;; | Property of the US Government. | "RTN","MAGJRPT",6,0) ;; | No permission to copy or redistribute this software is given. | "RTN","MAGJRPT",7,0) ;; | Use of unreleased versions of this software requires the user | "RTN","MAGJRPT",8,0) ;; | to execute a written test agreement with the VistA Imaging | "RTN","MAGJRPT",9,0) ;; | Development Office of the Department of Veterans Affairs, | "RTN","MAGJRPT",10,0) ;; | telephone (301) 734-0100. | "RTN","MAGJRPT",11,0) ;; | The Food and Drug Administration classifies this software as | "RTN","MAGJRPT",12,0) ;; | a medical device. As such, it may not be changed in any way. | "RTN","MAGJRPT",13,0) ;; | Modifications to this software may result in an adulterated | "RTN","MAGJRPT",14,0) ;; | medical device under 21CFR820, the use of which is considered | "RTN","MAGJRPT",15,0) ;; | to be a violation of US Federal Statutes. | "RTN","MAGJRPT",16,0) ;; +---------------------------------------------------------------+ "RTN","MAGJRPT",17,0) ;; "RTN","MAGJRPT",18,0) ; Subroutines for fetching Exam Info for VistaRad Workstation "RTN","MAGJRPT",19,0) ; RADRPT: Display Radiology Report -- RPC Call: MAGJ EXAM REPORT "RTN","MAGJRPT",20,0) ; ORD: Display Radiology Requisition -- RPC Call: MAGJ RADORDERDISP "RTN","MAGJRPT",21,0) ; "RTN","MAGJRPT",22,0) Q "RTN","MAGJRPT",23,0) ORD(MAGRPTY,DATA) ; Radiology Order Display "RTN","MAGJRPT",24,0) ; RPC Call: MAGJ RADORDERDISP "RTN","MAGJRPT",25,0) ; MAGRPTY holds indirect reference to returned data "RTN","MAGJRPT",26,0) ; "RTN","MAGJRPT",27,0) S MAGRPTY=$NA(^TMP($J,"WSDAT")) K @MAGRPTY "RTN","MAGJRPT",28,0) N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJRPT" "RTN","MAGJRPT",29,0) N RARPT,RADFN,RADTI,RACNI,RAPGE,RAX,RAOIFN "RTN","MAGJRPT",30,0) N REPLY,POP,DFN,COMPLIC,XX,HDR,MAGRET,REQONLY,TMPDATA "RTN","MAGJRPT",31,0) N MEDS,RDIOPHARM "RTN","MAGJRPT",32,0) S REPLY="0^4~Attempting to display order info" "RTN","MAGJRPT",33,0) D OPENDEV "RTN","MAGJRPT",34,0) I POP S REPLY="0^4~Unable to open device 'IMAGING WORKSTATION'" G ORDZ "RTN","MAGJRPT",35,0) S RADFN=$P(DATA,U),RADTI=$P(DATA,U,2),RACNI=$P(DATA,U,3) "RTN","MAGJRPT",36,0) S RARPT=+$P(DATA,U,4),REQONLY=+$P(DATA,U,5) "RTN","MAGJRPT",37,0) I RADFN,RADTI,RACNI "RTN","MAGJRPT",38,0) E S REPLY="0^4~Request Contains Invalid Case Pointer ("_RADFN_" "_RADTI_" "_RACNI_" "_RARPT_")." G ORDZ "RTN","MAGJRPT",39,0) S RAOIFN=$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),U,11) "RTN","MAGJRPT",40,0) I RAOIFN,$D(^RAO(75.1,RAOIFN,0)) "RTN","MAGJRPT",41,0) E S REPLY="0^2~Order Information is NOT Available for this exam." G ORDZ "RTN","MAGJRPT",42,0) ; Check for Database integrity problems ONLY if Req was explicitly "RTN","MAGJRPT",43,0) ; requested (No check for Auto_Display of Req, cuz Exam Open does ck) "RTN","MAGJRPT",44,0) D GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,"",.MAGRET) "RTN","MAGJRPT",45,0) S RADATA=$G(^TMP($J,"MAGRAEX",1,1)),XX=$G(^(2)),HDR="" "RTN","MAGJRPT",46,0) S COMPLIC=$P(XX,U,4) ; Complications text "RTN","MAGJRPT",47,0) S MEDS=$P(XX,U,14),RDIOPHARM=$P(XX,U,15) ; Medications & RadioPharm indicators "RTN","MAGJRPT",48,0) F I=4,12,9 S HDR=HDR_$P(RADATA,U,I)_" " ; PtName, Case #, Procedure "RTN","MAGJRPT",49,0) I REQONLY D CKINTEG(.REPLY,RADFN,RADTI,RACNI,RARPT,RADATA) I REPLY]"" S REPLY="0^7~"_REPLY G ORDZ ; Database integrity problems "RTN","MAGJRPT",50,0) S TMPDATA=MAGRPTY_"~"_RADTI_"~"_RACNI "RTN","MAGJRPT",51,0) S RAX="",RAPGE=0 D ^RAORD5 "RTN","MAGJRPT",52,0) S MAGRPTY=$P(TMPDATA,"~"),RADTI=$P(TMPDATA,"~",2),RACNI=$P(TMPDATA,"~",3) "RTN","MAGJRPT",53,0) D:IO'=IO(0) ^%ZISC "RTN","MAGJRPT",54,0) S @MAGRPTY@(1)="REQ: "_HDR "RTN","MAGJRPT",55,0) D COMMENTS(RADFN,RADTI,RACNI,MAGRPTY,2,COMPLIC,MEDS,RDIOPHARM) "RTN","MAGJRPT",56,0) D TIUNOTE(RARPT,MAGRPTY,10000) ; append TIU note to reply at node 10000 "RTN","MAGJRPT",57,0) S REPLY="1^OK" "RTN","MAGJRPT",58,0) K ^TMP($J,"MAGRAEX") "RTN","MAGJRPT",59,0) ORDZ S @MAGRPTY@(0)=REPLY "RTN","MAGJRPT",60,0) Q "RTN","MAGJRPT",61,0) ; "RTN","MAGJRPT",62,0) COMMENTS(RADFN,RADTI,RACNI,MAGRPTY,DNODE,COMPLIC,MEDS,RDIOPHARM) ; add Complications & Tech Comments to output report "RTN","MAGJRPT",63,0) ; Add Medications and Radiopharmaceuticals information to output "RTN","MAGJRPT",64,0) ; RADFN, RADTI, & RACNI identify exam "RTN","MAGJRPT",65,0) ; MAGRPTY is indirect reference wher output lines are to be stored "RTN","MAGJRPT",66,0) ; DNODE holds reference for starting node for lines of output "RTN","MAGJRPT",67,0) ; COMPLIC passes in complications data reference "RTN","MAGJRPT",68,0) ; MEDS passes in Medications indicator "RTN","MAGJRPT",69,0) ; RDIOPHARM passes in Radiopharmaceuticals reference "RTN","MAGJRPT",70,0) ; "RTN","MAGJRPT",71,0) I +MAGJOB("USER",1) ; Radiologist "RTN","MAGJRPT",72,0) E I $D(^VA(200,"ARC","T",+DUZ)) ; Rad Tech "RTN","MAGJRPT",73,0) E Q ; Don't display for any other user type "RTN","MAGJRPT",74,0) N QTMP,CT,XX S CT=0 "RTN","MAGJRPT",75,0) S @MAGRPTY@(DNODE)=" ",CT=CT+.01,@MAGRPTY@(DNODE+CT)="Complications: "_$S(COMPLIC:$P($G(^RA(78.1,+COMPLIC,0)),U),1:"") "RTN","MAGJRPT",76,0) S X=$P(COMPLIC,"~",2) "RTN","MAGJRPT",77,0) I X S CT=CT+.01,@MAGRPTY@(DNODE+CT)=" "_$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"COMP")),U) "RTN","MAGJRPT",78,0) K ^TMP($J,"RAE2") D SVTCOM^RAUTL11(RADFN,RADTI,RACNI) "RTN","MAGJRPT",79,0) S QTMP="^TMP($J,""RAE2"")" "RTN","MAGJRPT",80,0) F S QTMP=$Q(@QTMP) Q:QTMP="" Q:QTMP'["RAE2" I QTMP["TCOM" D "RTN","MAGJRPT",81,0) . S XX=@(QTMP) N HI,TXT,LINE1 S LINE1=0 "RTN","MAGJRPT",82,0) . F Q:XX="" S HI=$L(XX) S:HI>63 HI=63 F I=HI:-1:0 S:'I XX="" I HI<63!($E(XX,I)=" ") D Q "RTN","MAGJRPT",83,0) . . S TXT=$S('LINE1:"Tech Comments: ",1:" ")_$E(XX,1,I),XX=$E(XX,I+1,999),LINE1=1 "RTN","MAGJRPT",84,0) . . I XX]"" F I=1:1:999 I $E(XX,I)'=" " S XX=$E(XX,I,999) Q "RTN","MAGJRPT",85,0) . . S CT=CT+.01,@MAGRPTY@(DNODE+CT)=TXT "RTN","MAGJRPT",86,0) K ^TMP($J,"RAE2") "RTN","MAGJRPT",87,0) I +$G(MEDS) D "RTN","MAGJRPT",88,0) . N REF,RAUTOE,RAACNT "RTN","MAGJRPT",89,0) . K ^TMP($J,"RA AUTOE") "RTN","MAGJRPT",90,0) . S REF=RACNI_","_RADTI_","_RADFN_"," "RTN","MAGJRPT",91,0) . S RAUTOE="" ; if defined, directs output to ^TMP "RTN","MAGJRPT",92,0) . S RAACNT=1000 ; init counter for output to ^TMP "RTN","MAGJRPT",93,0) . D PHARM^RARTUTL(REF) ; get Medications data ; ICR #5946 (Private) "RTN","MAGJRPT",94,0) . D PHARMAS("Medications",1001) "RTN","MAGJRPT",95,0) I +$G(RDIOPHARM) D "RTN","MAGJRPT",96,0) . N RAUTOE,RAACNT "RTN","MAGJRPT",97,0) . K ^TMP($J,"RA AUTOE") "RTN","MAGJRPT",98,0) . S RAUTOE="" ; if defined, directs output to ^TMP "RTN","MAGJRPT",99,0) . S RAACNT=1000 ; init counter for output to ^TMP "RTN","MAGJRPT",100,0) . D RDIO^RARTUTL(RDIOPHARM) ; get Radiopharm data ; ICR #5946 (Private) "RTN","MAGJRPT",101,0) . D PHARMAS("Radiopharmaceuticals",1001) "RTN","MAGJRPT",102,0) I +$G(MEDS)!+$G(RDIOPHARM) D "RTN","MAGJRPT",103,0) . S CT=CT+.001,@MAGRPTY@(DNODE+CT)=" "_$TR($J(" ",66)," ","_") "RTN","MAGJRPT",104,0) . S CT=CT+.001,@MAGRPTY@(DNODE+CT)=" " "RTN","MAGJRPT",105,0) K ^TMP($J,"RA AUTOE") "RTN","MAGJRPT",106,0) Q "RTN","MAGJRPT",107,0) ; "RTN","MAGJRPT",108,0) PHARMAS(TITLE,NODE) ; output lines of pharma data "RTN","MAGJRPT",109,0) N LINE "RTN","MAGJRPT",110,0) I $D(^TMP($J,"RA AUTOE",NODE)) D "RTN","MAGJRPT",111,0) . S CT=CT+.001,@MAGRPTY@(DNODE+CT)=" " "RTN","MAGJRPT",112,0) . S CT=CT+.001,@MAGRPTY@(DNODE+CT)=" ------------ "_TITLE_" ------------" "RTN","MAGJRPT",113,0) . S CT=CT+.001,@MAGRPTY@(DNODE+CT)=" " "RTN","MAGJRPT",114,0) . F S LINE=^TMP($J,"RA AUTOE",NODE) D S NODE=$O(^TMP($J,"RA AUTOE",NODE)) Q:'NODE "RTN","MAGJRPT",115,0) . . S CT=CT+.001,@MAGRPTY@(DNODE+CT)=LINE "RTN","MAGJRPT",116,0) . Q "RTN","MAGJRPT",117,0) Q "RTN","MAGJRPT",118,0) ; "RTN","MAGJRPT",119,0) TIUNOTE(RARPT,MAGRPTY,DNODE) ; FUT-70/IHS append Rad TIU Notes to report "RTN","MAGJRPT",120,0) ; 1/2011--only works at IHS where TIU notes may exist for Radiology exams "RTN","MAGJRPT",121,0) ; test for this by presence of DOCTEXT^BEHOTIU "RTN","MAGJRPT",122,0) ; RARPT--exam pointer "RTN","MAGJRPT",123,0) ; MAGRPTY--indirect reference to output file "RTN","MAGJRPT",124,0) ; DNODE--starting node for lines of output "RTN","MAGJRPT",125,0) ; "RTN","MAGJRPT",126,0) N CT,QTMP,TEXT,XX "RTN","MAGJRPT",127,0) I RARPT,$L(MAGRPTY),DNODE,$L($T(DOCTEXT^BEHOTIU)) D "RTN","MAGJRPT",128,0) . D DOCTEXT^BEHOTIU("TEXT",RARPT_";RARPT(") "RTN","MAGJRPT",129,0) . I $D(TEXT) D "RTN","MAGJRPT",130,0) . . S CT=0,QTMP="TEXT" "RTN","MAGJRPT",131,0) . . S @MAGRPTY@(DNODE)=" " "RTN","MAGJRPT",132,0) . . F S QTMP=$Q(@QTMP) Q:QTMP="" S XX=@(QTMP) S CT=CT+.01,@MAGRPTY@(DNODE+CT)=XX "RTN","MAGJRPT",133,0) Q "RTN","MAGJRPT",134,0) ; "RTN","MAGJRPT",135,0) OPENDEV ; "RTN","MAGJRPT",136,0) N IOP,%ZIS "RTN","MAGJRPT",137,0) S IOP="IMAGING WORKSTATION",%ZIS=0 D ^%ZIS "RTN","MAGJRPT",138,0) I POP "RTN","MAGJRPT",139,0) E U IO "RTN","MAGJRPT",140,0) Q "RTN","MAGJRPT",141,0) ; "RTN","MAGJRPT",142,0) RADRPT(MAGRPTY,DATA) ; Display rad report; 1st must pass integrity checks "RTN","MAGJRPT",143,0) ; Note: adds an additional line of output for the Report Window header "RTN","MAGJRPT",144,0) ; RPC is MAGJ EXAM REPORT "RTN","MAGJRPT",145,0) ; "RTN","MAGJRPT",146,0) ; MAGRPTY holds $NA reference to return message; references to it use subscript indirection "RTN","MAGJRPT",147,0) ; "RTN","MAGJRPT",148,0) S MAGRPTY=$NA(^TMP($J,"MAGJRADRPT")) K @MAGRPTY "RTN","MAGJRPT",149,0) N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJRPT" "RTN","MAGJRPT",150,0) N RARPT,RADATA,MAGDFN,MAGDTI,MAGCNI,X,MAGRET,HDR,REPLY,MAGPRC,COMPLIC,DNODE "RTN","MAGJRPT",151,0) N MEDS,RDIOPHARM "RTN","MAGJRPT",152,0) S MAGDFN=$P(DATA,U),MAGDTI=$P(DATA,U,2),MAGCNI=$P(DATA,U,3),RARPT=+$P(DATA,U,4) "RTN","MAGJRPT",153,0) I '(MAGDFN&MAGDTI&MAGCNI) D G RPTZ "RTN","MAGJRPT",154,0) . S REPLY="0^4~Request Contains Invalid Case Pointer ("_MAGDFN_" "_MAGDTI_" "_MAGCNI_")." "RTN","MAGJRPT",155,0) D GETEXAM2^MAGJUTL1(MAGDFN,MAGDTI,MAGCNI,"",.MAGRET) "RTN","MAGJRPT",156,0) S RADATA=$G(^TMP($J,"MAGRAEX",1,1)),XX=$G(^(2)),HDR="" "RTN","MAGJRPT",157,0) S COMPLIC=$P(XX,U,4) ; Complications text "RTN","MAGJRPT",158,0) S MEDS=$P(XX,U,14),RDIOPHARM=$P(XX,U,15) ; Medications & RadioPharm indicators "RTN","MAGJRPT",159,0) F I=4,12,9 S HDR=HDR_$P(RADATA,U,I)_" " "RTN","MAGJRPT",160,0) D CKINTEG(.REPLY,MAGDFN,MAGDTI,MAGCNI,RARPT,RADATA) "RTN","MAGJRPT",161,0) I REPLY]"" S REPLY="0^7~"_REPLY G RPTZ ; DB integ problem "RTN","MAGJRPT",162,0) D EN3^RAO7PC3(MAGDFN_"^"_MAGDTI_"^"_MAGCNI) "RTN","MAGJRPT",163,0) I '$D(^TMP($J,"RAE3")) S REPLY="0^4~No report on file." G RPTZ "RTN","MAGJRPT",164,0) D COMMENTS(MAGDFN,MAGDTI,MAGCNI,MAGRPTY,2,COMPLIC,MEDS,RDIOPHARM) "RTN","MAGJRPT",165,0) S MAGPRC=$O(^TMP($J,"RAE3",MAGDFN,MAGCNI,"")),I=0,DNODE=2 "RTN","MAGJRPT",166,0) F S I=$O(^TMP($J,"RAE3",MAGDFN,MAGCNI,MAGPRC,I)) Q:'I D "RTN","MAGJRPT",167,0) . S DNODE=DNODE+1 "RTN","MAGJRPT",168,0) . S @MAGRPTY@(DNODE)=$G(^TMP($J,"RAE3",MAGDFN,MAGCNI,MAGPRC,I)) "RTN","MAGJRPT",169,0) F I=1:1:4 S DNODE=DNODE+1,@MAGRPTY@(DNODE)=$S(I'=3:"",1:"** END REPORT "_$$FMTE^XLFDT($$NOW^XLFDT,"1P")_" **") "RTN","MAGJRPT",170,0) D TIUNOTE(RARPT,MAGRPTY,10000) ; append TIU note to reply at node 10000 "RTN","MAGJRPT",171,0) S REPLY="1^1~Radiology Report" "RTN","MAGJRPT",172,0) RPTZ S @MAGRPTY@(0)=REPLY "RTN","MAGJRPT",173,0) I +$G(@MAGRPTY@(0)) S @MAGRPTY@(1)="RPT: "_HDR ; if a report exists, add header line to output "RTN","MAGJRPT",174,0) K ^TMP($J,"MAGRAEX"),^("RAE3") "RTN","MAGJRPT",175,0) Q "RTN","MAGJRPT",176,0) ; "RTN","MAGJRPT",177,0) CKINTEG(REPLY,RADFN,RADTI,RACNI,RARPT,RADATA) ; check integrity between Exam, Report, and Image Group Headers "RTN","MAGJRPT",178,0) ; This subroutine is used by other vrad programs "RTN","MAGJRPT",179,0) ; "RTN","MAGJRPT",180,0) N IEN,MAGIEN,MIXEDUP,X,CKDFN,CKACN "RTN","MAGJRPT",181,0) S MIXEDUP=0,REPLY="" "RTN","MAGJRPT",182,0) I RARPT D G CK2:MIXEDUP "RTN","MAGJRPT",183,0) . S X=$G(^RARPT(RARPT,0)),CKDFN=$P(X,U,2),CKACN=$P(X,U,4) "RTN","MAGJRPT",184,0) . I CKDFN'=RADFN S MIXEDUP=1_U_+CKDFN Q "RTN","MAGJRPT",185,0) . I $G(RADATA)]"" D "RTN","MAGJRPT",186,0) . . I $P(RADATA,U,8)'=CKACN D "RTN","MAGJRPT",187,0) . . . N MAGPSET,RAPRTSET,ACN,OK S OK=0 "RTN","MAGJRPT",188,0) . . . S RAPRTSET=0 D EN2^RAUTL20(.MAGPSET) I RAPRTSET D "RTN","MAGJRPT",189,0) . . . . N I,T ; P133 mod for MAGPSET Data ex.--Old= 256^154^190^4 SSAN= 660-080504-256^154^190^4 "RTN","MAGJRPT",190,0) . . . . S I=0 F S I=$O(MAGPSET(I)) Q:'I S T=$P(MAGPSET(I),U) I $P(T,"-",$L(T,"-"))=CKACN S OK=1 Q "RTN","MAGJRPT",191,0) . . . I 'OK S MIXEDUP=5_U_CKACN_U_$P(RADATA,U,8) "RTN","MAGJRPT",192,0) I $D(^RARPT(+RARPT,2005)) S IEN=0 D G CK2:MIXEDUP "RTN","MAGJRPT",193,0) . F S IEN=$O(^RARPT(RARPT,2005,IEN)) Q:'IEN S MAGIEN=+$G(^(IEN,0)) D Q:MIXEDUP "RTN","MAGJRPT",194,0) . . S X=$P($G(^MAG(2005,MAGIEN,0)),U,7) I X'=RADFN S MIXEDUP=2_U_+X Q "RTN","MAGJRPT",195,0) . . S X=$P($G(^MAG(2005,MAGIEN,2)),U,7) I X'=RARPT S MIXEDUP=3_U_+X Q "RTN","MAGJRPT",196,0) CK2 I 'MIXEDUP Q ; no problems detected "RTN","MAGJRPT",197,0) I +MIXEDUP=1!(+MIXEDUP=2) D Q "RTN","MAGJRPT",198,0) . S X=$$PNAM^MAGJEX1($P(MIXEDUP,U,2)) "RTN","MAGJRPT",199,0) . I +MIXEDUP=1 S REPLY="The Exam file for this exam has patient "_$$PNAM^MAGJEX1(RADFN)_"; the corresponding Report file has patient "_X_". This is a serious problem--immediately report it to Radiology management and Imaging support!" "RTN","MAGJRPT",200,0) . I +MIXEDUP=2 S REPLY="This exam is registered for "_$$PNAM^MAGJEX1(RADFN)_"; however, it is linked to images for patient "_X_". This is a serious problem--immediately report it to Radiology management and Imaging support staff!" "RTN","MAGJRPT",201,0) I +MIXEDUP=3 D Q "RTN","MAGJRPT",202,0) . N T S T=$P(MIXEDUP,U,2) S:'T T="Missing Link" "RTN","MAGJRPT",203,0) . S REPLY="This exam is linked to Report entry #"_RARPT_", but some of its images may be linked to Report entry #"_T_". This is a potentially serious problem--immediately report it to Radiology management and Imaging support staff!" "RTN","MAGJRPT",204,0) I +MIXEDUP=4 D Q "RTN","MAGJRPT",205,0) . N T S T=$P(MIXEDUP,U,2) S:'T T="Missing Reference" "RTN","MAGJRPT",206,0) . S X=" ("_RARPT_" and "_T_" )" "RTN","MAGJRPT",207,0) . S REPLY="This exam has problems in the Radiology Report file, with two different report entries referenced"_X_". This is a potentially serious problem--immediately report it to Radiology management and Imaging support staff!" "RTN","MAGJRPT",208,0) I +MIXEDUP=5 D Q "RTN","MAGJRPT",209,0) . N T S X=$P(MIXEDUP,U,2) S:X="" X="Missing" "RTN","MAGJRPT",210,0) . S T=$P(MIXEDUP,U,3) S:T="" T="Missing" "RTN","MAGJRPT",211,0) . S X=" ("_X_" and "_T_") " "RTN","MAGJRPT",212,0) . S REPLY="This exam has problems in the Radiology files, with two different Case Numbers referenced"_X_". This is a potentially serious problem--immediately report it to Radiology management and Imaging support staff!" "RTN","MAGJRPT",213,0) Q "RTN","MAGJRPT",214,0) ; "RTN","MAGJRPT",215,0) ERR ; "RTN","MAGJRPT",216,0) S @MAGRPTY@(0)="0^ERROR "_$$EC^%ZOSV "RTN","MAGJRPT",217,0) D @^%ZOSF("ERRTN") "RTN","MAGJRPT",218,0) Q:$Q 1 Q "RTN","MAGJRPT",219,0) END ; "RTN","MAGJTU4V") 0^4^B5405270 "RTN","MAGJTU4V",1,0) MAGJTU4V ;WOIFO/MAT - VERSION CONTROL (VISTARAD) ; 9 Sep 2013 11:22 AM "RTN","MAGJTU4V",2,0) ;;3.0;IMAGING;**90,115,120,133**;Mar 19, 2002;Build 5393;Sep 09, 2013 "RTN","MAGJTU4V",3,0) ;; Per VHA Directive 2004-038, this routine should not be modified. "RTN","MAGJTU4V",4,0) ;; +---------------------------------------------------------------+ "RTN","MAGJTU4V",5,0) ;; | Property of the US Government. | "RTN","MAGJTU4V",6,0) ;; | No permission to copy or redistribute this software is given. | "RTN","MAGJTU4V",7,0) ;; | Use of unreleased versions of this software requires the user | "RTN","MAGJTU4V",8,0) ;; | to execute a written test agreement with the VistA Imaging | "RTN","MAGJTU4V",9,0) ;; | Development Office of the Department of Veterans Affairs, | "RTN","MAGJTU4V",10,0) ;; | telephone (301) 734-0100. | "RTN","MAGJTU4V",11,0) ;; | The Food and Drug Administration classifies this software as | "RTN","MAGJTU4V",12,0) ;; | a medical device. As such, it may not be changed in any way. | "RTN","MAGJTU4V",13,0) ;; | Modifications to this software may result in an adulterated | "RTN","MAGJTU4V",14,0) ;; | medical device under 21CFR820, the use of which is considered | "RTN","MAGJTU4V",15,0) ;; | to be a violation of US Federal Statutes. | "RTN","MAGJTU4V",16,0) ;; +---------------------------------------------------------------+ "RTN","MAGJTU4V",17,0) ;; "RTN","MAGJTU4V",18,0) ; This routine contains the version control code and data specific "RTN","MAGJTU4V",19,0) ; to the VistARad application. DO NOT ADD ANYTHING ELSE! "RTN","MAGJTU4V",20,0) Q "RTN","MAGJTU4V",21,0) ; "RTN","MAGJTU4V",22,0) CLVERCT ;***** VERSION CONTROL TABLE FOR THE VistARad CLIENTS "RTN","MAGJTU4V",23,0) ;;================================================================== "RTN","MAGJTU4V",24,0) ;;| Version |Build|Seq #| Comment | "RTN","MAGJTU4V",25,0) ;;|---------+-----+------------------------------------------------| "RTN","MAGJTU4V",26,0) ;;| 3.0.133 | 3 | ?? | Sep 2013 <*> Projected Seq # & Release | "RTN","MAGJTU4V",27,0) ;;| 3.0.120 | 8 | 81 | Jul 2012 | "RTN","MAGJTU4V",28,0) ;;| 3.0.115 | 4 | 73 | Mar 2011 | "RTN","MAGJTU4V",29,0) ;;| 3.0.90 | 9 | 66 | Aug 2010 | "RTN","MAGJTU4V",30,0) ;;| 3.0.101 | 10 | 61 | Feb 2010 | "RTN","MAGJTU4V",31,0) ;;================================================================== "RTN","MAGJTU4V",32,0) ; "RTN","MAGJTU4V",33,0) ; Each row of the version control table contains the version and "RTN","MAGJTU4V",34,0) ; build number of a supported client. Released patches must also "RTN","MAGJTU4V",35,0) ; indicate the sequential numbers. "RTN","MAGJTU4V",36,0) ; "RTN","MAGJTU4V",37,0) ; Sort order of the rows does not matter. However, the reversed "RTN","MAGJTU4V",38,0) ; order of patch sequential numbers is recommended. "RTN","MAGJTU4V",39,0) ; "RTN","MAGJTU4V",40,0) Q "RTN","MAGJTU4V",41,0) ; "RTN","MAGJTU4V",42,0) ;***** ADDS A CLIENT-SPECIFIC WARNING (IF NECESSARY) "RTN","MAGJTU4V",43,0) ; "RTN","MAGJTU4V",44,0) ; .MAGBUF Reference to a local array that the warning text "RTN","MAGJTU4V",45,0) ; is returned to. It is appended to the RPC result "RTN","MAGJTU4V",46,0) ; array by the caller (WARNING^MAGGTU41). "RTN","MAGJTU4V",47,0) ; "RTN","MAGJTU4V",48,0) ; CLVER Client application version (Major.Minor.Patch.Build) "RTN","MAGJTU4V",49,0) ; "RTN","MAGJTU4V",50,0) ; CVRC Version check code returned by the $$CHKVER1^MAGGTU41 "RTN","MAGJTU4V",51,0) ; "RTN","MAGJTU4V",52,0) ; Notes "RTN","MAGJTU4V",53,0) ; ===== "RTN","MAGJTU4V",54,0) ; "RTN","MAGJTU4V",55,0) ; If the RPC result array already contains an error message that "RTN","MAGJTU4V",56,0) ; will terminate the client, application, this procedure is not "RTN","MAGJTU4V",57,0) ; called. "RTN","MAGJTU4V",58,0) ; "RTN","MAGJTU4V",59,0) WARNING(MAGBUF,CLVER,CVRC) ; "RTN","MAGJTU4V",60,0) Q "RTN","MAGJUPD1") 0^5^B64000428 "RTN","MAGJUPD1",1,0) MAGJUPD1 ;WOIFO/JHC - VistARad Update Exam Status ; 25 Mar 2013 5:22 PM "RTN","MAGJUPD1",2,0) ;;3.0;IMAGING;**16,22,18,76,101,120,133**;Mar 19, 2002;Build 5393;Sep 09, 2013 "RTN","MAGJUPD1",3,0) ;; Per VHA Directive 2004-038, this routine should not be modified. "RTN","MAGJUPD1",4,0) ;; +---------------------------------------------------------------+ "RTN","MAGJUPD1",5,0) ;; | Property of the US Government. | "RTN","MAGJUPD1",6,0) ;; | No permission to copy or redistribute this software is given. | "RTN","MAGJUPD1",7,0) ;; | Use of unreleased versions of this software requires the user | "RTN","MAGJUPD1",8,0) ;; | to execute a written test agreement with the VistA Imaging | "RTN","MAGJUPD1",9,0) ;; | Development Office of the Department of Veterans Affairs, | "RTN","MAGJUPD1",10,0) ;; | telephone (301) 734-0100. | "RTN","MAGJUPD1",11,0) ;; | The Food and Drug Administration classifies this software as | "RTN","MAGJUPD1",12,0) ;; | a medical device. As such, it may not be changed in any way. | "RTN","MAGJUPD1",13,0) ;; | Modifications to this software may result in an adulterated | "RTN","MAGJUPD1",14,0) ;; | medical device under 21CFR820, the use of which is considered | "RTN","MAGJUPD1",15,0) ;; | to be a violation of US Federal Statutes. | "RTN","MAGJUPD1",16,0) ;; +---------------------------------------------------------------+ "RTN","MAGJUPD1",17,0) ;; "RTN","MAGJUPD1",18,0) Q "RTN","MAGJUPD1",19,0) ; Subroutines for RPC's to update Exam Status to "Interpreted", and "RTN","MAGJUPD1",20,0) ; for "Closing" a case that is open on the DX Workstation "RTN","MAGJUPD1",21,0) ; "RTN","MAGJUPD1",22,0) ERR N ERR S ERR=$$EC^%ZOSV S @MAGGRY@(0)="0^Server Program Error: "_ERR "RTN","MAGJUPD1",23,0) D @^%ZOSF("ERRTN") "RTN","MAGJUPD1",24,0) Q:$Q 1 Q "RTN","MAGJUPD1",25,0) ; "RTN","MAGJUPD1",26,0) STATUS(MAGGRY,PARAMS,DATA) ; rpc: MAGJ RADSTATUSUPDATE "RTN","MAGJUPD1",27,0) ; Update Exam Status to "Interpreted" and/or Close the exam "RTN","MAGJUPD1",28,0) ; Only updates the Status if the current value is "Examined" "RTN","MAGJUPD1",29,0) ; This routine defines variables needed for calling the Radiology "RTN","MAGJUPD1",30,0) ; package routine UP1^RAUTL1, for filing Status updates "RTN","MAGJUPD1",31,0) ; "RTN","MAGJUPD1",32,0) ; PARAMS = UPDFLAG ^ RADFN ^ RADTI ^ RACNI ^ RARPT ^ UPDPSKEY "RTN","MAGJUPD1",33,0) ; UPDFLAG = 1/0 -- 1 to perform update; else no update made "RTN","MAGJUPD1",34,0) ; RARPT = ptr to Rad Exam Report file "RTN","MAGJUPD1",35,0) ; RADFN,RADTI,RACNI = pointers to Rad Patient File for the exam "RTN","MAGJUPD1",36,0) ; UPDPSKEY = 1/0 -- 1 to update Presentation State &/or Key Image data "RTN","MAGJUPD1",37,0) ; = 2 -- update PS data with NO lock in place--Resident workflow, or Sec Key Override "RTN","MAGJUPD1",38,0) ; DATA = optional array containing prezentation state data; see SAVKPS^MAGJUPD2 for description "RTN","MAGJUPD1",39,0) ; MAGGRY = return results in @MAGGRY "RTN","MAGJUPD1",40,0) ; "RTN","MAGJUPD1",41,0) N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJUPD1" "RTN","MAGJUPD1",42,0) N RARPT,RADFN,RADTI,RACNI,RAEXT,RACNE,RADTE,RAINT,RAMDV,DIQUIET "RTN","MAGJUPD1",43,0) N RAONLINE,ZTQUEUED,RAOR,RASN,RASTI,RAPRTSET,LOGDATA,RSL,TIMESTMP "RTN","MAGJUPD1",44,0) N UPDPSKEY,MAGRET,MAGLST,REPLY,UPDFLAG,RADATA,RIST,MAGPSET,RACNILST,ACNLST "RTN","MAGJUPD1",45,0) N PSETLST "RTN","MAGJUPD1",46,0) S MAGLST="MAGJUPDATE" "RTN","MAGJUPD1",47,0) K MAGGRY S MAGGRY=$NA(^TMP($J,MAGLST)) K @MAGGRY ; assign MAGGRY value "RTN","MAGJUPD1",48,0) S DIQUIET=1 D DT^DICRW "RTN","MAGJUPD1",49,0) S TIMESTMP=$$NOW^XLFDT() "RTN","MAGJUPD1",50,0) S UPDFLAG=$P(PARAMS,U),RADFN=$P(PARAMS,U,2),RADTI=$P(PARAMS,U,3),RACNI=$P(PARAMS,U,4),RARPT=$P(PARAMS,U,5),UPDPSKEY=+$P(PARAMS,U,6) "RTN","MAGJUPD1",51,0) S REPLY="0^4~Closing case with"_$S(UPDFLAG:"",1:" NO")_" Status Update" "RTN","MAGJUPD1",52,0) S RAPRTSET=0 "RTN","MAGJUPD1",53,0) I RADFN,RADTI,RACNI "RTN","MAGJUPD1",54,0) E S REPLY="0^4~Request Contains Invalid Case Pointer ("_RARPT_")" G STATUSZ "RTN","MAGJUPD1",55,0) D GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,0,.MAGRET) "RTN","MAGJUPD1",56,0) I 'MAGRET S REPLY="0^4~Current Case Not Accessible for Updating" G STATUSZ "RTN","MAGJUPD1",57,0) ; 1 RADFN RADTI RACNI RANME RASSN <--Contents of RADATA, "RTN","MAGJUPD1",58,0) ; 6 RADATE RADTE RACN RAPRC RARPT from GETEXAM "RTN","MAGJUPD1",59,0) ;11 RAST DAYCASE RAELOC RASTP RASTORD "RTN","MAGJUPD1",60,0) ;16 RADTPRT "RTN","MAGJUPD1",61,0) S RADATA=$G(^TMP($J,"MAGRAEX",1,1)) "RTN","MAGJUPD1",62,0) S RAEXT=$P(RADATA,U,12),RACNE=$P(RAEXT,"-",$L(RAEXT,"-")),RADTE=$P(RADATA,U,7) ; p133: $L for SSAN or old Acn "RTN","MAGJUPD1",63,0) S RAINT=RADTI_"-"_RACNI "RTN","MAGJUPD1",64,0) I UPDPSKEY=2 D G STATUSZ ; P101 update annotations only, if authorized (Resident workflow, or Sec Key Override) "RTN","MAGJUPD1",65,0) . I +MAGJOB("USER",1),'UPDFLAG,($D(DATA)>9) S REPLY="0^1~Case #"_RAEXT_" Closed; No Status Update; annotation updates performed." "RTN","MAGJUPD1",66,0) . E S UPDPSKEY=0,REPLY="0^4~Invalid request to update annotations for Case #"_RAEXT_"." "RTN","MAGJUPD1",67,0) D CLOSE(.RSL,RADFN_U_RADTI_U_RACNI_U_U_1,.LOGDATA) ; unlock the case "RTN","MAGJUPD1",68,0) ; proceed only if case was locked by this user "RTN","MAGJUPD1",69,0) ; if it was not Locked, then do NOT update PS, Key Images "RTN","MAGJUPD1",70,0) I 'RSL S REPLY=RSL,UPDPSKEY=0 G STATUSZ "RTN","MAGJUPD1",71,0) I 'UPDFLAG S REPLY="0^1~Case #"_RAEXT_" Closed; No Status Update performed" G STATUSZ "RTN","MAGJUPD1",72,0) S RIST=$P(RSL,U,2) ; CLOSE reports back the type of radiologist "RTN","MAGJUPD1",73,0) ; now we know this user had locked the case, & wants to do Status update "RTN","MAGJUPD1",74,0) D EN2^RAUTL20(.MAGPSET) ; get info re rad PrintSet "RTN","MAGJUPD1",75,0) ; Note--above call also sets variable RAPRTSET "RTN","MAGJUPD1",76,0) ; "RTN","MAGJUPD1",77,0) ; IF exam is not "Examined", and not "Cancelled" and past "Waiting" "RTN","MAGJUPD1",78,0) ; then assume it has already been updated via another pathway, "RTN","MAGJUPD1",79,0) ; either as printset member (via code below--see PRTSET note...), "RTN","MAGJUPD1",80,0) ; or from a voice-dictation or terminal session by the radiologist "RTN","MAGJUPD1",81,0) ; For these cases, no warning msg is sent "RTN","MAGJUPD1",82,0) ; Else, update not allowed, so give warning msg "RTN","MAGJUPD1",83,0) ; Note that when the Exam was OPENed, it must have had status "Examined" "RTN","MAGJUPD1",84,0) I '$D(^RA(72,"AVC","E",$P(RADATA,U,11))) D G STATUSX:(+$P(REPLY,U,2)=1),STATUSZ ; Current Status MUST be "Examined" Category "RTN","MAGJUPD1",85,0) . I $P(RADATA,U,15)>2 D ; assume update has otherwise been done, eg voice dictation or manual entry in Vista "RTN","MAGJUPD1",86,0) . . S RACNILST=RACNI,RASTI=$P(RADATA,U,11) ; need for code at tag statusx "RTN","MAGJUPD1",87,0) . . I RAPRTSET S REPLY="0^1~Printset Exams with Case #"_RAEXT_" have been updated" "RTN","MAGJUPD1",88,0) . . E S REPLY="0^1~No Update done for Case #"_RAEXT_"--current status is "_$P(RADATA,U,14) "RTN","MAGJUPD1",89,0) . E S REPLY="0^3~No Update Allowed for Case #"_RAEXT_"--current status is "_$P(RADATA,U,14) "RTN","MAGJUPD1",90,0) ; "RTN","MAGJUPD1",91,0) ; now ready to update exam status "RTN","MAGJUPD1",92,0) S RAMDV=$P(^RADPT(RADFN,"DT",RADTI,0),U,3) "RTN","MAGJUPD1",93,0) S RAMDV=$TR(^RA(79,RAMDV,.1),"YyNn","1100") "RTN","MAGJUPD1",94,0) ; "RTN","MAGJUPD1",95,0) ; Update interpreting radiologist field in Rad file "RTN","MAGJUPD1",96,0) I RIST D I RACNILST="" G STATUSZ "RTN","MAGJUPD1",97,0) . N SAVRACNI,RTN S RACNILST="" "RTN","MAGJUPD1",98,0) . ; PRTSET note: if exam is part of Rad Print-Set, then update all exams of printset "RTN","MAGJUPD1",99,0) . I RAPRTSET D "RTN","MAGJUPD1",100,0) . . S ACNLST="",SAVRACNI=RACNI,X=0 "RTN","MAGJUPD1",101,0) . . N T ; P133 mod for MAGPSET Data ex.--Old= 256^154^190^4 SSAN= 660-080504-256^154^190^4 "RTN","MAGJUPD1",102,0) . . F I=0:1 S X=$O(MAGPSET(X)) Q:'X S RACNILST=RACNILST_$S(I:U,1:"")_X,T=$P(MAGPSET(X),U) S:RACNE'=$P(T,"-",($L(T,"-"))) ACNLST=ACNLST_", "_$S($L(T,"-")=1:"-",1:"")_T "RTN","MAGJUPD1",103,0) . E S RACNILST=RACNI "RTN","MAGJUPD1",104,0) . F I=1:1:$L(RACNILST,U) S RACNI=$P(RACNILST,U,I) I RACNI D I RACNILST="" Q "RTN","MAGJUPD1",105,0) . . S DA(2)=RADFN,DA(1)=RADTI,DA=RACNI "RTN","MAGJUPD1",106,0) . . D STUFPHY^RARIC1(DUZ,RIST,.RTN) "RTN","MAGJUPD1",107,0) . . I 'RTN S REPLY="0^4~Unable to update Interpreting Radiologist: "_RTN_"." S RACNILST="" "RTN","MAGJUPD1",108,0) . I RAPRTSET S RACNI=SAVRACNI "RTN","MAGJUPD1",109,0) S RAONLINE=1,ZTQUEUED=1 D UP1^RAUTL1 ; Suppress msgs, do Status update "RTN","MAGJUPD1",110,0) ;<*> K RAONLINE,ZTQUEUED D UP1^RAUTL1 ; <*> Testing Only: ENABLE msgs "RTN","MAGJUPD1",111,0) I RAOR<0 S REPLY="0^3~Exam Status for Case #"_RAEXT_" CANNOT be updated; current status remains: "_$S($G(RASN)]"":RASN,1:"Unknown") "RTN","MAGJUPD1",112,0) I G STATUSZ "RTN","MAGJUPD1",113,0) ; "RTN","MAGJUPD1",114,0) S REPLY="0^1~For Case #"_$S($G(ACNLST)]"":"s ",1:"")_RAEXT_$S(RAPRTSET:ACNLST,1:"")_", Exam Status updated to "_RASN "RTN","MAGJUPD1",115,0) ; "RTN","MAGJUPD1",116,0) STATUSX ; Newly Interpreted exam: "RTN","MAGJUPD1",117,0) ; Log the Interpreted event; Printset logging includes all printset members "RTN","MAGJUPD1",118,0) S PSETLST="" "RTN","MAGJUPD1",119,0) I RAPRTSET S X="" D "RTN","MAGJUPD1",120,0) . F I=0:1 S X=$O(MAGPSET(X)) Q:'X S PSETLST=PSETLST_$S(I:U,1:"")_$P(MAGPSET(X),U) "RTN","MAGJUPD1",121,0) D LOG^MAGJUTL3("VR-INT",LOGDATA,PSETLST) "RTN","MAGJUPD1",122,0) ; Update Recent Exams List "RTN","MAGJUPD1",123,0) G STATUSZ:'$P(^MAG(2006.69,1,0),U,8) ; no bkgnd compile enabled "RTN","MAGJUPD1",124,0) L +^XTMP("MAGJ2","RECENT"):5 "RTN","MAGJUPD1",125,0) E G STATUSZ "RTN","MAGJUPD1",126,0) N INDX F I=1:1:$L(RACNILST,U) S RACNI=$P(RACNILST,U,I) I RACNI D "RTN","MAGJUPD1",127,0) . S INDX=+$G(^XTMP("MAGJ2","RECENT",0))+1,$P(^(0),U)=INDX,^(INDX)=RADFN_U_RADTI_U_RACNI_U_RASTI "RTN","MAGJUPD1",128,0) L -^XTMP("MAGJ2","RECENT") "RTN","MAGJUPD1",129,0) STATUSZ ; "RTN","MAGJUPD1",130,0) ; store PS, Key Image data "RTN","MAGJUPD1",131,0) I UPDPSKEY,($D(DATA)>9) D "RTN","MAGJUPD1",132,0) . D SAVKPS^MAGJUPD2(RARPT,UPDPSKEY,.DATA,.X) "RTN","MAGJUPD1",133,0) . S REPLY=REPLY_$P(X,"~",2,99) "RTN","MAGJUPD1",134,0) S @MAGGRY@(0)=REPLY "RTN","MAGJUPD1",135,0) K ^TMP($J,"MAGRAEX"),^("RAE1") "RTN","MAGJUPD1",136,0) Q "RTN","MAGJUPD1",137,0) ; "RTN","MAGJUPD1",138,0) CLOSE(RSL,PARAMS,LOGDATA) ; Close/unlock a case "RTN","MAGJUPD1",139,0) ; Input: PARAMS = DFN ^ DTI ^ CNI ^ RPT ^ UPDFLAG "RTN","MAGJUPD1",140,0) ; "RTN","MAGJUPD1",141,0) ; DFN,DTI,CNI,RPT = pointers to Rad File for the exam "RTN","MAGJUPD1",142,0) ; UPDFLAG = 1/0 -- 1 indicates CLOSE was called from subroutine "RTN","MAGJUPD1",143,0) ; STATUS, above (which has already called GETEXAM) "RTN","MAGJUPD1",144,0) ; RSL = return result of the Close "RTN","MAGJUPD1",145,0) ; This subroutine may be called directly (to close a case without "RTN","MAGJUPD1",146,0) ; doing a status update), or is called from tag STATUS, above, when "RTN","MAGJUPD1",147,0) ; also doing a status update "RTN","MAGJUPD1",148,0) ; "RTN","MAGJUPD1",149,0) N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJUPD1" "RTN","MAGJUPD1",150,0) N RPT,DFN,DTI,CNI,MAGRET,REPLY,RARPT,UPDFLAG,RIST,DAYCASE,NLOCKS,MYLOCK "RTN","MAGJUPD1",151,0) S DFN=$P(PARAMS,U),DTI=$P(PARAMS,U,2),CNI=$P(PARAMS,U,3),RPT=$P(PARAMS,U,4),UPDFLAG=$P(PARAMS,U,5) "RTN","MAGJUPD1",152,0) S LOGDATA="" "RTN","MAGJUPD1",153,0) I $P($G(^MAG(2006.69,1,0)),U,4) "RTN","MAGJUPD1",154,0) E S REPLY=$S(UPDFLAG:"0^3~Updates not allowed at this site--no action taken",1:"") G CLOSEZ ; Status Update NOT Enabled "RTN","MAGJUPD1",155,0) S RIST=+MAGJOB("USER",1) I RIST "RTN","MAGJUPD1",156,0) E S REPLY=$S(UPDFLAG:"0^3~Update allowed only by a radiologist--no action taken",1:"") G CLOSEZ ; need only unlock a radiologist "RTN","MAGJUPD1",157,0) I DFN,DTI,CNI "RTN","MAGJUPD1",158,0) E S REPLY="0^4~Request Contains Invalid Case Pointer ("_RPT_")--no action taken" G CLOSEZ "RTN","MAGJUPD1",159,0) ; "RTN","MAGJUPD1",160,0) I 'UPDFLAG N RADATA D I 'MAGRET G CLOSEZ "RTN","MAGJUPD1",161,0) . D GETEXAM2^MAGJUTL1(DFN,DTI,CNI,0,.MAGRET) "RTN","MAGJUPD1",162,0) . I 'MAGRET S REPLY="0^4~No Current Case accessible to close--no action taken" "RTN","MAGJUPD1",163,0) . E S RADATA=$G(^TMP($J,"MAGRAEX",1,1)) "RTN","MAGJUPD1",164,0) S RARPT=$P(RADATA,U,10),DAYCASE=$P(RADATA,U,12) "RTN","MAGJUPD1",165,0) I RARPT,DAYCASE "RTN","MAGJUPD1",166,0) E S REPLY="0^4~Current Case not accessible to close--no action taken" G CLOSEZ "RTN","MAGJUPD1",167,0) ; "RTN","MAGJUPD1",168,0) D LOCKACT^MAGJEX1A(RARPT,DAYCASE,101,,.MYLOCK) "RTN","MAGJUPD1",169,0) S LOGDATA=$P(MYLOCK(1),"|",2) "RTN","MAGJUPD1",170,0) I 'MYLOCK(1) S X=$P(MYLOCK(1),U,4) D S LOGDATA="" G CLOSEZ "RTN","MAGJUPD1",171,0) . I UPDFLAG S REPLY="0^1~Case #"_DAYCASE_$S(X]"":" locked by "_X,1:" not locked by "_$P(MAGJOB("USER",1),U,2))_"--No Status update performed" "RTN","MAGJUPD1",172,0) . E S REPLY="0^1~ " ; case wasn't opened by this R'ist; nothing to do "RTN","MAGJUPD1",173,0) ; "RTN","MAGJUPD1",174,0) I UPDFLAG S REPLY=1_U_RIST "RTN","MAGJUPD1",175,0) E S REPLY="0^1~Case #"_DAYCASE_$S(+MYLOCK(1):" unlocked",+MYLOCK(2):" reserve cancelled",1:" closed")_"--No Status Update performed." "RTN","MAGJUPD1",176,0) CLOSEZ S RSL=REPLY "RTN","MAGJUPD1",177,0) Q "RTN","MAGJUPD1",178,0) ; "RTN","MAGJUPD1",179,0) END Q ; "RTN","MAGJUTL1") 0^6^B71279028 "RTN","MAGJUTL1",1,0) MAGJUTL1 ;WIRMFO/JHC VistARad subroutines for RPC calls ; 3 Jul 2013 10:48 AM "RTN","MAGJUTL1",2,0) ;;3.0;IMAGING;**22,18,65,76,101,133**;Mar 19, 2002;Build 5393;Sep 09, 2013 "RTN","MAGJUTL1",3,0) ;; Per VHA Directive 2004-038, this routine should not be modified. "RTN","MAGJUTL1",4,0) ;; +---------------------------------------------------------------+ "RTN","MAGJUTL1",5,0) ;; | Property of the US Government. | "RTN","MAGJUTL1",6,0) ;; | No permission to copy or redistribute this software is given. | "RTN","MAGJUTL1",7,0) ;; | Use of unreleased versions of this software requires the user | "RTN","MAGJUTL1",8,0) ;; | to execute a written test agreement with the VistA Imaging | "RTN","MAGJUTL1",9,0) ;; | Development Office of the Department of Veterans Affairs, | "RTN","MAGJUTL1",10,0) ;; | telephone (301) 734-0100. | "RTN","MAGJUTL1",11,0) ;; | The Food and Drug Administration classifies this software as | "RTN","MAGJUTL1",12,0) ;; | a medical device. As such, it may not be changed in any way. | "RTN","MAGJUTL1",13,0) ;; | Modifications to this software may result in an adulterated | "RTN","MAGJUTL1",14,0) ;; | medical device under 21CFR820, the use of which is considered | "RTN","MAGJUTL1",15,0) ;; | to be a violation of US Federal Statutes. | "RTN","MAGJUTL1",16,0) ;; +---------------------------------------------------------------+ "RTN","MAGJUTL1",17,0) ;; "RTN","MAGJUTL1",18,0) Q "RTN","MAGJUTL1",19,0) ;<*>Notes on possible changes to ^RAO7PC1/1A for fetching rad pkg data: "RTN","MAGJUTL1",20,0) ; 1) Return also: Exam Status IEN, Order Request Urgency, & Pre-Op Date "RTN","MAGJUTL1",21,0) ; 2) Allow to retrieve one specific exam; e.g. modify SETDATA^RAO7PC1A "RTN","MAGJUTL1",22,0) ; to act as a true subrtn, W/ params for RADFN, RADTI, & RACNI--if "RTN","MAGJUTL1",23,0) ; passed, then only the one exam would be returned "RTN","MAGJUTL1",24,0) ; "RTN","MAGJUTL1",25,0) GETEXAM3(DFN,BEGDT,ENDT,MAGRACNT,MAGRET,MORE,LIMEXAMS) ; Get data for all exams for a "RTN","MAGJUTL1",26,0) ; pt within a date range "RTN","MAGJUTL1",27,0) ; limit to LIMEXAMS entries--note, only PREFETCH & Auto-route Priors use this "RTN","MAGJUTL1",28,0) ; Input: "RTN","MAGJUTL1",29,0) ; DFN -- Patient DFN "RTN","MAGJUTL1",30,0) ; BEGDT -- Opt, earliest date desired "RTN","MAGJUTL1",31,0) ; ENDT -- Opt, latest date desired "RTN","MAGJUTL1",32,0) ; MAGRACNT -- Opt, pass by ref to init counter to ref return data in ^TMP (see GETEXSET) "RTN","MAGJUTL1",33,0) ; MORE -- Opt, If True, check for additional exams for pt "RTN","MAGJUTL1",34,0) ; LIMEXAMS -- Opt, limit # exams to return "RTN","MAGJUTL1",35,0) ; Return: "RTN","MAGJUTL1",36,0) ; MAGRACNT -- highest counter for return data "RTN","MAGJUTL1",37,0) ; MAGRET -- 1/0: exam was/not found "RTN","MAGJUTL1",38,0) ; MORE -- more exams exist for pt on & B4 this date "RTN","MAGJUTL1",39,0) ; ^TMP -- data returned (see GETEXSET) "RTN","MAGJUTL1",40,0) ; "RTN","MAGJUTL1",41,0) I '$D(DT) N DIQUIET S DIQUIET=1 D DT^DICRW "RTN","MAGJUTL1",42,0) S LIMEXAMS=+$G(LIMEXAMS) "RTN","MAGJUTL1",43,0) S:$G(BEGDT)="" BEGDT=2010101 S:$G(ENDT)="" ENDT=DT ; default all dates "RTN","MAGJUTL1",44,0) N MORECHK S MORECHK=+$G(MORE) "RTN","MAGJUTL1",45,0) S MAGRACNT=+$G(MAGRACNT),MAGRET=0,MORE=0 ; Init return data "RTN","MAGJUTL1",46,0) I BEGDT>ENDT S X=ENDT,ENDT=BEGDT,BEGDT=X "RTN","MAGJUTL1",47,0) I '(DFN&BEGDT&ENDT) Q "RTN","MAGJUTL1",48,0) K ^TMP($J,"RAE1") D EN1^RAO7PC1(DFN,BEGDT,ENDT,LIMEXAMS) "RTN","MAGJUTL1",49,0) N EXID,TMP,EX1,EX2 S EXID=0 "RTN","MAGJUTL1",50,0) F MAGRET=0:1 S EXID=$O(^TMP($J,"RAE1",DFN,EXID)) Q:'EXID S TMP($P(EXID,"-"),$P(EXID,"-",2))=EXID "RTN","MAGJUTL1",51,0) S (EX1,EX2)="" "RTN","MAGJUTL1",52,0) F S EX1=$O(TMP(EX1)) Q:'EX1 F S EX2=$O(TMP(EX1,EX2)) Q:'EX2 D GETEXSET(DFN,TMP(EX1,EX2),"") "RTN","MAGJUTL1",53,0) K ^TMP($J,"RAE1") "RTN","MAGJUTL1",54,0) I 'MORECHK Q ; all done; else indicate if pt has more exams "RTN","MAGJUTL1",55,0) N DTI,CNI,STS,DTCHK "RTN","MAGJUTL1",56,0) I 'MAGRET S DTI=9999999.9999-BEGDT,CNI=0 ; no exam found in orig dt range "RTN","MAGJUTL1",57,0) E S X=^TMP($J,"MAGRAEX",MAGRACNT,1),DTI=$P(X,U,2),CNI=$P(X,U,3) ; last exam processed "RTN","MAGJUTL1",58,0) ; loop thru addl exams til find one that is NOT Cancelled "RTN","MAGJUTL1",59,0) MORE1 F S CNI=$O(^RADPT(DFN,"DT",DTI,"P",CNI)) Q:'CNI S STS=$P($G(^(CNI,0)),U,3) I STS]"" D Q:MORE "RTN","MAGJUTL1",60,0) . Q:($P($G(^RA(72,STS,0)),U,3)=0) ; Canceled--keep looking "RTN","MAGJUTL1",61,0) . S DTCHK=9999999.9999-DTI D EN1^RAO7PC1(DFN,DTCHK,DTCHK,1) ; verify there is at least one "good" exam for this date (Remedy #200480) "RTN","MAGJUTL1",62,0) . I +$O(^TMP($J,"RAE1",DFN,0)) S MORE=1 "RTN","MAGJUTL1",63,0) . K ^TMP($J,"RAE1") "RTN","MAGJUTL1",64,0) I 'MORE S DTI=$O(^RADPT(DFN,"DT",DTI)),CNI=0 G MORE1:DTI "RTN","MAGJUTL1",65,0) I MORE S MORE=9999999.9999-DTI\1 "RTN","MAGJUTL1",66,0) Q "RTN","MAGJUTL1",67,0) ; "RTN","MAGJUTL1",68,0) GETEXAM2(DFN,DTI,CNI,MAGRACNT,MAGRET) ; Fetch data for one exam "RTN","MAGJUTL1",69,0) ;Input: "RTN","MAGJUTL1",70,0) ; DFN -- Pt DFN "RTN","MAGJUTL1",71,0) ; DTI -- Internal Date pointer to Rad exam "RTN","MAGJUTL1",72,0) ; CNI -- Case pointer to Rad exam "RTN","MAGJUTL1",73,0) ; MAGRACNT -- Opt, pass by ref to init counter for return data in ^TMP (see GETEXSET) "RTN","MAGJUTL1",74,0) ; Return: "RTN","MAGJUTL1",75,0) ; MAGRACNT -- highest counter for return data "RTN","MAGJUTL1",76,0) ; MAGRET -- 1/0: exam was/not found "RTN","MAGJUTL1",77,0) ; ^TMP -- data returned (see GETEXSET) "RTN","MAGJUTL1",78,0) ; "RTN","MAGJUTL1",79,0) ; This subroutine calls RAO7PC1A directly to fetch exam data "RTN","MAGJUTL1",80,0) ; which is returned in ^TMP($J,"RAE1",DFN,DTI_"-"_CNI). "RTN","MAGJUTL1",81,0) ; RAO7PC1A currently returns ALL exams filed under one DTI, "RTN","MAGJUTL1",82,0) ; but this subroutine returns the single exam for the input DTI, CNI "RTN","MAGJUTL1",83,0) ; "RTN","MAGJUTL1",84,0) N RADFN,RACNT,RAIBDT,RAEXN,RAXIT ; Vars input to RAO7PC1A "RTN","MAGJUTL1",85,0) S RADFN=DFN,RACNT=0,RAIBDT=DTI,RAEXN=0,RAXIT=0 "RTN","MAGJUTL1",86,0) ; other Vars set by RAO7PC1A: "RTN","MAGJUTL1",87,0) N RABNOR,RACSE,RADIAG,RANO,RAPRC,RAREX,RARPT,RARPTST,RASTNM,RAXAM,RAXID "RTN","MAGJUTL1",88,0) N RABNORMR,RACPT "RTN","MAGJUTL1",89,0) S MAGRACNT=+$G(MAGRACNT) "RTN","MAGJUTL1",90,0) K ^TMP($J,"RAE1") D SETDATA^RAO7PC1A "RTN","MAGJUTL1",91,0) S MAGRET=RACNT Q:'RACNT ; no exams found "RTN","MAGJUTL1",92,0) D GETEXSET(DFN,DTI_"-"_CNI,.X) "RTN","MAGJUTL1",93,0) I 'X S MAGRET=0 ; no exam for this CNI "RTN","MAGJUTL1",94,0) K ^TMP($J,"RAE1") "RTN","MAGJUTL1",95,0) Q "RTN","MAGJUTL1",96,0) ; "RTN","MAGJUTL1",97,0) GETEXSET(RADFN,EXID,MAGRET) ; "RTN","MAGJUTL1",98,0) ; Used by GETEXAM* subroutines above to set up rad data for vrad "RTN","MAGJUTL1",99,0) ; Input: "RTN","MAGJUTL1",100,0) ; RADFN -- Pt DFN "RTN","MAGJUTL1",101,0) ; EXID --- RADTI_"-"_RACNI, pointers to Rad exam "RTN","MAGJUTL1",102,0) ; Output: "RTN","MAGJUTL1",103,0) ; MAGRET- 1/0: an exam was/was not filed "RTN","MAGJUTL1",104,0) ; ^TMP($J,"MAGRAEX",MAGRACNT)=Data String (see code at end) "RTN","MAGJUTL1",105,0) ; MAGRACNT described in above subroutines "RTN","MAGJUTL1",106,0) ; "RTN","MAGJUTL1",107,0) N RACN,RACNI,RADATA,RADATE,RADTE,RADTI,RADTPRT,RAELOC,RANME "RTN","MAGJUTL1",108,0) N RAPRC,RARPT,RASSN,RAST,RASTORD,RASTP,RASTNM,RACPT,IMTYPABB,PROCMOD "RTN","MAGJUTL1",109,0) N DAYCASE,REQLOC,REQLOCN,REQLOCA,REQLOCT,RIST,RIST1,RIST2,COMPLIC "RTN","MAGJUTL1",110,0) N RADIV,RISTISME,REQWARD,RASTCAT,CPTMOD,LRFLAG,MODTXT,LONGACN,TECH "RTN","MAGJUTL1",111,0) N MEDS,RDIOPHARM "RTN","MAGJUTL1",112,0) S MAGRET=0,RADTI=$P(EXID,"-"),RACNI=$P(EXID,"-",2) "RTN","MAGJUTL1",113,0) Q:'(RADTI&RACNI) "RTN","MAGJUTL1",114,0) S RADIV="" "RTN","MAGJUTL1",115,0) S RADATA=$G(^TMP($J,"RAE1",RADFN,EXID)) "RTN","MAGJUTL1",116,0) Q:RADATA="" ; no exam for this EXID "RTN","MAGJUTL1",117,0) S RARPT=$P(RADATA,U,5) "RTN","MAGJUTL1",118,0) S X=$P(RADATA,U,6),RASTORD=$P(X,"~"),RASTNM=$P(X,"~",2) "RTN","MAGJUTL1",119,0) S X=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),COMPLIC=$D(^("COMP")),PROCMOD=$D(^("M")),CPTMOD=$D(^("CMOD")),TECH=$D(^("TC")),MEDS=$D(^("RX")) ; ICR #1172 (Private) "RTN","MAGJUTL1",120,0) S RAST=$P(X,U,3),REQLOC=$P(X,U,22),RIST1=$P(X,U,12),RIST2=$P(X,U,15),COMPLIC=$P(X,U,16)_"~"_COMPLIC "RTN","MAGJUTL1",121,0) S REQWARD=$P(X,U,6),LONGACN=$P(X,U,31),RDIOPHARM=$P(X,U,28) ; ICR #1172 (Private) "RTN","MAGJUTL1",122,0) N CT,MODS,IEN,TT ; Process Proc/CPT Modifier info "RTN","MAGJUTL1",123,0) S CT=0 "RTN","MAGJUTL1",124,0) I PROCMOD D "RTN","MAGJUTL1",125,0) . S IEN=0 "RTN","MAGJUTL1",126,0) . F S IEN=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"M",IEN)) Q:'IEN S X=$P($G(^(IEN,0)),U) I X D "RTN","MAGJUTL1",127,0) . . S X=$P($G(^RAMIS(71.2,X,0)),U) Q:X="" S X=$$TRIM(X) "RTN","MAGJUTL1",128,0) . . S X=$S(X="BILATERAL EXAM":"BILAT",1:X) "RTN","MAGJUTL1",129,0) . . S CT=CT+1,MODS(CT)=X "RTN","MAGJUTL1",130,0) I CPTMOD D "RTN","MAGJUTL1",131,0) . S IEN=0 "RTN","MAGJUTL1",132,0) . F S IEN=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",IEN)) Q:'IEN S X=$P($G(^(IEN,0)),U) I X D "RTN","MAGJUTL1",133,0) . . S X=$P($$MOD^ICPTMOD(X,"I"),U,3) Q:X="" S X=$$TRIM(X) "RTN","MAGJUTL1",134,0) . . S X=$S(X="LEFT SIDE":"LEFT",X="RIGHT SIDE":"RIGHT",X="BILATERAL PROCEDURE":"BILAT",1:X) "RTN","MAGJUTL1",135,0) . . S CT=CT+1,MODS(CT)=X "RTN","MAGJUTL1",136,0) S MODTXT="",LRFLAG=0 K TT "RTN","MAGJUTL1",137,0) I CT F I=1:1:CT S X=MODS(I) D "RTN","MAGJUTL1",138,0) . ; eliminate redundant values for L/R/Bilat (TT), & track L/R for prior matching (LRFLAG) "RTN","MAGJUTL1",139,0) . S T=(X="LEFT") I T,$D(TT(1)) Q ; already got it "RTN","MAGJUTL1",140,0) . I 'T S T=(X="RIGHT") I T S T=2 I T,$D(TT(2)) Q ; ditto "RTN","MAGJUTL1",141,0) . I 'T S T=(X="BILAT") I T S T=3 I T,$D(TT(3)) Q ; ditto "RTN","MAGJUTL1",142,0) . I T S TT(T)="",MODTXT=X_$S(MODTXT="":"",1:";")_MODTXT ; force L/R/Bilat to left end of string .. "RTN","MAGJUTL1",143,0) . E S MODTXT=MODTXT_$S(MODTXT="":"",1:";")_X ; .. so is easier to spot in displayed column "RTN","MAGJUTL1",144,0) . I 'LRFLAG S:T LRFLAG=T "RTN","MAGJUTL1",145,0) . E I T S:(LRFLAG'=T) LRFLAG=3 ; L&R or Bilat--ignore result "RTN","MAGJUTL1",146,0) S LRFLAG=$S(LRFLAG=1:"L",LRFLAG=2:"R",1:"") ; Left/Right indicator "RTN","MAGJUTL1",147,0) I 'TECH S TECH="" "RTN","MAGJUTL1",148,0) E D "RTN","MAGJUTL1",149,0) . S IEN=0,TECH="" N T "RTN","MAGJUTL1",150,0) . F S IEN=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",IEN)) Q:'IEN S X=$P($G(^(IEN,0)),U) I X S T(X)="" "RTN","MAGJUTL1",151,0) . I $D(T) S T="" F S T=$O(T(T)) Q:T="" S X=$P($G(^VA(200,T,0)),U,2) I X]"" S TECH=TECH_$S(TECH="":"",1:"~")_X "RTN","MAGJUTL1",152,0) S RADIV=$P(^RADPT(RADFN,"DT",RADTI,0),U,3) "RTN","MAGJUTL1",153,0) K DIC,DR,DA,DIQ "RTN","MAGJUTL1",154,0) I 'REQLOC S (REQLOCN,REQLOCT,REQLOCA)="" "RTN","MAGJUTL1",155,0) E D "RTN","MAGJUTL1",156,0) . S X=$G(^SC(REQLOC,0)),REQLOCN=$P(X,U),REQLOCA=$P(X,U,2) "RTN","MAGJUTL1",157,0) . S:REQLOCA="" REQLOCA=REQLOCN "RTN","MAGJUTL1",158,0) . S DIC="44",DR="2",DA=REQLOC,DIQ="REQLOCT" D EN^DIQ1 K DIC,DR,DA,DIQ "RTN","MAGJUTL1",159,0) . S REQLOCT=REQLOCT(44,REQLOC,2) "RTN","MAGJUTL1",160,0) I REQWARD]"" S DIC="42",DR=".01",DA=REQWARD,DIQ="REQWARD" D EN^DIQ1 K DIC,DR,DA,DIQ S REQWARD=REQWARD(42,REQWARD,.01) "RTN","MAGJUTL1",161,0) S X=$$RIST(RIST1,RIST2),RIST=$P(X,U),RISTISME=$P(X,U,2) "RTN","MAGJUTL1",162,0) S RADTE=9999999.9999-RADTI,(RADTPRT,Y)=RADTE D D^RAUTL S RADATE=Y "RTN","MAGJUTL1",163,0) S RADTPRT=$E(RADTPRT,4,5)_"/"_$E(RADTPRT,6,7)_"/"_$E(RADTPRT,2,3) "RTN","MAGJUTL1",164,0) S RAPRC=$E($P(RADATA,U),1,40),RACN=$P(RADATA,U,2),RAELOC=$P(RADATA,U,7) "RTN","MAGJUTL1",165,0) S IMTYPABB=$P($P(RADATA,U,8),"~"),RACPT=$P(RADATA,U,10) "RTN","MAGJUTL1",166,0) S DAYCASE=$E(RADTE,4,7)_$E(RADTE,2,3)_"-"_RACN "RTN","MAGJUTL1",167,0) I LONGACN]"" S DAYCASE=LONGACN "RTN","MAGJUTL1",168,0) S RASTP=RASTNM,RASTCAT="" "RTN","MAGJUTL1",169,0) I RAST S RASTCAT=$P($G(^RA(72,RAST,0)),U,9) "RTN","MAGJUTL1",170,0) S RANME=$P(^DPT(RADFN,0),U) "RTN","MAGJUTL1",171,0) S DFN=RADFN D PID^VADPT6 S RASSN=$S(VAERR:"Unknown",1:VA("PID")) "RTN","MAGJUTL1",172,0) K VA("PID"),VA("BID"),VAERR "RTN","MAGJUTL1",173,0) S MAGRACNT=$G(MAGRACNT)+1 "RTN","MAGJUTL1",174,0) I MAGRACNT=1 K ^TMP($J,"MAGRAEX") "RTN","MAGJUTL1",175,0) S ^TMP($J,"MAGRAEX",MAGRACNT,1)=RADFN_U_RADTI_U_RACNI_U_$E(RANME,1,30)_U_RASSN_U_RADATE_U_RADTE_U_RACN_U_$E(RAPRC,1,35)_U_RARPT_U_RAST_U_DAYCASE_U_RAELOC_U_RASTP_U_RASTORD_U_RADTPRT_U_RACPT_U_IMTYPABB "RTN","MAGJUTL1",176,0) S ^TMP($J,"MAGRAEX",MAGRACNT,2)=REQLOCA_U_$E(REQLOCN,1,25)_U_RIST_U_COMPLIC_U_RADIV_U_$P($$IMGSIT(RADIV),U,2)_U_RISTISME_U_MODTXT_U_REQLOCT_U_REQWARD_U_RASTCAT_U_LRFLAG_U_TECH_U_MEDS_U_RDIOPHARM "RTN","MAGJUTL1",177,0) S MAGRET=1 "RTN","MAGJUTL1",178,0) Q "RTN","MAGJUTL1",179,0) ; "RTN","MAGJUTL1",180,0) RIST(RIST1,RIST2) ; return Interp Radiologist info "RTN","MAGJUTL1",181,0) S RIST1=$G(RIST1),RIST2=$G(RIST2) "RTN","MAGJUTL1",182,0) N RIST,RISTISME "RTN","MAGJUTL1",183,0) S (RIST,RISTISME)="" "RTN","MAGJUTL1",184,0) I RIST1!RIST2 D "RTN","MAGJUTL1",185,0) . I RIST1 S RISTISME=RIST1 S RIST=$$USERINF^MAGJUTL3(RIST1,1) "RTN","MAGJUTL1",186,0) . I RIST2 S RISTISME=$S('RISTISME:RIST2,1:RISTISME_"~"_RIST2) S RIST2=$$USERINF^MAGJUTL3(RIST2,1) "RTN","MAGJUTL1",187,0) . I RIST]"" S RIST=RIST_$S(RIST2]"":"/"_RIST2,1:"") "RTN","MAGJUTL1",188,0) . E S RIST=RIST2 "RTN","MAGJUTL1",189,0) Q RIST_U_RISTISME "RTN","MAGJUTL1",190,0) ; "RTN","MAGJUTL1",191,0) IMGSIT(DIV,DFLT) ; Return Imaging Site code for input Division "RTN","MAGJUTL1",192,0) ; From 2006.1: IEN ^ Site Code ^ Parent_DIV "RTN","MAGJUTL1",193,0) I DIV]"" D "RTN","MAGJUTL1",194,0) . N IEN I $D(^MAG(2006.1,"B",DIV)) S IEN=$O(^(DIV,"")) I IEN "RTN","MAGJUTL1",195,0) . E I $G(DFLT) S IEN=$O(^MAG(2006.1,0)) ; Dflt to 1st if requested "RTN","MAGJUTL1",196,0) . E S X="" Q "RTN","MAGJUTL1",197,0) . S X=^MAG(2006.1,IEN,0),X=IEN_U_$P(X,U,9)_U_$P(X,U) "RTN","MAGJUTL1",198,0) Q X "RTN","MAGJUTL1",199,0) ; "RTN","MAGJUTL1",200,0) TRIM(X) ; Trim trailing spaces from X "RTN","MAGJUTL1",201,0) I $G(X)]"" D "RTN","MAGJUTL1",202,0) . F I=$L(X):-1:0 I $E(X,I)'=" " Q "RTN","MAGJUTL1",203,0) . I I S X=$E(X,1,I) "RTN","MAGJUTL1",204,0) . E S X="" "RTN","MAGJUTL1",205,0) Q:$Q X Q "RTN","MAGJUTL1",206,0) ; "RTN","MAGJUTL1",207,0) END Q ; "RTN","MAGJUTL3") 0^7^B139481284 "RTN","MAGJUTL3",1,0) MAGJUTL3 ;WIRMFO/JHC - VistARad subrtns & RPCs ; 29 Mar 2013 5:02 PM "RTN","MAGJUTL3",2,0) ;;3.0;IMAGING;**16,9,22,18,65,76,101,90,120,133**;Mar 19, 2002;Build 5393;Sep 09, 2013 "RTN","MAGJUTL3",3,0) ;; Per VHA Directive 2004-038, this routine should not be modified. "RTN","MAGJUTL3",4,0) ;; +---------------------------------------------------------------+ "RTN","MAGJUTL3",5,0) ;; | Property of the US Government. | "RTN","MAGJUTL3",6,0) ;; | No permission to copy or redistribute this software is given. | "RTN","MAGJUTL3",7,0) ;; | Use of unreleased versions of this software requires the user | "RTN","MAGJUTL3",8,0) ;; | to execute a written test agreement with the VistA Imaging | "RTN","MAGJUTL3",9,0) ;; | Development Office of the Department of Veterans Affairs, | "RTN","MAGJUTL3",10,0) ;; | telephone (301) 734-0100. | "RTN","MAGJUTL3",11,0) ;; | The Food and Drug Administration classifies this software as | "RTN","MAGJUTL3",12,0) ;; | a medical device. As such, it may not be changed in any way. | "RTN","MAGJUTL3",13,0) ;; | Modifications to this software may result in an adulterated | "RTN","MAGJUTL3",14,0) ;; | medical device under 21CFR820, the use of which is considered | "RTN","MAGJUTL3",15,0) ;; | to be a violation of US Federal Statutes. | "RTN","MAGJUTL3",16,0) ;; +---------------------------------------------------------------+ "RTN","MAGJUTL3",17,0) ;; "RTN","MAGJUTL3",18,0) Q "RTN","MAGJUTL3",19,0) ;RPC Entry points: "RTN","MAGJUTL3",20,0) ; LISTINF--Custom list info "RTN","MAGJUTL3",21,0) ; LOGOFF--update session file "RTN","MAGJUTL3",22,0) ; CACHEQ--init session data "RTN","MAGJUTL3",23,0) ; PINF1--Patient info "RTN","MAGJUTL3",24,0) ; USERINF2--P18 inits for the session "RTN","MAGJUTL3",25,0) ;Subrtn EPs: "RTN","MAGJUTL3",26,0) ; LOG--Upd image access log "RTN","MAGJUTL3",27,0) ; MAGJOBNC--inits for non-client sessions "RTN","MAGJUTL3",28,0) ; USERKEYS--user key info "RTN","MAGJUTL3",29,0) ; USERINF--user info "RTN","MAGJUTL3",30,0) ; "RTN","MAGJUTL3",31,0) LISTINF(MAGGRY) ; RPC: MAGJ CUSTOM LISTS "RTN","MAGJUTL3",32,0) ; get Exam List data "RTN","MAGJUTL3",33,0) ; Return in ^TMP($J,"MAGJLSTINF",0:N) "RTN","MAGJUTL3",34,0) ; 0)= # Entries below (0:n) "RTN","MAGJUTL3",35,0) ; 1:n)= Button Label^List #^Button Hints^List Type "RTN","MAGJUTL3",36,0) ; "RTN","MAGJUTL3",37,0) ; MAGGRY holds $NA ref to ^TMP for return message "RTN","MAGJUTL3",38,0) ; all refs to MAGGRY use SS indirection "RTN","MAGJUTL3",39,0) ; "RTN","MAGJUTL3",40,0) ; GLB has $NA ref to ^MAG(2006.631), Custom Lists "RTN","MAGJUTL3",41,0) ; refs to GLB use SS indirection to get data from this file "RTN","MAGJUTL3",42,0) ; "RTN","MAGJUTL3",43,0) S X="ERR1^MAGJUTL3",@^%ZOSF("TRAP") "RTN","MAGJUTL3",44,0) N D0,GLB,INF,MAGLST,NAM,T "RTN","MAGJUTL3",45,0) S MAGLST="MAGJLSTINF" "RTN","MAGJUTL3",46,0) K MAGGRY S MAGGRY=$NA(^TMP($J,MAGLST)) K @MAGGRY S @MAGGRY@(0)=0 "RTN","MAGJUTL3",47,0) S GLB=$NA(^MAG(2006.631)),NAM="" "RTN","MAGJUTL3",48,0) F S NAM=$O(@GLB@("B",NAM)) Q:NAM="" S D0="" D "RTN","MAGJUTL3",49,0) . S D0=$O(@GLB@("B",NAM,D0)) Q:'D0 D "RTN","MAGJUTL3",50,0) . . S X=$G(@GLB@(D0,0)) Q:($P(X,U,2)>9000)!'$P(X,U,6) ; List Active & User-defined "RTN","MAGJUTL3",51,0) . . S INF="" F I=1:1 S T=$P("7^2^1^3",U,I) Q:T="" S Y=$P(X,U,T) Q:Y="" S $P(INF,U,I)=Y "RTN","MAGJUTL3",52,0) . . Q:T'="" ; req'd fields not all there "RTN","MAGJUTL3",53,0) . . S T=@MAGGRY@(0)+1,^(0)=T,^(T)=INF ; add entry to reply "RTN","MAGJUTL3",54,0) Q "RTN","MAGJUTL3",55,0) ; "RTN","MAGJUTL3",56,0) LOG(ACTION,LOGDATA,PSETLST) ; Log exam access "RTN","MAGJUTL3",57,0) ; ACTION --- Action code string passed in (e.g. VR-VW for vrad view) "RTN","MAGJUTL3",58,0) ; LOGDATA - ^-delimited fields--see code immediately below "RTN","MAGJUTL3",59,0) ; PSETLST -- For Printset exams, has list of Rad Case Numbers included "RTN","MAGJUTL3",60,0) ; "RTN","MAGJUTL3",61,0) N PTCT,TXT,RADFN,MAGIEN,NIMGS,REMOTE,PRTSET "RTN","MAGJUTL3",62,0) S RADFN=$P(LOGDATA,U),MAGIEN=$P(LOGDATA,U,2),NIMGS=$P(LOGDATA,U,3),REMOTE=$P(LOGDATA,U,4) "RTN","MAGJUTL3",63,0) ; "RTN","MAGJUTL3",64,0) ; For Printset, append string to TXT "RTN","MAGJUTL3",65,0) ; string= "|VR-PRINTSET~"_CaseNum_~x~y ; x = nth; y = total PrtSet members "RTN","MAGJUTL3",66,0) ; "RTN","MAGJUTL3",67,0) S PSETLST=$G(PSETLST) "RTN","MAGJUTL3",68,0) S PRTSET=$L(PSETLST,U) "RTN","MAGJUTL3",69,0) I PRTSET>1 D "RTN","MAGJUTL3",70,0) . N I,T F I=1:1:PRTSET S T=$P(PSETLST,U,I),T=$P(T,"-",$L(T,"-")),PRTSET(I)="VR-PRINTSET~"_T_"~"_I_"~"_PRTSET "RTN","MAGJUTL3",71,0) I ACTION="" S ACTION="UNKNOWN" ; Should never happen "RTN","MAGJUTL3",72,0) S PTCT=RADFN'=$G(MAGJOB("LASTPT",ACTION)) "RTN","MAGJUTL3",73,0) I PTCT S MAGJOB("LASTPT",ACTION)=RADFN "RTN","MAGJUTL3",74,0) S TXT=ACTION_U_RADFN_U_MAGIEN_U_U_U_NIMGS "RTN","MAGJUTL3",75,0) S TXT=TXT_U_PTCT_U_$S(+MAGJOB("USER",1):1,1:0)_U_REMOTE "RTN","MAGJUTL3",76,0) ; "RTN","MAGJUTL3",77,0) ;=== Log to Imaging Windows Sessions file (#2006.82). "RTN","MAGJUTL3",78,0) ; for PRTSET members 2 to N (prevent double-counting): "RTN","MAGJUTL3",79,0) ; set NIMGS = 0 "RTN","MAGJUTL3",80,0) ; set PTCT to FALSE "RTN","MAGJUTL3",81,0) ; "RTN","MAGJUTL3",82,0) I PRTSET>1 N I F I=1:1:PRTSET D "RTN","MAGJUTL3",83,0) . I I>1 S $P(TXT,U,6)=0,$P(TXT,U,7)=0 "RTN","MAGJUTL3",84,0) . D ACTION^MAGGTAU(TXT_"|"_PRTSET(I),1) "RTN","MAGJUTL3",85,0) E D ACTION^MAGGTAU(TXT,1) "RTN","MAGJUTL3",86,0) ; "RTN","MAGJUTL3",87,0) ;=== Log to Mag Log "RTN","MAGJUTL3",88,0) ; For Printset, add string to new Param-7 prior to calling ENTRY... "RTN","MAGJUTL3",89,0) ; string= s/a above, but no pipe char. "RTN","MAGJUTL3",90,0) ; for PRTSET members 2 to N set NIMGS = 0 to not double-count "RTN","MAGJUTL3",91,0) ; "RTN","MAGJUTL3",92,0) I REMOTE S ACTION=ACTION_"/REM" "RTN","MAGJUTL3",93,0) I PRTSET>1 N I F I=1:1:PRTSET D "RTN","MAGJUTL3",94,0) . I I>1 S NIMGS=0 "RTN","MAGJUTL3",95,0) . D ENTRY^MAGLOG(ACTION,+DUZ,MAGIEN,"VRAD:"_MAGJOB("VRVERSION"),RADFN,NIMGS,PRTSET(I)) "RTN","MAGJUTL3",96,0) E D ENTRY^MAGLOG(ACTION,+DUZ,MAGIEN,"VRAD:"_MAGJOB("VRVERSION"),RADFN,NIMGS) "RTN","MAGJUTL3",97,0) Q "RTN","MAGJUTL3",98,0) ; "RTN","MAGJUTL3",99,0) LOGOFF(MAGGRY,DATA) ; RPC: MAGJ LOGOFF "RTN","MAGJUTL3",100,0) ; "RTN","MAGJUTL3",101,0) ;=== Update Imaging Windows Sessions file: logoff time & session entry closed. "RTN","MAGJUTL3",102,0) D LOGOFF^MAGGTAU(.MAGGRY) "RTN","MAGJUTL3",103,0) Q "RTN","MAGJUTL3",104,0) ; "RTN","MAGJUTL3",105,0) CACHEQ(MAGGRY,DATA) ; RPC: MAGJ CACHELOCATION "RTN","MAGJUTL3",106,0) ; some logon inits & get alternate paths for Remote Reading "RTN","MAGJUTL3",107,0) ; input in DATA: "RTN","MAGJUTL3",108,0) ; - WSLOC = WS Loc'n "RTN","MAGJUTL3",109,0) ; - VRADVER = Client Vs -- p32 ONLY "RTN","MAGJUTL3",110,0) ; - OSVER = Client OS Vs -- p32 ONLY "RTN","MAGJUTL3",111,0) ; Return in ^TMP($J,"MAGJCACHE",0:N) (@MAGGRY) "RTN","MAGJUTL3",112,0) ; 0)= # Entries below (0:n) "RTN","MAGJUTL3",113,0) ; 1:n)= PhysName^Subdirectory^HashFlag^Username^Password^AltPath_IEN "RTN","MAGJUTL3",114,0) ; "RTN","MAGJUTL3",115,0) ; MAGGRY holds $NA reference to ^TMP for return message "RTN","MAGJUTL3",116,0) ; refs to MAGGRY use SS indirection "RTN","MAGJUTL3",117,0) ; "RTN","MAGJUTL3",118,0) ; Also builds local array: p32/p18 compatibility: Some of this is moved to userinf2 below "RTN","MAGJUTL3",119,0) ; MAGJOB("LOC",NetworkLocnIEN)=Site Abbrev "RTN","MAGJUTL3",120,0) ; ("REMOTE")=1/0 (T/F for "User is Remote") "RTN","MAGJUTL3",121,0) ; ("REMOTESCREEN")=0/1 (init User-switchable Remote Screening--P18 use only) "RTN","MAGJUTL3",122,0) ; ("WSLOC")=WS Loc'n String "RTN","MAGJUTL3",123,0) ; ("WSLOCTYP")=WS Loc'n Type "RTN","MAGJUTL3",124,0) ; ("WSNAME")=WS ID "RTN","MAGJUTL3",125,0) ; ("VRVERSION")=VRAD Vs "RTN","MAGJUTL3",126,0) ; ("OSVER")=O/S Vs "RTN","MAGJUTL3",127,0) ; ("ALTPATH")=1/0 ^ 1/0 (T/F Alt Paths are defined "RTN","MAGJUTL3",128,0) ; ^ Alt Paths Enabled/Disabled for most recent exam) "RTN","MAGJUTL3",129,0) ; "RTN","MAGJUTL3",130,0) S X="ERR1^MAGJUTL3",@^%ZOSF("TRAP") "RTN","MAGJUTL3",131,0) ; "RTN","MAGJUTL3",132,0) N I,MAGLST,REPLY,TMP,WSLOC,XX,VRADVER,OSVER,DIQUIET,ALTIEN "RTN","MAGJUTL3",133,0) S DIQUIET=1 D DT^DICRW "RTN","MAGJUTL3",134,0) S REPLY=0,MAGLST="MAGJCACHE" "RTN","MAGJUTL3",135,0) K MAGGRY S MAGGRY=$NA(^TMP($J,MAGLST)) K @MAGGRY "RTN","MAGJUTL3",136,0) S WSLOC=$$UPCASE($P(DATA,U)),VRADVER=$P(DATA,U,2),OSVER=$P(DATA,U,3) "RTN","MAGJUTL3",137,0) I '$D(MAGJOB("OSVER")) D ; ID p32 initialization "RTN","MAGJUTL3",138,0) . S MAGJOB("OSVER")=$S(OSVER]"":OSVER,1:"UNK") "RTN","MAGJUTL3",139,0) . S MAGJOB("VRVERSION")=$S(VRADVER]"":VRADVER,1:"UNK") "RTN","MAGJUTL3",140,0) . D MAGJOB ; p32 init of VRAD "RTN","MAGJUTL3",141,0) ; get alt paths location info "RTN","MAGJUTL3",142,0) S MAGJOB("WSLOC")=WSLOC,MAGJOB("REMOTE")=0 "RTN","MAGJUTL3",143,0) S MAGJOB("REMOTESCREEN")=+$P($G(^MAG(2006.69,1,0)),U,10) "RTN","MAGJUTL3",144,0) I WSLOC]"" D "RTN","MAGJUTL3",145,0) . S X=$P($G(^MAG(2006.1,+MAGJOB("SITEP"),0)),U,9) "RTN","MAGJUTL3",146,0) . I X]"",(X'=WSLOC) S MAGJOB("REMOTE")=1 "RTN","MAGJUTL3",147,0) . E Q "RTN","MAGJUTL3",148,0) . D LIST^MAGBRTLD(WSLOC,.TMP) "RTN","MAGJUTL3",149,0) . I TMP S REPLY=TMP,MAGJOB("ALTPATH")=$G(MAGJOB("ALTPATH"),"1^1") F I=1:1:TMP D "RTN","MAGJUTL3",150,0) . . S ALTIEN=$P(TMP(I),U,7) "RTN","MAGJUTL3",151,0) . . S XX=$P(TMP(I),U,1,5),X=$P(XX,U,3),$P(XX,U,3)=$S(X="Y":1,1:0) "RTN","MAGJUTL3",152,0) . . S X=$P(XX,U,4),$P(XX,U,4)=$P(XX,U,5),$P(XX,U,5)=X,$P(XX,U,6)=ALTIEN "RTN","MAGJUTL3",153,0) . . S @MAGGRY@(I)=XX,MAGJOB("LOC",ALTIEN)=$P(TMP(I),U,6) "RTN","MAGJUTL3",154,0) I '$D(MAGJOB("ALTPATH")) S MAGJOB("ALTPATH")="0^0" "RTN","MAGJUTL3",155,0) S @MAGGRY@(0)=REPLY "RTN","MAGJUTL3",156,0) CACHEQZ Q "RTN","MAGJUTL3",157,0) ; "RTN","MAGJUTL3",158,0) MAGJOBNC ; EP for Prefetch/Bkgnd calls (NOT a Vrad Client) "RTN","MAGJUTL3",159,0) N NOTCLIEN S NOTCLIEN=1 "RTN","MAGJUTL3",160,0) D MAGJOB "RTN","MAGJUTL3",161,0) Q "RTN","MAGJUTL3",162,0) ; "RTN","MAGJUTL3",163,0) MAGJOB ; Init magjob array "RTN","MAGJUTL3",164,0) N T,RIST "RTN","MAGJUTL3",165,0) I $G(MAGJOB("VRVERSION")) S X=MAGJOB("VRVERSION") "RTN","MAGJUTL3",166,0) E S X="" ; non-client processes assume post-P32 logic "RTN","MAGJUTL3",167,0) S MAGJOB("P32")=(X="3.0.41.17") ; P32 Client? "RTN","MAGJUTL3",168,0) I MAGJOB("P32") D P32STOP^MAGJUTL5(.X) S MAGJOB("P32STOP")=X ; STOP support when P76 releases "RTN","MAGJUTL3",169,0) D USERKEYS "RTN","MAGJUTL3",170,0) S MAGJOB("CONSOLIDATED")=($G(^MAG(2006.1,"CONSOLIDATED"))="YES") "RTN","MAGJUTL3",171,0) S MAGJOB("SITEP")=$$IMGSIT^MAGJUTL1(DUZ(2),1) ; Site Param ien "RTN","MAGJUTL3",172,0) S RIST="" F X="S","R" I $D(^VA(200,"ARC",X,DUZ)) S RIST=X Q "RTN","MAGJUTL3",173,0) S RIST=$S(RIST="S":15,RIST="R":12,1:0) ; Staff/Resident/Non rist "RTN","MAGJUTL3",174,0) S MAGJOB("USER",1)=RIST_U_$$USERINF(+DUZ,".01;1") ; RIST_Type^NAME^INI "RTN","MAGJUTL3",175,0) S X=$P($G(IO("CLNM")),"."),MAGJOB("WSNAME")=$S(X]"":X,1:"VistaradWS") "RTN","MAGJUTL3",176,0) K MAGJOB("DIVSCRN") I MAGJOB("CONSOLIDATED") D "RTN","MAGJUTL3",177,0) . ; include logon DIV, other DIVs to screen Unread Lists & Locking "RTN","MAGJUTL3",178,0) . I $G(DUZ(2))]"" S MAGJOB("DIVSCRN",DUZ(2))="" "RTN","MAGJUTL3",179,0) . S DIV="" "RTN","MAGJUTL3",180,0) . I DUZ(2)'=$P(MAGJOB("SITEP"),U,3) D ; Assoc DIV "RTN","MAGJUTL3",181,0) . . S IEN=$O(^MAG(2006.1,+MAGJOB("SITEP"),"INSTS","B",DUZ(2),0)) "RTN","MAGJUTL3",182,0) . . I IEN F S DIV=$O(^MAG(2006.1,+MAGJOB("SITEP"),"INSTS",IEN,201,"B",DIV)) Q:'DIV S MAGJOB("DIVSCRN",DIV)="" "RTN","MAGJUTL3",183,0) . E D ; Parent DIV "RTN","MAGJUTL3",184,0) . . F S DIV=$O(^MAG(2006.1,+MAGJOB("SITEP"),201,"B",DIV)) Q:'DIV S MAGJOB("DIVSCRN",DIV)="" "RTN","MAGJUTL3",185,0) S MAGJOB("WSLOCTYP")=$S(+MAGJOB("USER",1):"RAD",1:"Non-Rad") ; USer is Rist/Not "RTN","MAGJUTL3",186,0) I '$D(MAGJOB("WRKSIEN")) D "RTN","MAGJUTL3",187,0) . Q:+$G(NOTCLIEN) ; proceed only if Vrad Client is attached "RTN","MAGJUTL3",188,0) . S X=MAGJOB("WSNAME") "RTN","MAGJUTL3",189,0) . S $P(X,U,4)=MAGJOB("WSLOCTYP") "RTN","MAGJUTL3",190,0) . S $P(X,U,8)=1 ; StartupMode=Normal. "RTN","MAGJUTL3",191,0) . S $P(X,U,9)=MAGJOB("OSVER") "RTN","MAGJUTL3",192,0) . S $P(X,U,10)=MAGJOB("VRVERSION") "RTN","MAGJUTL3",193,0) . S $P(X,U,17)=MAGJOB("VRBLDDTTM") "RTN","MAGJUTL3",194,0) . D UPD^MAGGTAU(.Y,X) "RTN","MAGJUTL3",195,0) . D REMLOCK^MAGJEX1B ; put here to only run 1x/ login "RTN","MAGJUTL3",196,0) Q "RTN","MAGJUTL3",197,0) ; "RTN","MAGJUTL3",198,0) USERINF(DUZ,FLDS) ; get data from user file "RTN","MAGJUTL3",199,0) I FLDS=""!'DUZ Q "" "RTN","MAGJUTL3",200,0) N I,RSL,T S RSL="" "RTN","MAGJUTL3",201,0) D GETS^DIQ(200,+DUZ,FLDS,"E","T") "RTN","MAGJUTL3",202,0) S T=+DUZ_"," "RTN","MAGJUTL3",203,0) F I=1:1:$L(FLDS,";") S RSL=RSL_$S(RSL="":"",1:U)_T(200,T,$P(FLDS,";",I),"E") "RTN","MAGJUTL3",204,0) Q RSL "RTN","MAGJUTL3",205,0) ; "RTN","MAGJUTL3",206,0) USERKEYS ; Store Security Keys in MagJob "RTN","MAGJUTL3",207,0) N I,X,Y "RTN","MAGJUTL3",208,0) N MAGKS ; keys to send to XUS KEY CHECK "RTN","MAGJUTL3",209,0) N MAGKG ; returned "RTN","MAGJUTL3",210,0) K MAGJOB("KEYS") "RTN","MAGJUTL3",211,0) S X="MAGJ",I=0 "RTN","MAGJUTL3",212,0) F S X=$O(^XUSEC(X)) Q:$E(X,1,4)'="MAGJ" D "RTN","MAGJUTL3",213,0) . S I=I+1,MAGKS(I)=X "RTN","MAGJUTL3",214,0) I '$D(MAGKS) Q "RTN","MAGJUTL3",215,0) D OWNSKEY^XUSRB(.MAGKG,.MAGKS) "RTN","MAGJUTL3",216,0) S I=0 F S I=$O(MAGKG(I)) Q:'I I MAGKG(I) S MAGJOB("KEYS",MAGKS(I))="" "RTN","MAGJUTL3",217,0) Q "RTN","MAGJUTL3",218,0) ; "RTN","MAGJUTL3",219,0) PINF1(MAGGRY,MAGDFN) ;RPC Call MAGJ PT INFO -- Get pt info "RTN","MAGJUTL3",220,0) N AGE,DFN,DOB,MAGSSN,X "RTN","MAGJUTL3",221,0) S X="ERR3^MAGJUTL3",@^%ZOSF("TRAP") "RTN","MAGJUTL3",222,0) S (AGE,MAGSSN)="" "RTN","MAGJUTL3",223,0) D INFO^MAGGTPT1(.MAGGRY,MAGDFN_"^1^^^1") ; 1=Don't log to session file; 4-digit yr "RTN","MAGJUTL3",224,0) I +MAGGRY D "RTN","MAGJUTL3",225,0) . ; calculate Age & SSN/MRN display strings "RTN","MAGJUTL3",226,0) . S DOB=$P(MAGGRY,U,5) "RTN","MAGJUTL3",227,0) . I DOB D DT^DILF("",DOB,.X,"") S AGE=$$AGECALC(X) "RTN","MAGJUTL3",228,0) . S DFN=MAGDFN D PID^VADPT6 S MAGSSN=$S(VAERR:"Unknown",1:VA("PID")) ; IA #10062 (Supported) "RTN","MAGJUTL3",229,0) . K VA("PID"),VA("BID"),VAERR "RTN","MAGJUTL3",230,0) S MAGGRY=MAGGRY_"|"_AGE_U_MAGSSN "RTN","MAGJUTL3",231,0) Q "RTN","MAGJUTL3",232,0) ; "RTN","MAGJUTL3",233,0) AGECALC(DOB) ; calculate age from DOB til now "RTN","MAGJUTL3",234,0) ; format for age-appropriate display "RTN","MAGJUTL3",235,0) ; Input DOB in Fileman format "RTN","MAGJUTL3",236,0) ; Note: assumes a previously validated date is passed in "RTN","MAGJUTL3",237,0) N AGE,NDAYS,X,X1,X2 "RTN","MAGJUTL3",238,0) S AGE="unknown" "RTN","MAGJUTL3",239,0) I DOB?7N1"."0.N S DOB=$E(DOB,1,7) ; strip off time value "RTN","MAGJUTL3",240,0) I DOB?7N D "RTN","MAGJUTL3",241,0) . D NOW^%DTC S X1=X K %I "RTN","MAGJUTL3",242,0) . s X2=DOB D ^%DTC S NDAYS=X "RTN","MAGJUTL3",243,0) . I NDAYS<0 Q ; * Invalid DOB later than today --> Unknown "RTN","MAGJUTL3",244,0) . I NDAYS<32 S AGE=NDAYS_"d" Q ; days "RTN","MAGJUTL3",245,0) . I NDAYS<365 S AGE=$J(NDAYS\30.5,0,0)_"m" Q ; months "RTN","MAGJUTL3",246,0) . I NDAYS=365 S AGE="1y 0m" Q ; special case "RTN","MAGJUTL3",247,0) . S AGE=NDAYS\365.25_"y" ; years "RTN","MAGJUTL3",248,0) . I AGE<16 S AGE=AGE_" "_(($J(NDAYS#365.25,0,0))\30.5)_"m" Q ; years & months "RTN","MAGJUTL3",249,0) Q AGE "RTN","MAGJUTL3",250,0) ; "RTN","MAGJUTL3",251,0) ;+++++ INITIALIZE SESSION (VERSION CHK, DISPLAY RES CHK, COLLECT USER INFO). "RTN","MAGJUTL3",252,0) ; RPC: MAGJ USER2 "RTN","MAGJUTL3",253,0) ; "RTN","MAGJUTL3",254,0) ; MAGGRY Reference to a variable naming the global to store returned data "RTN","MAGJUTL3",255,0) ; "RTN","MAGJUTL3",256,0) ; DATA Information about the client and its workstation. "RTN","MAGJUTL3",257,0) ; ^01: MAMMORES -- Screen resolution of main viewer display: "RTN","MAGJUTL3",258,0) ; "RTN","MAGJUTL3",259,0) ; format is X_"x"_Y_","_ColorType (e.g., 2048x2580,GRAY) "RTN","MAGJUTL3",260,0) ; where X,Y are resolutions & ColorType={GRAY, COLOR}. "RTN","MAGJUTL3",261,0) ; "RTN","MAGJUTL3",262,0) ; ^02: Client Vs ....... Client software version for checking. "RTN","MAGJUTL3",263,0) ; ^03: Client O/S Vs ... Client OS version for logging. "RTN","MAGJUTL3",264,0) ; ^04: ClientBuildDayTime ..... for logging. "RTN","MAGJUTL3",265,0) ; "RTN","MAGJUTL3",266,0) ; Return Values "RTN","MAGJUTL3",267,0) ; ============= "RTN","MAGJUTL3",268,0) ; "RTN","MAGJUTL3",269,0) ; ^(0) "RTN","MAGJUTL3",270,0) ; |01 "RTN","MAGJUTL3",271,0) ; ^01: 1/0 -- Success/Fail flag for version check. "RTN","MAGJUTL3",272,0) ; ^02: "RTN","MAGJUTL3",273,0) ; ~01: code ... 4=fail. "RTN","MAGJUTL3",274,0) ; ~02: Msg .... Message to display if fail. "RTN","MAGJUTL3",275,0) ; |02 "RTN","MAGJUTL3",276,0) ; ^01: DUZ "RTN","MAGJUTL3",277,0) ; ^02: NAME "RTN","MAGJUTL3",278,0) ; ^03: INITIALS "RTN","MAGJUTL3",279,0) ; ^04: REQFLAG .... 1/0 Enable/Disable Requisition for non-rad staff "RTN","MAGJUTL3",280,0) ; ^05: SVERSION ... VistARad Server Version "RTN","MAGJUTL3",281,0) ; ---- Patch MAG*3*101 ---- "RTN","MAGJUTL3",282,0) ; ^06: DICTPREF ... 1/0 ENA DICT PREF-YES ALL LOCKED (File 2006.69,13) "RTN","MAGJUTL3",283,0) ; ---- Patch MAG*3*90 ---- "RTN","MAGJUTL3",284,0) ; ^07: SSN "RTN","MAGJUTL3",285,0) ; ^08: UserLocalStationNumber "RTN","MAGJUTL3",286,0) ; ^09: LocalPrimaryDivision "RTN","MAGJUTL3",287,0) ; ^10: PrimarySiteStationNumber "RTN","MAGJUTL3",288,0) ; ^11: SiteServiceURL "RTN","MAGJUTL3",289,0) ; ^12: SiteCode "RTN","MAGJUTL3",290,0) ; ^(1) "RTN","MAGJUTL3",291,0) ; ^01: UserName ... Network UserName "RTN","MAGJUTL3",292,0) ; ^02: PSW ........ Network Password "RTN","MAGJUTL3",293,0) ; ^03: UserType ... 3=Staff R'ist, 2=Resident R'ist, 1=Rad Tech, 0=Non-Rad "RTN","MAGJUTL3",294,0) ; ^04: SYSADMIN ... 1/0 1=user has System User privileges "RTN","MAGJUTL3",295,0) ; ^05: Production account? 1/0 1=yes "RTN","MAGJUTL3",296,0) ; "RTN","MAGJUTL3",297,0) ; ^(2:N) Security Keys "RTN","MAGJUTL3",298,0) ; ^(N+1:M) Mammography display message data "RTN","MAGJUTL3",299,0) ; "RTN","MAGJUTL3",300,0) USERINF2(MAGGRY,DATA) ; RPC: MAGJ USER2--get user info "RTN","MAGJUTL3",301,0) S X="ERR2^MAGJUTL3",@^%ZOSF("TRAP") "RTN","MAGJUTL3",302,0) K MAGGRY S MAGGRY(0)="",MAGGRY(1)="" "RTN","MAGJUTL3",303,0) I +$G(DUZ)=0 S MAGGRY(0)="0^4~DUZ Undefined, Null or Zero|" Q "RTN","MAGJUTL3",304,0) N I,J,K,Y,REQFLAG,VRADVER,OSVER,RADTECH,PLACE,REPLY,DICTPREF,MAMMORES,ICNT,MSG "RTN","MAGJUTL3",305,0) S MAMMORES=$P(DATA,U),VRADVER=$P(DATA,U,2),OSVER=$P(DATA,U,3) "RTN","MAGJUTL3",306,0) D CHKVER^MAGJUTL5(.REPLY,VRADVER,.PLACE,.SVERSION) "RTN","MAGJUTL3",307,0) I 'REPLY S MAGGRY(0)=REPLY_"|^^^^",MAGGRY(1)="^^^" G USERIN2Z ; Version check or PLACE failed "RTN","MAGJUTL3",308,0) S RADTECH="" "RTN","MAGJUTL3",309,0) S MAGJOB("OSVER")=$S(OSVER]"":OSVER,1:"UNK") ; IDs P18 initialization; cf cacheq ep above "RTN","MAGJUTL3",310,0) S MAGJOB("VRVERSION")=$S(VRADVER]"":VRADVER,1:"UNK") "RTN","MAGJUTL3",311,0) S MAGJOB("VRBLDDTTM")=$P(DATA,U,4) "RTN","MAGJUTL3",312,0) S MAGJOB("VSVERSION")=SVERSION "RTN","MAGJUTL3",313,0) D MAGJOB "RTN","MAGJUTL3",314,0) ; "RTN","MAGJUTL3",315,0) ;=== Enable/Disable Requisition if not a radiology user "RTN","MAGJUTL3",316,0) S REQFLAG=1 "RTN","MAGJUTL3",317,0) I 'MAGJOB("USER",1) D ; not a rist "RTN","MAGJUTL3",318,0) . I $D(^VA(200,"ARC","T",+DUZ)) S RADTECH=1 Q ; Rad Tech OK "RTN","MAGJUTL3",319,0) . S X=+$P($G(^MAG(2006.69,1,0)),U,16) "RTN","MAGJUTL3",320,0) . I X S REQFLAG=0 ; Disable Req "RTN","MAGJUTL3",321,0) S DICTPREF=+$P($G(^MAG(2006.69,1,0)),U,17) "RTN","MAGJUTL3",322,0) S MAGGRY(0)=REPLY_"|"_DUZ_U_$$GET1^DIQ(200,DUZ_",",.01)_U_$$GET1^DIQ(200,DUZ_",",1)_U_REQFLAG_U_SVERSION_U_DICTPREF "RTN","MAGJUTL3",323,0) ; "RTN","MAGJUTL3",324,0) ;=== Add "^"-pieces 7:12 for ViX (MAG*3*90). "RTN","MAGJUTL3",325,0) S MAGGRY(0)=MAGGRY(0)_U_$$GET1^DIQ(200,DUZ_",",9) ;...SSN "RTN","MAGJUTL3",326,0) S MAGGRY(0)=MAGGRY(0)_U_$$GET1^DIQ(4,DUZ(2),99,"E") ;.UserLocalStationNumber "RTN","MAGJUTL3",327,0) S MAGGRY(0)=MAGGRY(0)_U_$P($$SITE^VASITE(),U,3) ;.......LocalPrimaryDivision "RTN","MAGJUTL3",328,0) S MAGGRY(0)=MAGGRY(0)_U_$P($$SITE^VASITE(),U,3) ;.....PrimarySiteStationNumber "RTN","MAGJUTL3",329,0) ; "RTN","MAGJUTL3",330,0) ;=== Lookup SiteServiceURL. "RTN","MAGJUTL3",331,0) N SSUNC,VIXPTR "RTN","MAGJUTL3",332,0) S VIXPTR=$P($G(^MAG(2006.1,+MAGJOB("SITEP"),"NET")),"^",5) "RTN","MAGJUTL3",333,0) ; "RTN","MAGJUTL3",334,0) ;=== Return UNC only if OpStatus is 'online'. "RTN","MAGJUTL3",335,0) I VIXPTR,+$P($G(^MAG(2005.2,VIXPTR,0)),"^",6) D "RTN","MAGJUTL3",336,0) . S SSUNC=$P($G(^MAG(2005.2,VIXPTR,0)),"^",2) "RTN","MAGJUTL3",337,0) S MAGGRY(0)=MAGGRY(0)_U_$G(SSUNC) ;...................SiteServiceURL "RTN","MAGJUTL3",338,0) S MAGGRY(0)=MAGGRY(0)_U_$P(MAGJOB("SITEP"),U,2) ;.....SiteCode "RTN","MAGJUTL3",339,0) ; "RTN","MAGJUTL3",340,0) ;=== Network UserName and PSW "RTN","MAGJUTL3",341,0) S MAGGRY(1)=$P($G(^MAG(2006.1,PLACE,"NET")),U,1,2) "RTN","MAGJUTL3",342,0) S X=+MAGJOB("USER",1),X=$S(X=15:3,X=12:2,+RADTECH:1,1:0) "RTN","MAGJUTL3",343,0) S MAGGRY(1)=MAGGRY(1)_U_X_U_$D(MAGJOB("KEYS","MAGJ SYSTEM USER")) "RTN","MAGJUTL3",344,0) S MAGGRY(1)=MAGGRY(1)_U_$S($L($T(PROD^XUPROD)):+$$PROD^XUPROD,1:0) "RTN","MAGJUTL3",345,0) S MAGGRY(2)="*KEYS",X="" F ICNT=3:1 S X=$O(MAGJOB("KEYS",X)) Q:X="" S MAGGRY(ICNT)=X "RTN","MAGJUTL3",346,0) S MAGGRY(ICNT)="*END" "RTN","MAGJUTL3",347,0) S ICNT=ICNT+1,MAGGRY(ICNT)="*MAMMO" "RTN","MAGJUTL3",348,0) S MSG=$$MAMMOCHK(MAMMORES) "RTN","MAGJUTL3",349,0) I MSG]"" S ICNT=ICNT+1,MAGGRY(ICNT)=MSG "RTN","MAGJUTL3",350,0) S ICNT=ICNT+1,MAGGRY(ICNT)="*END" "RTN","MAGJUTL3",351,0) USERIN2Z Q "RTN","MAGJUTL3",352,0) ; "RTN","MAGJUTL3",353,0) MAMMOCHK(X) ; P133--now ignoring screen resolution, etc. "RTN","MAGJUTL3",354,0) ; note--as of ??/12 there are other sized displaysapproved for mammo "RTN","MAGJUTL3",355,0) ; now returns just a single disclaimer message, regardless of display "RTN","MAGJUTL3",356,0) ; keeping this structure for possible change in the future "RTN","MAGJUTL3",357,0) N MSG "RTN","MAGJUTL3",358,0) S MSG="Primary diagnostic interpretation of mammography images may only be performed on medical devices that are cleared for that intended use, and that use display hardware conforming to technical specifications set by the FDA." "RTN","MAGJUTL3",359,0) Q:$Q MSG Q "RTN","MAGJUTL3",360,0) ; "RTN","MAGJUTL3",361,0) UPCASE(X) ; strip spaces, and cx to uppercase "RTN","MAGJUTL3",362,0) Q $TR(X,"abcdefghijklmnopqrstuvwxyz ","ABCDEFGHIJKLMNOPQRSTUVWXYZ") "RTN","MAGJUTL3",363,0) ; "RTN","MAGJUTL3",364,0) ERR1 N ERR S ERR=$$EC^%ZOSV S @MAGGRY@(0)="0^4~"_ERR G ERR "RTN","MAGJUTL3",365,0) ERR2 N ERR S ERR=$$EC^%ZOSV S MAGGRY(0)="0^4~"_ERR G ERR "RTN","MAGJUTL3",366,0) ERR3 N ERR S ERR=$$EC^%ZOSV S MAGGRY="0^4~"_ERR "RTN","MAGJUTL3",367,0) ERR D @^%ZOSF("ERRTN") "RTN","MAGJUTL3",368,0) Q:$Q 1 Q "RTN","MAGJUTL3",369,0) ; "RTN","MAGJUTL3",370,0) END Q ; "RTN","MAGJUTL5") 0^8^B38140374 "RTN","MAGJUTL5",1,0) MAGJUTL5 ;WOIFO/JHC - VistARad RPCs ; 9 Sep 2013 11:22 AM "RTN","MAGJUTL5",2,0) ;;3.0;IMAGING;**65,76,101,90,115,104,120,133**;Mar 19, 2002;Build 5393;Sep 09, 2013 "RTN","MAGJUTL5",3,0) ;; Per VHA Directive 2004-038, this routine should not be modified. "RTN","MAGJUTL5",4,0) ;; +---------------------------------------------------------------+ "RTN","MAGJUTL5",5,0) ;; | Property of the US Government. | "RTN","MAGJUTL5",6,0) ;; | No permission to copy or redistribute this software is given. | "RTN","MAGJUTL5",7,0) ;; | Use of unreleased versions of this software requires the user | "RTN","MAGJUTL5",8,0) ;; | to execute a written test agreement with the VistA Imaging | "RTN","MAGJUTL5",9,0) ;; | Development Office of the Department of Veterans Affairs, | "RTN","MAGJUTL5",10,0) ;; | telephone (301) 734-0100. | "RTN","MAGJUTL5",11,0) ;; | The Food and Drug Administration classifies this software as | "RTN","MAGJUTL5",12,0) ;; | a medical device. As such, it may not be changed in any way. | "RTN","MAGJUTL5",13,0) ;; | Modifications to this software may result in an adulterated | "RTN","MAGJUTL5",14,0) ;; | medical device under 21CFR820, the use of which is considered | "RTN","MAGJUTL5",15,0) ;; | to be a violation of US Federal Statutes. | "RTN","MAGJUTL5",16,0) ;; +---------------------------------------------------------------+ "RTN","MAGJUTL5",17,0) ;; "RTN","MAGJUTL5",18,0) Q "RTN","MAGJUTL5",19,0) ; adapted from MAGGTU4 "RTN","MAGJUTL5",20,0) GETVER(SVRVER,SVRTVER,ALLOWCL,VIXVER) ; "RTN","MAGJUTL5",21,0) ; The Server Version SVRVER is hardcoded to match the Client "RTN","MAGJUTL5",22,0) ; so this Routine must be edited/distributed with a new Client "RTN","MAGJUTL5",23,0) ; released Client will have the T version that the server expects "RTN","MAGJUTL5",24,0) ; "RTN","MAGJUTL5",25,0) ;--- Synchronize the below information with that in MAGJTU4V. "RTN","MAGJUTL5",26,0) ; "RTN","MAGJUTL5",27,0) S SVRVER="3.0.133",SVRTVER=3 ; <*> Edit this line for each patch/T-version "RTN","MAGJUTL5",28,0) ; "RTN","MAGJUTL5",29,0) S ALLOWCL="|3.0.120|" ; back-compatible with prior client "RTN","MAGJUTL5",30,0) ; "RTN","MAGJUTL5",31,0) S VIXVER="" "RTN","MAGJUTL5",32,0) ; VIX may present versions different from vrad Client/Server versions; this would "RTN","MAGJUTL5",33,0) ; happen if M-only changes are made to vrad Server code as part of a VIX patch "RTN","MAGJUTL5",34,0) ; to support updated VIX-related functionality. VIXVERS contains the version numbers "RTN","MAGJUTL5",35,0) ; that are to be supported in this fashion; related M changes need to be back-compatible "RTN","MAGJUTL5",36,0) ; with prior vrad versions' behavior in the interface "RTN","MAGJUTL5",37,0) N T,VIXVERS "RTN","MAGJUTL5",38,0) S VIXVERS="|3.0.104|" ; keep compatible with P115 & P90 <*> edit as needed for patches "RTN","MAGJUTL5",39,0) S T=$G(MAGJOB("VIX")) "RTN","MAGJUTL5",40,0) I T,VIXVERS[("|"_T_"|") S ALLOWCL=ALLOWCL_T_"|",VIXVER=T "RTN","MAGJUTL5",41,0) Q "RTN","MAGJUTL5",42,0) ; "RTN","MAGJUTL5",43,0) CHKVER(MAGRY,CLVER,PLC,SVERSION) ; "RTN","MAGJUTL5",44,0) ; Input CLVER is the version of the Client "RTN","MAGJUTL5",45,0) ; format: Major.Minor.Patch.Build# [|VIX] -- eg 3.0.115.4|VIX "RTN","MAGJUTL5",46,0) ; Build # = T-version; VIX string only appears if a VIX session "RTN","MAGJUTL5",47,0) ; 3 possible return codes in MAGRY: "RTN","MAGJUTL5",48,0) ; 2^n~msg : Client displays a message and continues "RTN","MAGJUTL5",49,0) ; 1^1~msg : Client continues without displaying a message "RTN","MAGJUTL5",50,0) ; 0^n~msg : Client displays a message then Aborts "RTN","MAGJUTL5",51,0) ; PLC returns 2006.1 pointer "RTN","MAGJUTL5",52,0) ; "RTN","MAGJUTL5",53,0) S CLVER=$G(CLVER),PLC="",MAGRY="" "RTN","MAGJUTL5",54,0) N SV,ST,CV,CT,CP,ALLOWV,TESTFLAG,SVSTAT,VIXVER "RTN","MAGJUTL5",55,0) ; SVERSION = Full Server Version -> (3.0.18.132 or 3.0.18); test has 4, release has 3 parts "RTN","MAGJUTL5",56,0) ; SV = Server Version -> (3.0.18); only 1st 3 parts "RTN","MAGJUTL5",57,0) ; ST = Server T Version -> defined to always match client part-4 "RTN","MAGJUTL5",58,0) ; CV = Client Version, w/out build # "RTN","MAGJUTL5",59,0) ; CT = Client T Version alone "RTN","MAGJUTL5",60,0) ; CP = Client Patch alone "RTN","MAGJUTL5",61,0) ; ALLOWV = Hard coded string of allowed clients for this KIDS. "RTN","MAGJUTL5",62,0) ; TESTFLAG = 1/0 -- 1=Test vs of server code; 0=Release vs "RTN","MAGJUTL5",63,0) ; get VIX version if a VIX session "RTN","MAGJUTL5",64,0) I $P(CLVER,"|",2)["VIX" S MAGJOB("VIX")=$P(CLVER,"|") ; VIX facade version "RTN","MAGJUTL5",65,0) ; "RTN","MAGJUTL5",66,0) I $G(DUZ(2)) S PLC=$$PLACE^MAGBAPI(DUZ(2)) "RTN","MAGJUTL5",67,0) ; Quit if we don't have a valid DUZ(2) or valid PLACE: ^MAG(2006.1,PLC) "RTN","MAGJUTL5",68,0) I 'PLC S MAGRY="0^4~Error verifying Imaging Site (Place) -- Contact Imaging support." Q "RTN","MAGJUTL5",69,0) ; "RTN","MAGJUTL5",70,0) D GETVER(.SV,.ST,.ALLOWV,.VIXVER) "RTN","MAGJUTL5",71,0) S CLVER=$P(CLVER,"|") "RTN","MAGJUTL5",72,0) S CV=$P(CLVER,".",1,3),CT=+$P(CLVER,".",4),CP=+$P(CLVER,".",3) "RTN","MAGJUTL5",73,0) ; "RTN","MAGJUTL5",74,0) D VERSTAT(.SVSTAT,SV) "RTN","MAGJUTL5",75,0) I 'SVSTAT S MAGRY=SVSTAT Q ; KIDS status for this version indeterminate "RTN","MAGJUTL5",76,0) S TESTFLAG=(+SVSTAT=1) "RTN","MAGJUTL5",77,0) S SVERSION=SV "RTN","MAGJUTL5",78,0) I TESTFLAG S SVERSION=SV_"."_ST "RTN","MAGJUTL5",79,0) ; Check Version differences: "RTN","MAGJUTL5",80,0) I (CV'=SV) D Q "RTN","MAGJUTL5",81,0) . I '(ALLOWV[("|"_CV_"|")) D Q "RTN","MAGJUTL5",82,0) . . S MAGRY="0^4~VistARad Workstation software version "_CLVER_" is not compatible with the VistA server version "_SVERSION_". Contact Imaging support. (CNA)" "RTN","MAGJUTL5",83,0) . ; Warn the Client (unless VIX), allow to continue "RTN","MAGJUTL5",84,0) . I TESTFLAG S MAGRY="2^3~VistARad Workstation software version "_CLVER_" is running with VistA server TEST Version "_SVERSION_" -- VistARad will Continue, but contact Imaging Support if problems occur. (Pdif)" "RTN","MAGJUTL5",85,0) . E I VIXVER]"" S MAGRY="1^1~VIX software vs. "_CLVER_" is running with VistA server vs. "_SVERSION_". (VIXdif)" "RTN","MAGJUTL5",86,0) . E S MAGRY="2^3~VistARad Workstation software version "_CLVER_" is running with VistA server Version "_SVERSION_" -- VistARad will Continue, but contact Imaging Support to install Released Version. (RPdif)" "RTN","MAGJUTL5",87,0) . Q "RTN","MAGJUTL5",88,0) ; Versions are the Same: If T versions are not, warn the Client if needed. "RTN","MAGJUTL5",89,0) ; Released Client (of any version) will have the T version that the server "RTN","MAGJUTL5",90,0) ; expects, and no warning will be displayed. "RTN","MAGJUTL5",91,0) I CT,(CT'=ST) D Q "RTN","MAGJUTL5",92,0) . I TESTFLAG S MAGRY="2^3~VistARad Workstation software vs. "_CLVER_" is running with VistA server TEST vs. "_SVERSION_" -- VistARad will Continue, but contact Imaging Support " D "RTN","MAGJUTL5",93,0) . . I CT