KIDS Distribution saved on Dec 17, 2010@12:50:59 VistA Imaging V3.0 - Patch 115 - 12/17/2010 12:50PM **KIDS**:MAG*3.0*115^ **INSTALL NAME** MAG*3.0*115 "BLD",3463,0) MAG*3.0*115^IMAGING^0^3101217^y "BLD",3463,1,0) ^^10^10^3101217^ "BLD",3463,1,1,0) Version 3.0 Patch 115 - VistARad Maintenance VI "BLD",3463,1,2,0) "BLD",3463,1,3,0) "BLD",3463,1,4,0) Routines: "BLD",3463,1,5,0) MAGJEX1 new value = 78821225 "BLD",3463,1,6,0) MAGJMN1 new value = 100385788 "BLD",3463,1,7,0) MAGJPRF1 new value = 142578165 "BLD",3463,1,8,0) MAGJTU4V new value = 4995092 "BLD",3463,1,9,0) MAGJUTL5 new value = 33147179 "BLD",3463,1,10,0) MAGJVAPI new value = 15026041 "BLD",3463,4,0) ^9.64PA^2006.1^1 "BLD",3463,6.3) V3.0p115Build1912_T4 "BLD",3463,4,2006.1,0) 2006.1 "BLD",3463,4,2006.1,2,0) ^9.641^2006.1^1 "BLD",3463,4,2006.1,2,2006.1,0) IMAGING SITE PARAMETERS (File-top level) "BLD",3463,4,2006.1,2,2006.1,1,0) ^9.6411^203^2 "BLD",3463,4,2006.1,2,2006.1,1,202,0) DEFAULT VISTARAD USERPREF RAD "BLD",3463,4,2006.1,2,2006.1,1,203,0) DEFAULT VISTARAD USERPREF NON "BLD",3463,4,2006.1,222) y^y^p^^^^n^^n "BLD",3463,4,2006.1,224) "BLD",3463,4,"APDD",2006.1,2006.1) "BLD",3463,4,"APDD",2006.1,2006.1) "BLD",3463,4,"APDD",2006.1,2006.1,202) "BLD",3463,4,"APDD",2006.1,2006.1,203) "BLD",3463,4,"B",2006.1,2006.1) "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",.4,"NM",0) ^9.68A^^ "BLD",3463,"KRN",.401,0) .401 "BLD",3463,"KRN",.401,"NM",0) ^9.68A^^ "BLD",3463,"KRN",.402,0) .402 "BLD",3463,"KRN",.402,"NM",0) ^9.68A^^ "BLD",3463,"KRN",.403,0) .403 "BLD",3463,"KRN",.5,0) .5 "BLD",3463,"KRN",.84,0) .84 "BLD",3463,"KRN",.84,"NM",0) ^9.68A^^ "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^6^6 "BLD",3463,"KRN",9.8,"NM",1,0) MAGJEX1^^0^B78821225 "BLD",3463,"KRN",9.8,"NM",2,0) MAGJMN1^^0^B100385788 "BLD",3463,"KRN",9.8,"NM",3,0) MAGJPRF1^^0^B142578165 "BLD",3463,"KRN",9.8,"NM",4,0) MAGJTU4V^^0^B4995092 "BLD",3463,"KRN",9.8,"NM",5,0) MAGJUTL5^^0^B33147179 "BLD",3463,"KRN",9.8,"NM",6,0) MAGJVAPI^^0^B15026041 "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","MAGJPRF1",3) "BLD",3463,"KRN",9.8,"NM","B","MAGJTU4V",4) "BLD",3463,"KRN",9.8,"NM","B","MAGJUTL5",5) "BLD",3463,"KRN",9.8,"NM","B","MAGJVAPI",6) "BLD",3463,"KRN",19,0) 19 "BLD",3463,"KRN",19,"NM",0) ^9.68A^2^2 "BLD",3463,"KRN",19,"NM",1,0) MAGJ E/E DEFAULT USER PROFILES^^0 "BLD",3463,"KRN",19,"NM",2,0) MAGJ MAIN^^2 "BLD",3463,"KRN",19,"NM","B","MAGJ E/E DEFAULT USER PROFILES",1) "BLD",3463,"KRN",19,"NM","B","MAGJ MAIN",2) "BLD",3463,"KRN",19.1,0) 19.1 "BLD",3463,"KRN",19.1,"NM",0) ^9.68A^^ "BLD",3463,"KRN",101,0) 101 "BLD",3463,"KRN",101,"NM",0) ^9.68A^^ "BLD",3463,"KRN",409.61,0) 409.61 "BLD",3463,"KRN",771,0) 771 "BLD",3463,"KRN",771,"NM",0) ^9.68A^^ "BLD",3463,"KRN",870,0) 870 "BLD",3463,"KRN",870,"NM",0) ^9.68A^^ "BLD",3463,"KRN",8989.51,0) 8989.51 "BLD",3463,"KRN",8989.51,"NM",0) ^9.68A^^ "BLD",3463,"KRN",8989.52,0) 8989.52 "BLD",3463,"KRN",8994,0) 8994 "BLD",3463,"KRN",8994,"NM",0) ^9.68A^1^1 "BLD",3463,"KRN",8994,"NM",1,0) MAGJ VIX LOG REMOTE IMG ACCESS^^0 "BLD",3463,"KRN",8994,"NM","B","MAGJ VIX LOG REMOTE IMG ACCESS",1) "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*90^2 "BLD",3463,"REQB","B","MAG*3.0*90",1) "FIA",2006.1) IMAGING SITE PARAMETERS "FIA",2006.1,0) ^MAG(2006.1, "FIA",2006.1,0,0) 2006.1P "FIA",2006.1,0,1) y^y^p^^^^n^^n "FIA",2006.1,0,10) "FIA",2006.1,0,11) "FIA",2006.1,0,"RLRO") "FIA",2006.1,2006.1) 1 "FIA",2006.1,2006.1,202) "FIA",2006.1,2006.1,203) "INIT") POSTINST^MAGJMN1 "KRN",19,123457,-1) 0^1 "KRN",19,123457,0) MAGJ E/E DEFAULT USER PROFILES^E/E VistARad Default User Profiles^^R^^^^^^^y^MAGJ RADIOLOGY^n "KRN",19,123457,1,0) ^19.06^2^2^3101022^^^^ "KRN",19,123457,1,1,0) Allows specification of a MAGJ USER DATA file (#2006.68) entry to serve as a default entry for a particular VistARad user class (e.g., Radiologist, Non-radiologist, etc.). This streamlines new user initialization: a new user can "KRN",19,123457,1,2,0) be given a default profile rather than building one. "KRN",19,123457,25) EEPRO^MAGJMN1 "KRN",19,123457,"U") E/E VISTARAD DEFAULT USER PROF "KRN",19,123458,-1) 2^2 "KRN",19,123458,0) MAGJ MAIN^VistARad System Options^^M^126^^^^^^^469 "KRN",19,123458,10,0) ^19.01IP^12^10 "KRN",19,123458,10,12,0) 23454^EPRO^ "KRN",19,123458,10,12,"^") MAGJ E/E DEFAULT USER PROFILES "KRN",19,123458,"U") VISTARAD SYSTEM OPTIONS "KRN",8994,123459,-1) 0^1 "KRN",8994,123459,0) MAGJ VIX LOG REMOTE IMG ACCESS^LOGRIA^MAGJVAPI^1^R^0^^1^.1^^0 "KRN",8994,123459,1,0) ^8994.01^1^1^3101104^^^^ "KRN",8994,123459,1,1,0) Log ViX-enabled Remote Image Access Events. "KRN",8994,123459,2,0) ^8994.02A^1^1 "KRN",8994,123459,2,1,0) DATA^1^256^1^1 "KRN",8994,123459,2,1,1,0) ^8994.021^9^9^3101104^^^^ "KRN",8994,123459,2,1,1,1,0) CARET DELIMITED AS FOLLOWS: "KRN",8994,123459,2,1,1,2,0) ^01: ACTION ... "VR-RV"_ subset member from ACTION+1^MAGGTAU "KRN",8994,123459,2,1,1,3,0) ^02: RADFN .... IEN of PATIENT file (#2) "KRN",8994,123459,2,1,1,4,0) ^03: MAGIEN ... IEN of IMAGE file (#2005) "KRN",8994,123459,2,1,1,5,0) ^04: NIMGS .... VRad Image Count "KRN",8994,123459,2,1,1,6,0) ^05: REMOTE ... VRad Remote Read Flag "KRN",8994,123459,2,1,1,7,0) ^06: MAGJVRV .. VRad Version "KRN",8994,123459,2,1,1,8,0) ^07: USERCLS .. VRad User Class "KRN",8994,123459,2,1,1,9,0) ^08: VIXTXID .. VRad VIX Transaction ID "KRN",8994,123459,2,"B","DATA",1) "KRN",8994,123459,2,"PARAMSEQ",1,1) "KRN",8994,123459,3,0) ^8994.03^5^5^3100401^^^^ "KRN",8994,123459,3,1,0) CARET-DELIMITED (IF NECESSARY): "KRN",8994,123459,3,2,0) "KRN",8994,123459,3,3,0) __EXPECTED__ ______ON_ERROR______ "KRN",8994,123459,3,4,0) ^01: 1 0 "KRN",8994,123459,3,5,0) ^02: Error msg. (optional) "MBREQ") 0 "ORD",16,8994) 8994;16;1;;;;;;;RPCDEL^XPDIA1 "ORD",16,8994,0) REMOTE PROCEDURE "ORD",18,19) 19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA "ORD",18,19,0) OPTION "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) 115^3101217^.5 "PKG",454,22,1,"PAH",1,1,0) ^9.49011^9^9^3101217 "PKG",454,22,1,"PAH",1,1,1,0) Routines for Patch 115, Test Build 4. "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 = 25703195 "PKG",454,22,1,"PAH",1,1,5,0) MAGJMN1 value = 19116251 "PKG",454,22,1,"PAH",1,1,6,0) MAGJPRF1 value = 22808620 "PKG",454,22,1,"PAH",1,1,7,0) MAGJTU4V value = 3477480 "PKG",454,22,1,"PAH",1,1,8,0) MAGJUTL5 value = 15135475 "PKG",454,22,1,"PAH",1,1,9,0) MAGJVAPI value = 5898333 "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") 6 "RTN","MAGJEX1") 0^1^B78821225 "RTN","MAGJEX1",1,0) MAGJEX1 ;WIRMFO/JHC VistARad RPC calls ; 26-Oct-2010 3:20 PM "RTN","MAGJEX1",2,0) ;;3.0;IMAGING;**16,22,18,65,101,115**;Mar 19, 2002;Build 1912;Dec 17, 2010 "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^SERDISA^STK/LAY^USETGA "RTN","MAGJEX1",33,0) ; OPEN_FLAG = 1/0 - 1: OPEN the case for update; else, view-only "RTN","MAGJEX1",34,0) ; = /2 2: Reserve for Interp ; * P18 "RTN","MAGJEX1",35,0) ; RADFN^RADTI^RACNI specify case of interest "RTN","MAGJEX1",36,0) ; SERDISA = 1/0 - Disable Mult Series processing if true * n/a for P18 "RTN","MAGJEX1",37,0) ; STK/LAY = 1/0 - 1:Open in Stack; 0:Open in Layout * n/a for P18 "RTN","MAGJEX1",38,0) ; USETGA = 1/0 - 1:Open .TGA file; 0:Open .BIG file "RTN","MAGJEX1",39,0) ; "RTN","MAGJEX1",40,0) ; * In P18, the SERDISA position is re-cycled to pass in PS_Indicator_Type values of interest "RTN","MAGJEX1",41,0) ; K/I/U for Key Image/ Interpretation/ User PS types; used in IMGLOOP^MAGJEX1B "RTN","MAGJEX1",42,0) ; "RTN","MAGJEX1",43,0) N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJEX1" "RTN","MAGJEX1",44,0) N RARPT,RADFN,RADTI,RACNI,RADIV "RTN","MAGJEX1",45,0) N DAYCASE,CURCASE,REPLY,CT,MAGS,STARTNOD,LOCKED,DATAOUT,RADATA,RIST,MDL "RTN","MAGJEX1",46,0) N IMAG,MAGXX,MAGFILE,MAGFILE1,MAGFILE2,MAGFILE3,MAGLST,MAGOBJT,MODALITY "RTN","MAGJEX1",47,0) N SERDISA,MAGSTRT,MAGEND,SERLBL,SERBRK,SERLIM,NSERIES,CURPATHS "RTN","MAGJEX1",48,0) N MIXEDUP,VIEWOK,STKLAY,USETGA,OPENCNT,USELORES,IMGST,REMOTE,DIQUIET "RTN","MAGJEX1",49,0) N LOGDATA,MODIF,EXCAT,RADATA2,PSIND,RACPT,RASTCAT,RASTORD,ACQSITE,ALTPATH,PROCDT "RTN","MAGJEX1",50,0) N YNMAMMO,YNREVANN "RTN","MAGJEX1",51,0) S DIQUIET=1 D DT^DICRW "RTN","MAGJEX1",52,0) S (CT,MIXEDUP)=0,MODALITY="",DATAOUT="",DAYCASE="",MAGLST="MAGJOPENCASE",(ACQSITE,ALTPATH,PROCDT)="" "RTN","MAGJEX1",53,0) S VIEWOK=1,OPENCNT=1 "RTN","MAGJEX1",54,0) K MAGGRY S MAGGRY=$NA(^TMP($J,MAGLST)),STARTNOD=0 K @MAGGRY ; assign MAGGRY value "RTN","MAGJEX1",55,0) S CURCASE=$P(DATA,U),RARPT=+$P(DATA,U,5),SERDISA=+$P(DATA,U,6) "RTN","MAGJEX1",56,0) I 'MAGJOB("P32") S PSIND="",X=$P(DATA,U,6) I X]"" F I="K","I","U" I $F(X,I) S PSIND(I)="" "RTN","MAGJEX1",57,0) S STKLAY=+$P(DATA,U,7),USETGA=+$P(DATA,U,8) "RTN","MAGJEX1",58,0) S RADFN=$P(DATA,U,2),RADTI=$P(DATA,U,3),RACNI=$P(DATA,U,4) "RTN","MAGJEX1",59,0) I RADFN,RADTI,RACNI D GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,"",.X) "RTN","MAGJEX1",60,0) I 'X S REPLY="4~Request Contains Invalid Case Pointer ("_RADFN_U_RADTI_U_RACNI_U_RARPT_")." G OPENCASZ "RTN","MAGJEX1",61,0) S RADATA=$G(^TMP($J,"MAGRAEX",1,1)),RADATA2=$G(^(2)) "RTN","MAGJEX1",62,0) K ^TMP($J,"MAGRAEX") "RTN","MAGJEX1",63,0) S RADIV=$P(RADATA2,U,5),MODIF=$P(RADATA2,U,8),RASTCAT=$P(RADATA2,U,11),RASTORD=$P(RADATA,U,15) "RTN","MAGJEX1",64,0) S RARPT=+$P(RADATA,U,10),DAYCASE=$P(RADATA,U,12),RACPT=$P(RADATA,U,17) "RTN","MAGJEX1",65,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",66,0) D CKINTEG^MAGJRPT(.X,RADFN,RADTI,RACNI,RARPT,RADATA) "RTN","MAGJEX1",67,0) I X]"" S MIXEDUP=1,MIXEDUP("REPLY")=X ; DB corruption "RTN","MAGJEX1",68,0) S REPLY="4~Attempting to open/display case #"_DAYCASE "RTN","MAGJEX1",69,0) S IMGST=$$JBFETCH^MAGJUTL2(RARPT,.MAGS,USETGA) ; open only if NOT on JB "RTN","MAGJEX1",70,0) I +IMGST D G OPENCASZ "RTN","MAGJEX1",71,0) . I $D(MAGS("OFFLN")) N T,TT S T="",TT="" D "RTN","MAGJEX1",72,0) . . F S T=$O(MAGS("OFFLN",T)) Q:T="" S TT=TT_$S(TT="":"",1:", ")_T "RTN","MAGJEX1",73,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",74,0) . E S REPLY="2~Case #"_DAYCASE_"--"_+IMGST_" Images have been requested from Jukebox; try again later." "RTN","MAGJEX1",75,0) I '$P(IMGST,U,2) S REPLY="2~No Images exist for Case #"_DAYCASE_"." G OPENCASZ "RTN","MAGJEX1",76,0) S USELORES=+$P(IMGST,U,3)_U_$P(IMGST,U,2) "RTN","MAGJEX1",77,0) ; set up series info (*back compat for P32) "RTN","MAGJEX1",78,0) I (STKLAY&SERDISA)!'MAGJOB("P32") S STKLAY=3 ; disable series in Stacker or post-patch 32 "RTN","MAGJEX1",79,0) N SERHI S SERHI=$G(MAGS("SER",0)) "RTN","MAGJEX1",80,0) K SERBRK "RTN","MAGJEX1",81,0) I SERHI>1,$P($G(^MAG(2006.69,1,0)),U,12) D ; Process for mult. Series "RTN","MAGJEX1",82,0) . Q:SERDISA ; user disabled from w/s "RTN","MAGJEX1",83,0) . Q:STKLAY ; Don't do this for Stacker "RTN","MAGJEX1",84,0) . N SERCT,SERSTR I '$D(SERLIM) S SERLIM=5 ; min size for a series "RTN","MAGJEX1",85,0) . S SERSTR="",SERCT=0,SERBRK(0)=0 "RTN","MAGJEX1",86,0) . ; step 1: roll up "small" series at the bottom to next higher ones "RTN","MAGJEX1",87,0) . F Q:(MAGS("SER",SERHI)'1 D "RTN","MAGJEX1",128,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",129,0) . . S XPTS=$S(IMIX=1:" ",1:"s ")_XPTS "RTN","MAGJEX1",130,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",131,0) . E S REPLY=(7-VIEWOK)_"~"_MIXEDUP("REPLY") "RTN","MAGJEX1",132,0) . I CURCASE S REPLY=REPLY_" The exam is NOT Locked." S CURCASE=0 "RTN","MAGJEX1",133,0) I CT D "RTN","MAGJEX1",134,0) . S RIST=$S(+MAGJOB("USER",1):1,1:0),EXCAT="" "RTN","MAGJEX1",135,0) . S LOGDATA=RADFN_U_+$P(MAGS(1),U,4)_U_+MAGS_U_REMOTE ; for Img Access log "RTN","MAGJEX1",136,0) . I CURCASE D "RTN","MAGJEX1",137,0) . . I $G(MAGJOB("CONSOLIDATED")),'$D(MAGJOB("DIVSCRN",RADIV)) D S CURCASE=0 Q "RTN","MAGJEX1",138,0) . . . S REPLY="5~Exam is for Station #"_$$STATN(RADIV)_"; you are logged on to #"_$$STATN(DUZ(2))_". Exam is NOT Locked." "RTN","MAGJEX1",139,0) . . S XX=$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,3) "RTN","MAGJEX1",140,0) . . I '$D(^RA(72,"AVC","E",XX)) D S CURCASE=0 Q "RTN","MAGJEX1",141,0) . . . I 'MAGJOB("P32") D "RTN","MAGJEX1",142,0) . . . . D LOCKACT^MAGJEX1A(RARPT,DAYCASE,100,.RESULT) ; between reserve and now, exam may have been Taken & Updated "RTN","MAGJEX1",143,0) . . . . I +RESULT(1)!+RESULT(2) D LOCKACT^MAGJEX1A(RARPT,DAYCASE,101,.RESULT) ; so, cancel any lock/reserve "RTN","MAGJEX1",144,0) . . . S REPLY="5~For Case #"_DAYCASE_", current Status is "_$P(^RA(72,XX,0),U)_"; Lock or Reserve NOT allowed." "RTN","MAGJEX1",145,0) . . E S EXCAT="E" "RTN","MAGJEX1",146,0) . . I RIST,'USELORES D ; lock only for Current Case, Radiologist, & Full Res images "RTN","MAGJEX1",147,0) . . . ; save data needed to later log Interpreted event "RTN","MAGJEX1",148,0) . . . D LOCKACT^MAGJEX1A(RARPT,DAYCASE,CURCASE,.RESULT,.REPLY,LOGDATA) "RTN","MAGJEX1",149,0) . . . S LOCKED=$S(+RESULT:1,+$P(RESULT,U,2):2,1:0) "RTN","MAGJEX1",150,0) . I EXCAT="" D "RTN","MAGJEX1",151,0) . . I RASTORD=9 S EXCAT="C" Q ; Complete "RTN","MAGJEX1",152,0) . . E S EXCAT=RASTCAT "RTN","MAGJEX1",153,0) . . I EXCAT="D"!(EXCAT="T") S EXCAT="I" ; just display one value meaning Interpreted "RTN","MAGJEX1",154,0) . S DATAOUT=$P(RADATA,U,4)_U_DAYCASE_U_$P(RADATA,U,9) "RTN","MAGJEX1",155,0) . S X=$P(RADATA,U,6),T=$L(X," "),X=$P(X," ",1,T-1)_U_$P(X," ",T) "RTN","MAGJEX1",156,0) . S DATAOUT=DATAOUT_U_X "RTN","MAGJEX1",157,0) . S DATAOUT=DATAOUT_U_MODALITY_U_$P(RADATA,U,5)_U_STKLAY_U_LOCKED "RTN","MAGJEX1",158,0) . ; "RTN","MAGJEX1",159,0) . ; 3090406 -- MAT -- Modified per tag's comments above. "RTN","MAGJEX1",160,0) . S DATAOUT=DATAOUT_U_MODIF_U_EXCAT_U_"|"_RIST_U_ALTPATH_U_ACQSITE_U_PROCDT_U_YNREVANN_U_YNMAMMO "RTN","MAGJEX1",161,0) . I USELORES D "RTN","MAGJEX1",162,0) . . I +USELORES=+$P(USELORES,U,2) S X="All" "RTN","MAGJEX1",163,0) . . E S X=+USELORES_" of "_+$P(USELORES,U,2) "RTN","MAGJEX1",164,0) . . I $E(REPLY,1,8)="0~Images" S REPLY="3~" "RTN","MAGJEX1",165,0) . . E S REPLY=REPLY_" -- " "RTN","MAGJEX1",166,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",167,0) S @MAGGRY@(STARTNOD)=CT_U_REPLY_"|"_RADFN_U_RADTI_U_RACNI_U_RARPT_"|"_DATAOUT "RTN","MAGJEX1",168,0) ; if mixedup & not have keys to see images, delete image refs "RTN","MAGJEX1",169,0) ; & send only reply msg "RTN","MAGJEX1",170,0) I MIXEDUP,('VIEWOK) S CT=0 K @MAGGRY S @MAGGRY@(0)=CT_U_REPLY "RTN","MAGJEX1",171,0) E S $P(@MAGGRY@(0),U)=CT+STARTNOD "RTN","MAGJEX1",172,0) I CT,(LOCKED'=2),(CURCASE'="VIX") D LOG^MAGJUTL3("VR-VW",LOGDATA) ; Image access log "RTN","MAGJEX1",173,0) Q "RTN","MAGJEX1",174,0) ; "RTN","MAGJEX1",175,0) PNAM(X) ; return pt name for input DFN "RTN","MAGJEX1",176,0) I X S X=$G(^DPT(+X,0)) I X]"" S X=$P(X,U) "RTN","MAGJEX1",177,0) E S X="UNKNOWN" "RTN","MAGJEX1",178,0) Q X "RTN","MAGJEX1",179,0) ; "RTN","MAGJEX1",180,0) STATN(X) ; get station #, else return input value "RTN","MAGJEX1",181,0) N T "RTN","MAGJEX1",182,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",183,0) Q X "RTN","MAGJEX1",184,0) ; "RTN","MAGJEX1",185,0) END Q ; "RTN","MAGJEX1",186,0) ; "RTN","MAGJMN1") 0^2^B100385788 "RTN","MAGJMN1",1,0) MAGJMN1 ;WIRMFO/JHC VRad Maint functions ; 2-Jul-2010 6:21 PM "RTN","MAGJMN1",2,0) ;;3.0;IMAGING;**16,9,22,18,65,76,101,90,115**;Mar 19, 2002;Build 1912;Dec 17, 2010 "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) N MAGJKIDS S MAGJKIDS=1 "RTN","MAGJMN1",20,0) D BGCSTOP "RTN","MAGJMN1",21,0) Q "RTN","MAGJMN1",22,0) ; "RTN","MAGJMN1",23,0) SVRLIST ; "RTN","MAGJMN1",24,0) W @IOF,!!?10,"Enter/Edit VistARad Exams List Definition",!! "RTN","MAGJMN1",25,0) N MAGIEN "RTN","MAGJMN1",26,0) K DIC S (DIC,DLAYGO)=2006.631,DIC(0)="ALMEQ" "RTN","MAGJMN1",27,0) D ^DIC I Y=-1 K DIC,DA,DR,DIE,DLAYGO Q "RTN","MAGJMN1",28,0) S X=$P(@(DIC_+Y_",0)"),U,2) "RTN","MAGJMN1",29,0) I X>9000 W !!,$C(7),"You may not edit System-Supplied files!" H 3 G SVRLIST "RTN","MAGJMN1",30,0) S DIE=2006.631,DA=+Y,DR="[MAGJ LIST EDIT]" "RTN","MAGJMN1",31,0) S MAGIEN=DA "RTN","MAGJMN1",32,0) D ^DIE I '$D(DA) G SVRLIST "RTN","MAGJMN1",33,0) D ENSRCH "RTN","MAGJMN1",34,0) D BLDDEF(MAGIEN) "RTN","MAGJMN1",35,0) S $P(^MAG(2006.631,MAGIEN,0),U,5)=$$NOW^XLFDT() "RTN","MAGJMN1",36,0) W !!,"List Definition complete!" R X:2 "RTN","MAGJMN1",37,0) G SVRLIST "RTN","MAGJMN1",38,0) Q "RTN","MAGJMN1",39,0) ENSRCH ; Invoke Search for 2006.631 def'n "RTN","MAGJMN1",40,0) N GREF,GLIN,GO,CT,DIARI,DIC,FNOD,TNOD,NCOND,NODE0 "RTN","MAGJMN1",41,0) ; GREF holds indirect ref to store search logic data: "RTN","MAGJMN1",42,0) ; @GREF@(3, ff -- conditional elements (fields/logic) "RTN","MAGJMN1",43,0) ; @GREF@(4, ff -- composite elements (ANDed conditions) "RTN","MAGJMN1",44,0) ; @GREF@(5, ff -- Human-readable search text "RTN","MAGJMN1",45,0) ; GLIN holds indirect ref to retrieve search logic data from ^DIBT "RTN","MAGJMN1",46,0) ; @GLIN@("DC", ff -- conditional elements "RTN","MAGJMN1",47,0) ; @GLIN@("DL", ff -- composite elements "RTN","MAGJMN1",48,0) ; @GLIN@("O", ff -- readable text "RTN","MAGJMN1",49,0) S GREF=$NA(^MAG(2006.631,MAGIEN,"DEF")) "RTN","MAGJMN1",50,0) S GO=1 I $D(@GREF@(5,1)) D ; show current logic "RTN","MAGJMN1",51,0) . W ! D DISPSRCH(GREF) "RTN","MAGJMN1",52,0) . S X=$$YN("Do you want to delete or re-enter the search logic?","NO") "RTN","MAGJMN1",53,0) . I X'="Y" S GO=0 Q "RTN","MAGJMN1",54,0) . W !!?7,"Re-entering the search logic requires first deleting the current",!?7,"definition, then entering the new definition from scratch." "RTN","MAGJMN1",55,0) . S X=$$YN("Are you sure you want to continue?","NO") "RTN","MAGJMN1",56,0) . I X'="Y" S GO=0 Q "RTN","MAGJMN1",57,0) I 'GO Q "RTN","MAGJMN1",58,0) W !!?7,"Now enter search logic for this List. To do this, the program" "RTN","MAGJMN1",59,0) W !?7,"will prompt you just as if you were going to run a Fileman Search." "RTN","MAGJMN1",60,0) W !?7,"When prompted STORE RESULTS OF SEARCH IN TEMPLATE:, answer with 'TEMP'" "RTN","MAGJMN1",61,0) W !?7,"If prompted ... OK TO PURGE? NO// answer 'YES'; don't bother specifying" "RTN","MAGJMN1",62,0) W !?7,"output print fields, but just RETURN through all the prompts to" "RTN","MAGJMN1",63,0) W !?7,"complete the process. The search definition will be saved as part" "RTN","MAGJMN1",64,0) W !?7,"of this List definition; you will test it out by running it from " "RTN","MAGJMN1",65,0) W !?7,"the workstation. If you need to modify the search logic, you will" "RTN","MAGJMN1",66,0) W !?7,"have to re-enter it in its entirety." "RTN","MAGJMN1",67,0) W !!?7,"NOTES: EXAM LOCK INDICATOR will not work for search logic;" "RTN","MAGJMN1",68,0) W !?14,"REMOTE CACHE INDICATOR only works for Null/Not Null logic." "RTN","MAGJMN1",69,0) S DIC=2006.634 D EN^DIS ; call Fman Search Logic routine. It will store search logic in ^DIBT "RTN","MAGJMN1",70,0) ; 2006.634 is intentional--don't change this! "RTN","MAGJMN1",71,0) I '$G(DIARI) W !!," Search logic NOT updated" D Q "RTN","MAGJMN1",72,0) . Q:'$D(@GREF@(5,1)) ; if no logic had existed, quit "RTN","MAGJMN1",73,0) . S X=$$YN("Do you want to DELETE the search logic?","NO") "RTN","MAGJMN1",74,0) . I X="Y" K @GREF@(3) K ^(4),^(5) W " -- Deleted!" "RTN","MAGJMN1",75,0) K @GREF@(3) K ^(4),^(5) "RTN","MAGJMN1",76,0) S GLIN=$NA(^DIBT(DIARI)) ; Copy logic to 2006.631 DEF nodes "RTN","MAGJMN1",77,0) S FNOD="DC",TNOD=3,CT=0 ; "DC" data--straight copy "RTN","MAGJMN1",78,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",79,0) S @GREF@(TNOD,0)=CT "RTN","MAGJMN1",80,0) S FNOD="DL",TNOD=4,CT=0 ; "DL" data--copy depends on storage scheme in DIBT: "RTN","MAGJMN1",81,0) ;Zero node null -- straight copy "RTN","MAGJMN1",82,0) ; Else 1) either only one condition is defined; "RTN","MAGJMN1",83,0) ; or, 2) the zero-node condition is ANDed with all defined conditions "RTN","MAGJMN1",84,0) ; Case 2: Var A -- Pre-pend zero node, then dup zero node "RTN","MAGJMN1",85,0) ; Var B -- Pre-pend zero node "RTN","MAGJMN1",86,0) S NCOND=+$G(@GLIN@(FNOD)) "RTN","MAGJMN1",87,0) I $G(@GLIN@(FNOD,0))]"" S NODE0=^(0) D "RTN","MAGJMN1",88,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",89,0) . I CT'=NCOND S CT=CT+1,@GREF@(TNOD,CT)=NODE0_$S(CT=1:"",1:"^") "RTN","MAGJMN1",90,0) E D "RTN","MAGJMN1",91,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",92,0) S @GREF@(TNOD,0)=CT "RTN","MAGJMN1",93,0) ; readable text--straight copy "RTN","MAGJMN1",94,0) S TNOD=5,T=0 F S T=$O(@GLIN@("O",T)) Q:T="" S @GREF@(TNOD,T)=^(T,0) "RTN","MAGJMN1",95,0) Q "RTN","MAGJMN1",96,0) ; "RTN","MAGJMN1",97,0) BLDDEF(LSTID) ; build DEF nodes for Column/Sort defs "RTN","MAGJMN1",98,0) N X,QX,SS,STR,LSTHDR,T,T0,T8,T6,HASCASE,XT,HASDATE,HASNIMG,HASPRIO,HASLOCK,LISTYPE "RTN","MAGJMN1",99,0) S SS=0,HASCASE=0,HASDATE=0,HASNIMG=0,HASPRIO=0,HASLOCK=0 "RTN","MAGJMN1",100,0) S LISTYPE=$P($G(^MAG(2006.631,LSTID,0)),U,3) "RTN","MAGJMN1",101,0) ; columns/hdrs: Order in T array by the Relative Column Order "RTN","MAGJMN1",102,0) F S SS=$O(^MAG(2006.631,LSTID,1,SS)) D Q:'SS "RTN","MAGJMN1",103,0) . I 'SS D Q "RTN","MAGJMN1",104,0) . . I 'HASCASE S X=1 D BLDDEF2(X) ; Force CASE# "RTN","MAGJMN1",105,0) . . I 'HASDATE S X=7 D BLDDEF2(X) ; DATE/TIME "RTN","MAGJMN1",106,0) . . I 'HASNIMG S X=9 D BLDDEF2(X) ; NUMBER IMAGES "RTN","MAGJMN1",107,0) . . Q:LISTYPE'="U" ; force below only if for an Unread list "RTN","MAGJMN1",108,0) . . I 'HASLOCK S X=2 D BLDDEF2(X) ; EXAM LOCK IND. "RTN","MAGJMN1",109,0) . . I 'HASPRIO S X=5 D BLDDEF2(X) ; PRIORITY "RTN","MAGJMN1",110,0) . E S X=^MAG(2006.631,LSTID,1,SS,0) "RTN","MAGJMN1",111,0) . D BLDDEF2(X) "RTN","MAGJMN1",112,0) ; go thru T to build ordered field sequence for output columns "RTN","MAGJMN1",113,0) S QX="T",STR="",LSTHDR="" "RTN","MAGJMN1",114,0) F S QX=$Q(@QX) Q:QX="" S X=@QX D "RTN","MAGJMN1",115,0) . S STR=STR_$S(STR="":"",1:U)_$P(X,U) "RTN","MAGJMN1",116,0) . S LSTHDR=LSTHDR_$S(LSTHDR="":"",1:U)_$P(X,U,2) "RTN","MAGJMN1",117,0) S ^MAG(2006.631,LSTID,"DEF",.5)=LSTHDR,^(1)=STR "RTN","MAGJMN1",118,0) ; Sort values: "RTN","MAGJMN1",119,0) S SS=0,STR="" "RTN","MAGJMN1",120,0) F S SS=$O(^MAG(2006.631,LSTID,2,SS)) Q:'SS S X=^(SS,0) D "RTN","MAGJMN1",121,0) . S X=+X_$S($P(X,U,2):"-",1:"") "RTN","MAGJMN1",122,0) . S STR=STR_$S(STR="":"",1:U)_X "RTN","MAGJMN1",123,0) S ^MAG(2006.631,LSTID,"DEF",2)=STR "RTN","MAGJMN1",124,0) S $P(^MAG(2006.631,LSTID,"DEF",0),U)=$$NOW^XLFDT() "RTN","MAGJMN1",125,0) Q "RTN","MAGJMN1",126,0) ; "RTN","MAGJMN1",127,0) BLDDEF2(X) ; "RTN","MAGJMN1",128,0) S X=+X_$S($P(X,U,2):";"_+$P(X,U,2),1:"") "RTN","MAGJMN1",129,0) I 'HASCASE S HASCASE=(+X=1) "RTN","MAGJMN1",130,0) I 'HASDATE S HASDATE=(+X=7) "RTN","MAGJMN1",131,0) I 'HASNIMG S HASNIMG=(+X=9) "RTN","MAGJMN1",132,0) I 'HASLOCK S HASLOCK=(+X=2) "RTN","MAGJMN1",133,0) I 'HASPRIO S HASPRIO=(+X=5) "RTN","MAGJMN1",134,0) S T0=^MAG(2006.63,+X,0),T6=+$P(T0,U,6) S:'T6 T6=99 "RTN","MAGJMN1",135,0) S T8=$P(T0,U,8) I T8]"" S T8="~"_T8 "RTN","MAGJMN1",136,0) S XT=$S($P(T0,U,3)]"":$P(T0,U,3),1:$P(T0,U,2))_T8 "RTN","MAGJMN1",137,0) S $P(XT,"~",3)=+X "RTN","MAGJMN1",138,0) S T(T6,+X)=X_U_XT "RTN","MAGJMN1",139,0) Q "RTN","MAGJMN1",140,0) ; "RTN","MAGJMN1",141,0) PRE ; init 2006.63 prior to KIDS install "RTN","MAGJMN1",142,0) N DIK,DA S DIK="^MAG(2006.63,",DA=0 F S DA=$O(@(DIK_DA_")")) Q:'DA D ^DIK "RTN","MAGJMN1",143,0) Q "RTN","MAGJMN1",144,0) ; "RTN","MAGJMN1",145,0) POSTINST ; Patch installation inits, etc. "RTN","MAGJMN1",146,0) D BLDALL ; update list definitions "RTN","MAGJMN1",147,0) D BGCSTRT ; re-start background compile "RTN","MAGJMN1",148,0) D POST ; install message, etc. "RTN","MAGJMN1",149,0) Q "RTN","MAGJMN1",150,0) ; "RTN","MAGJMN1",151,0) BLDALL ; Create "DEF" nodes, Button labels List Def'ns "RTN","MAGJMN1",152,0) ; Updates all lists after s/w update list defs are installed "RTN","MAGJMN1",153,0) N SS,LSTDAT,LSTNUM,BUTTON,LSTTYP "RTN","MAGJMN1",154,0) S SS=0 "RTN","MAGJMN1",155,0) F S SS=$O(^MAG(2006.631,SS)) Q:'SS S LSTDAT=$G(^(SS,0)) I LSTDAT]"" D "RTN","MAGJMN1",156,0) . S LSTNUM=$P(LSTDAT,U,2),BUTTON=$P(LSTDAT,U,7),LSTTYP=$P(LSTDAT,U,3) "RTN","MAGJMN1",157,0) . I LSTNUM>9900!$P(LSTDAT,U,6) D BLDDEF(SS) ; build DEF nodes for System Lists & any Enabled lists "RTN","MAGJMN1",158,0) . I BUTTON="",(LSTTYP]"") D ; Create Button Labels if needed "RTN","MAGJMN1",159,0) . . S BUTTON=$S(LSTTYP="U":"Unread #",LSTTYP="R":"Recent #",LSTTYP="A":"All Active #",LSTTYP="P":"Pending #",1:"List #")_LSTNUM "RTN","MAGJMN1",160,0) . . S $P(^MAG(2006.631,SS,0),U,7)=BUTTON "RTN","MAGJMN1",161,0) Q "RTN","MAGJMN1",162,0) ; "RTN","MAGJMN1",163,0) POST ; Install msg "RTN","MAGJMN1",164,0) D INS^MAGQBUT4(XPDNM,DUZ,$$NOW^XLFDT,XPDA) "RTN","MAGJMN1",165,0) Q "RTN","MAGJMN1",166,0) ; "RTN","MAGJMN1",167,0) YN(MSG,DFLT) ; get Yes/No reply "RTN","MAGJMN1",168,0) N X I $G(DFLT)="" S DFLT="N" "RTN","MAGJMN1",169,0) W ! "RTN","MAGJMN1",170,0) S DFLT=$E(DFLT),DFLT=$S(DFLT="N":"NO",1:"YES") "RTN","MAGJMN1",171,0) YN1 W !,MSG_" "_DFLT_"// " "RTN","MAGJMN1",172,0) R X:DTIME S:X="" X=DFLT S X=$E(X),X=$TR(X,"ynYN","YNYN") "RTN","MAGJMN1",173,0) I "YN"'[X W " ??? Enter YES or NO",! G YN1 "RTN","MAGJMN1",174,0) Q X "RTN","MAGJMN1",175,0) ; "RTN","MAGJMN1",176,0) LSTINQ ; Inq/Disp list def'n "RTN","MAGJMN1",177,0) N GREF,MAGIEN "RTN","MAGJMN1",178,0) W !!?15,"Display VistARad Exams List Definition",!! "RTN","MAGJMN1",179,0) N MAGIEN "RTN","MAGJMN1",180,0) S DIC=2006.631,DIC(0)="AMEQ" "RTN","MAGJMN1",181,0) D ^DIC I Y=-1 K DIC,DA,DR Q "RTN","MAGJMN1",182,0) K DR S DA=+Y,MAGIEN=DA "RTN","MAGJMN1",183,0) S GREF=$NA(^MAG(2006.631,MAGIEN,"DEF")) "RTN","MAGJMN1",184,0) W ! D EN^DIQ "RTN","MAGJMN1",185,0) R !,"Enter RETURN to display the Search Logic: ",X:DTIME W ! "RTN","MAGJMN1",186,0) D DISPSRCH(GREF) "RTN","MAGJMN1",187,0) G LSTINQ "RTN","MAGJMN1",188,0) Q "RTN","MAGJMN1",189,0) ; "RTN","MAGJMN1",190,0) DISPSRCH(GREF) ; GREF holds indirect ref for global holding search logic data "RTN","MAGJMN1",191,0) I $D(@GREF@(5,1)) W !,"List Exams where:",! D "RTN","MAGJMN1",192,0) . F I=1:1 Q:'$D(@GREF@(5,I)) W !?3,^(I) "RTN","MAGJMN1",193,0) E W !?3,"NO Search Logic defined!" "RTN","MAGJMN1",194,0) Q "RTN","MAGJMN1",195,0) ; "RTN","MAGJMN1",196,0) VRSIT ; "RTN","MAGJMN1",197,0) W @IOF,!!?10,"Enter/Edit VistARad Site Parameters",!! "RTN","MAGJMN1",198,0) S DIC=2006.69,DIC(0)="ALMEQ" "RTN","MAGJMN1",199,0) I '$D(^MAG(DIC,1)) S DLAYGO=DIC "RTN","MAGJMN1",200,0) D ^DIC I Y=-1 K DIC,DA,DR,DIE,DLAYGO Q "RTN","MAGJMN1",201,0) S DIE=2006.69,DA=+Y,DR=".01:3.99;4.1:20" "RTN","MAGJMN1",202,0) D ^DIE "RTN","MAGJMN1",203,0) K DIC,DA,DR,DIE,DLAYGO "RTN","MAGJMN1",204,0) N PLACE S DA="" "RTN","MAGJMN1",205,0) S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2))) "RTN","MAGJMN1",206,0) S:PLACE DA=PLACE "RTN","MAGJMN1",207,0) I DA D "RTN","MAGJMN1",208,0) . W !!,"Editing VistARad Timeout for division #",DUZ(2),! "RTN","MAGJMN1",209,0) . S DIE=2006.1,DR="123" D ^DIE "RTN","MAGJMN1",210,0) K DA,DR,DIE "RTN","MAGJMN1",211,0) Q "RTN","MAGJMN1",212,0) ; "RTN","MAGJMN1",213,0) ;+++++ OPTION: MAGJ E/E DEFAULT USER PROFILES "RTN","MAGJMN1",214,0) ; "RTN","MAGJMN1",215,0) ; FileMan ^DIE call to enter/edit IMAGING SITE PARAMETERS File (#2006.1), "RTN","MAGJMN1",216,0) ; fields #202: DEFAULT VISTARAD USERPREF RAD and "RTN","MAGJMN1",217,0) ; #203: DEFAULT VISTARAD USERPREF NON. "RTN","MAGJMN1",218,0) ; "RTN","MAGJMN1",219,0) ; These fields point to entries in the MAGJ USER DATA File (#2006.68), and "RTN","MAGJMN1",220,0) ; allow the VistARad client to initialize new VistARad users to the settings "RTN","MAGJMN1",221,0) ; held by the appropriate default user type ("Radiologist", "Non-rad'ist"). "RTN","MAGJMN1",222,0) ; "RTN","MAGJMN1",223,0) EEPRO ; "RTN","MAGJMN1",224,0) ; "RTN","MAGJMN1",225,0) ;--- Get IEN of IMAGING SITE PARAMETERS File. "RTN","MAGJMN1",226,0) N FIELD,SITEPIEN S SITEPIEN=+$$IMGSIT^MAGJUTL1(DUZ(2),1) "RTN","MAGJMN1",227,0) F FIELD=202,203 D "RTN","MAGJMN1",228,0) . ; "RTN","MAGJMN1",229,0) . ;--- Report field being edited. "RTN","MAGJMN1",230,0) . N PROMPT S PROMPT=$S(FIELD=202:"RADIOLOGIST",FIELD=203:"NON-RADIOLOGIST") "RTN","MAGJMN1",231,0) . W !!,"Editing default "_PROMPT_" profile ...",! "RTN","MAGJMN1",232,0) . N DA,DIE,DR "RTN","MAGJMN1",233,0) . S DIE=2006.1,DR=FIELD,DA=SITEPIEN D ^DIE "RTN","MAGJMN1",234,0) . Q "RTN","MAGJMN1",235,0) Q "RTN","MAGJMN1",236,0) EEPREF ; "RTN","MAGJMN1",237,0) W @IOF,!!?10,"Enter/Edit VistARad Prefetch Logic",!! "RTN","MAGJMN1",238,0) N MAGIEN "RTN","MAGJMN1",239,0) K DIC S (DIC,DLAYGO)=2006.65,DIC(0)="ALMEQ" "RTN","MAGJMN1",240,0) D ^DIC I Y=-1 K DIC,DIE,DR,DLAYGO Q "RTN","MAGJMN1",241,0) S DIE=2006.65,DA=+Y,DR="[MAGJ PRIOR EDIT]" "RTN","MAGJMN1",242,0) S MAGIEN=DA "RTN","MAGJMN1",243,0) D ^DIE I '$D(DA) G EEPREF "RTN","MAGJMN1",244,0) G EEPREF "RTN","MAGJMN1",245,0) Q "RTN","MAGJMN1",246,0) INPREF ; Inquire VRad PreFetch "RTN","MAGJMN1",247,0) W @IOF,!!?10,"Inquire VistARad Prefetch Logic",!! "RTN","MAGJMN1",248,0) N MAGIEN,BY,FR,TO "RTN","MAGJMN1",249,0) S DIC=2006.65,DIC(0)="AMEQ" "RTN","MAGJMN1",250,0) D ^DIC I Y=-1 K DIC Q "RTN","MAGJMN1",251,0) S DA=+Y,(FR,TO)=$P(Y,U,2),MAGIEN=DA,L=0 "RTN","MAGJMN1",252,0) S BY="[MAGJ PRIOR SORT]",DIS(0)="I D0=MAGIEN" "RTN","MAGJMN1",253,0) D EN^DIP "RTN","MAGJMN1",254,0) R !,"Enter RETURN to continue: ",X:DTIME W ! "RTN","MAGJMN1",255,0) G INPREF "RTN","MAGJMN1",256,0) Q "RTN","MAGJMN1",257,0) PRPREF ;Print VRad Prefetch "RTN","MAGJMN1",258,0) N BY "RTN","MAGJMN1",259,0) W !! S DIC=2006.65,L=0,BY="[MAGJ PRIOR SORT]" "RTN","MAGJMN1",260,0) D EN1^DIP "RTN","MAGJMN1",261,0) R !,"Enter RETURN to continue: ",X:DTIME W ! "RTN","MAGJMN1",262,0) Q "RTN","MAGJMN1",263,0) ; "RTN","MAGJMN1",264,0) BGCSTOP ; Stop Background Compile program "RTN","MAGJMN1",265,0) N MAGCSTRT,GO,NTRY,RETRY,X "RTN","MAGJMN1",266,0) S MAGCSTRT=0,GO=1 "RTN","MAGJMN1",267,0) S X=$G(^MAG(2006.69,1,0)) "RTN","MAGJMN1",268,0) I X]"",+$P(X,U,8) D ; Background compile switch; skip if already false "RTN","MAGJMN1",269,0) . S ^MAG(2006.69,"BGSTOP")=X ; save current settings for restore later "RTN","MAGJMN1",270,0) . S MAGCSTRT=1 "RTN","MAGJMN1",271,0) . S $P(X,U,8)=0 "RTN","MAGJMN1",272,0) . S ^MAG(2006.69,1,0)=X ; disable compile "RTN","MAGJMN1",273,0) . W !!,*7,"Wait for Background Compile program to stop;" "RTN","MAGJMN1",274,0) . W !," this might take up to a few minutes." "RTN","MAGJMN1",275,0) . S NTRY=60 "RTN","MAGJMN1",276,0) . F I=1:1:NTRY W "." L +^XTMP("MAGJ2","BKGND2","RUN"):3 I Q ; process maintains lock while running "RTN","MAGJMN1",277,0) . I D "RTN","MAGJMN1",278,0) . . L -^XTMP("MAGJ2","BKGND2","RUN") "RTN","MAGJMN1",279,0) . . W !!,"Background Compile Stopped" "RTN","MAGJMN1",280,0) . . I +$G(MAGJKIDS) W "; proceeding with install.",! H 2 "RTN","MAGJMN1",281,0) . E D "RTN","MAGJMN1",282,0) . . S X=$$YN("Background Compile NOT Stopped -- Try again?","Y") "RTN","MAGJMN1",283,0) . . S RETRY=("Y"[X),GO=0 "RTN","MAGJMN1",284,0) . . S ^MAG(2006.69,1,0)=^MAG(2006.69,"BGSTOP") K ^MAG(2006.69,"BGSTOP") "RTN","MAGJMN1",285,0) I 'GO G BGCSTOP:RETRY "RTN","MAGJMN1",286,0) I 'GO,+$G(MAGJKIDS) W !!,*7," * * * Exiting out of patch installation * * * ",! H 3 S XPDQUIT=1 "RTN","MAGJMN1",287,0) Q "RTN","MAGJMN1",288,0) BGCSTRT ; re-enable Background Compile "RTN","MAGJMN1",289,0) I $D(^MAG(2006.69,"BGSTOP")) S X=^("BGSTOP") W " ... Enabling background compile ." "RTN","MAGJMN1",290,0) E Q "RTN","MAGJMN1",291,0) S ^MAG(2006.69,1,0)=X "RTN","MAGJMN1",292,0) K ^MAG(2006.69,"BGSTOP") "RTN","MAGJMN1",293,0) W !!,"Background Compile Enabled.",! H 3 "RTN","MAGJMN1",294,0) Q "RTN","MAGJMN1",295,0) ; "RTN","MAGJMN1",296,0) END ; "RTN","MAGJPRF1") 0^3^B142578165 "RTN","MAGJPRF1",1,0) MAGJPRF1 ;WIRMFO/JHC - VistARad RPCs-User Prefs ; 16-DEC-2010 1:12 PM "RTN","MAGJPRF1",2,0) ;;3.0;IMAGING;**18,115**;Mar 19, 2002;Build 1912;Dec 17, 2010 "RTN","MAGJPRF1",3,0) ;; Per VHA Directive 2004-038, this routine should not be modified. "RTN","MAGJPRF1",4,0) ;; +---------------------------------------------------------------+ "RTN","MAGJPRF1",5,0) ;; | Property of the US Government. | "RTN","MAGJPRF1",6,0) ;; | No permission to copy or redistribute this software is given. | "RTN","MAGJPRF1",7,0) ;; | Use of unreleased versions of this software requires the user | "RTN","MAGJPRF1",8,0) ;; | to execute a written test agreement with the VistA Imaging | "RTN","MAGJPRF1",9,0) ;; | Development Office of the Department of Veterans Affairs, | "RTN","MAGJPRF1",10,0) ;; | telephone (301) 734-0100. | "RTN","MAGJPRF1",11,0) ;; | The Food and Drug Administration classifies this software as | "RTN","MAGJPRF1",12,0) ;; | a medical device. As such, it may not be changed in any way. | "RTN","MAGJPRF1",13,0) ;; | Modifications to this software may result in an adulterated | "RTN","MAGJPRF1",14,0) ;; | medical device under 21CFR820, the use of which is considered | "RTN","MAGJPRF1",15,0) ;; | to be a violation of US Federal Statutes. | "RTN","MAGJPRF1",16,0) ;; +---------------------------------------------------------------+ "RTN","MAGJPRF1",17,0) ;; "RTN","MAGJPRF1",18,0) Q "RTN","MAGJPRF1",19,0) ERR ; "RTN","MAGJPRF1",20,0) N ERR S ERR=$$EC^%ZOSV S @MAGGRY@(0)="0^4~"_ERR "RTN","MAGJPRF1",21,0) D @^%ZOSF("ERRTN") "RTN","MAGJPRF1",22,0) Q:$Q 1 Q "RTN","MAGJPRF1",23,0) ; "RTN","MAGJPRF1",24,0) ;+++++ VistARad Client Operations on the MAGJ USER DATA file (#2006.68). "RTN","MAGJPRF1",25,0) ; "RTN","MAGJPRF1",26,0) RPCIN(MAGGRY,PARAMS,DATA) ; RPC: MAGJ USER DATA "RTN","MAGJPRF1",27,0) ;PARAMS: TXID ^ SYSUPDAT ^ TXDUZ ^ TXDIV "RTN","MAGJPRF1",28,0) ;TXID: Req'd--action to take; see below "RTN","MAGJPRF1",29,0) ;TXDUZ: Opt; if input, get data for another user "RTN","MAGJPRF1",30,0) ;TXDIV: Opt; if input, get data for another div "RTN","MAGJPRF1",31,0) ;SYSUPDAT: Opt; if input, save Sys Default data; Sec Key Req'd "RTN","MAGJPRF1",32,0) ; DATA--(opt) input array; depends on TXID; see subs by TXID "RTN","MAGJPRF1",33,0) ;Pattern for DATA input & reply is: "RTN","MAGJPRF1",34,0) ;*LABEL ; Start for one label "RTN","MAGJPRF1",35,0) ;Label_Name ; label name "RTN","MAGJPRF1",36,0) ;(1:N lines of XML text follow) "RTN","MAGJPRF1",37,0) ;*END ; end for label "RTN","MAGJPRF1",38,0) ;*LABEL ; Start for next label (etc.) "RTN","MAGJPRF1",39,0) ;Label_Name_2 "RTN","MAGJPRF1",40,0) ;*KEY ; index keys to follow (KEY data is opt) "RTN","MAGJPRF1",41,0) ;KeyNam1=nnn ; 1st key (free-text) "RTN","MAGJPRF1",42,0) ;KeyNam2=jjj ; 2nd key (etc.) "RTN","MAGJPRF1",43,0) ;*END_KEY ; end of keys "RTN","MAGJPRF1",44,0) ; (1:N lines of XML text follow) "RTN","MAGJPRF1",45,0) ;*END ; end for label "RTN","MAGJPRF1",46,0) ; "RTN","MAGJPRF1",47,0) N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJPRF1" "RTN","MAGJPRF1",48,0) N GPREF,MAGLST,PDIV,PREFIEN,READONLY,REPLY,SYSUPDAT,TXDIV,TXDUZ,TXID,TXTYPE "RTN","MAGJPRF1",49,0) S TXID=+PARAMS,SYSUPDAT=+$P(PARAMS,U,2),TXDUZ=$P(PARAMS,U,3),TXDIV=+$P(PARAMS,U,4) "RTN","MAGJPRF1",50,0) S MAGLST="MAGJRPC" K MAGGRY S MAGGRY=$NA(^TMP($J,MAGLST)) K @MAGGRY "RTN","MAGJPRF1",51,0) N DIQUIET S DIQUIET=1 D DT^DICRW "RTN","MAGJPRF1",52,0) ; no updates allowed if read another user's data, or get data for another logon division "RTN","MAGJPRF1",53,0) I 'TXDUZ,(TXDUZ="sysAdmin") S TXDUZ=$$SYSUSER() "RTN","MAGJPRF1",54,0) I 'TXDUZ S TXDUZ=DUZ "RTN","MAGJPRF1",55,0) I 'TXDIV S TXDIV=DUZ(2) "RTN","MAGJPRF1",56,0) S READONLY=(TXDUZ'=DUZ) "RTN","MAGJPRF1",57,0) ; I 'READONLY S READONLY=(TXDIV'=DUZ(2)) ; <*> ?? Put this check inside Div-sensitive operations <*> "RTN","MAGJPRF1",58,0) I READONLY,$D(MAGJOB("KEYS","MAGJ SYSTEM USER")),SYSUPDAT,(TXDUZ=$$SYSUSER()) S READONLY=0 ; get/update SysDefault data "RTN","MAGJPRF1",59,0) S PREFIEN=$$GETPRIEN(TXDUZ,READONLY) "RTN","MAGJPRF1",60,0) I 'PREFIEN S REPLY="0~Unable to get/update user data ("_$$USER(TXDUZ)_") for MAGJ USER DATA rpc call." G RPCINZ "RTN","MAGJPRF1",61,0) ; set this level based on the TXID "RTN","MAGJPRF1",62,0) S TXID=+$G(TXID) "RTN","MAGJPRF1",63,0) ; "RTN","MAGJPRF1",64,0) ;--- Workstation settings, user preferences, etc. "RTN","MAGJPRF1",65,0) S TXTYPE="VR-WS",GPREF=$NA(^MAG(2006.68,PREFIEN,TXTYPE)),PDIV="" "RTN","MAGJPRF1",66,0) I TXID=1 G:'READONLY SAVE S REPLY="Access for updating preferences denied." G RPCINZ ; Store prefs by label "RTN","MAGJPRF1",67,0) I TXID=2 G TAGS ; Get Labels w/ assoc. Keys "RTN","MAGJPRF1",68,0) I TXID=3 G PRFDATA ; Get pref data for labels "RTN","MAGJPRF1",69,0) I TXID=4 G:'READONLY TAGDEL S REPLY="Access for deleting preferences denied." G RPCINZ ; Delete labels "RTN","MAGJPRF1",70,0) I TXID=6 G USERS ; Get list of vrad users, including SysAdmin "RTN","MAGJPRF1",71,0) ; "RTN","MAGJPRF1",72,0) ;--- Hanging Protocols "RTN","MAGJPRF1",73,0) S TXTYPE="VR-HP",GPREF=$NA(^MAG(2006.68,PREFIEN,TXTYPE)),PDIV="" "RTN","MAGJPRF1",74,0) I TXID=11 G:'READONLY SAVE S REPLY="Access for updating Hanging Protocols denied." G RPCINZ ; Store HP by label "RTN","MAGJPRF1",75,0) I TXID=12 G TAGS ; Get HP Labels "RTN","MAGJPRF1",76,0) I TXID=13 G PRFDATA ; Get data for HP labels "RTN","MAGJPRF1",77,0) I TXID=14 G:'READONLY TAGDEL S REPLY="Access for deleting Hanging Protocol denied." G RPCINZ ; Delete HP labels "RTN","MAGJPRF1",78,0) ; "RTN","MAGJPRF1",79,0) ;--- Single call batch delete of either VR-WS or VR-HP tags (MAG*3.0*115). "RTN","MAGJPRF1",80,0) I TXID=15 G:'READONLY TAGDEL2 S REPLY="Access for deleting preferences denied." G RPCINZ "RTN","MAGJPRF1",81,0) I TXID=16 G:'READONLY TAGDEL2 S REPLY="Access for deleting Hanging Protocols denied." G RPCINZ "RTN","MAGJPRF1",82,0) ; "RTN","MAGJPRF1",83,0) E S REPLY="0~Invalid transaction (TX="_TXID_") requested by MAGJ USER DATA rpc call." "RTN","MAGJPRF1",84,0) RPCINZ ; "RTN","MAGJPRF1",85,0) S @MAGGRY@(0)=0_U_REPLY "RTN","MAGJPRF1",86,0) Q "RTN","MAGJPRF1",87,0) ; "RTN","MAGJPRF1",88,0) ;+++++ Get existing or newly created IEN of a MAGJ USER DATA entry for input DUZ. "RTN","MAGJPRF1",89,0) ; "RTN","MAGJPRF1",90,0) ; Internal utility function called by RPCIN+33. "RTN","MAGJPRF1",91,0) ; "RTN","MAGJPRF1",92,0) GETPRIEN(DUZ,READONLY) ; Lookup/create User Pref entry for input DUZ "RTN","MAGJPRF1",93,0) ; READONLY: True for lookup-only (no create) "RTN","MAGJPRF1",94,0) N PREFIEN,T,X "RTN","MAGJPRF1",95,0) S PREFIEN=$O(^MAG(2006.68,"AC",+DUZ,"")) I 'PREFIEN,'READONLY D "RTN","MAGJPRF1",96,0) . L +^MAG(2006.68,0):10 "RTN","MAGJPRF1",97,0) . E Q "RTN","MAGJPRF1",98,0) . ; "RTN","MAGJPRF1",99,0) . ;--- Get next IEN & upd8 overhead node. "RTN","MAGJPRF1",100,0) . S X=$G(^MAG(2006.68,0)) "RTN","MAGJPRF1",101,0) . S PREFIEN=+$P(X,U,3) "RTN","MAGJPRF1",102,0) . F S PREFIEN=PREFIEN+1 I '$D(^MAG(2006.68,PREFIEN)) Q "RTN","MAGJPRF1",103,0) . S T=$P(X,U,4)+1,$P(X,U,3)=PREFIEN,$P(X,U,4)=T "RTN","MAGJPRF1",104,0) . S ^MAG(2006.68,0)=X "RTN","MAGJPRF1",105,0) . ; "RTN","MAGJPRF1",106,0) . ;--- Set new entry & cross references. "RTN","MAGJPRF1",107,0) . S T=$$USER(+DUZ),^MAG(2006.68,PREFIEN,0)=$P(T,U)_U_+DUZ_U_$P(T,U,3) "RTN","MAGJPRF1",108,0) . S ^MAG(2006.68,"B",$P(T,U),PREFIEN)="" "RTN","MAGJPRF1",109,0) . S ^MAG(2006.68,"AC",+DUZ,PREFIEN)="" "RTN","MAGJPRF1",110,0) . L -^MAG(2006.68,0) "RTN","MAGJPRF1",111,0) Q PREFIEN "RTN","MAGJPRF1",112,0) ; "RTN","MAGJPRF1",113,0) ;+++++ Save User Preference XML data by Label. "RTN","MAGJPRF1",114,0) ; "RTN","MAGJPRF1",115,0) ; Internal entry point branched to by RPCIN if TXID=1 or TXID=11. "RTN","MAGJPRF1",116,0) ; "RTN","MAGJPRF1",117,0) SAVE ; Save User Pref data by Label "RTN","MAGJPRF1",118,0) N DUMMY,KEYCT,KEYS,LBLCT,LINCT,NEWTAG,STUFF,TAGCT,TAGIEN "RTN","MAGJPRF1",119,0) S (DUMMY,KEYCT,KEYS,LBLCT,LINCT,NEWTAG,STUFF,TAGCT,TAGIEN)=0 "RTN","MAGJPRF1",120,0) N IDATA,LINE S (IDATA,LINE)="" "RTN","MAGJPRF1",121,0) F S IDATA=$O(DATA(IDATA)) Q:IDATA="" S LINE=DATA(IDATA) I LINE]"" D "RTN","MAGJPRF1",122,0) . I LINE="*LABEL" S NEWTAG=1,STUFF=0 Q "RTN","MAGJPRF1",123,0) . I LINE="*END" S NEWTAG=0,STUFF=0 Q "RTN","MAGJPRF1",124,0) . I NEWTAG S TAG=LINE D TAGINIT(TAG) Q ; Init the storage for this tag "RTN","MAGJPRF1",125,0) . I 'STUFF S TAG="*DUM" D TAGINIT(TAG) ; got text line w/out prior label; init dummy tag "RTN","MAGJPRF1",126,0) . S TAGCT=TAGCT+1,@GPREF@(TAGIEN,1,TAGCT,0)=LINE,LINCT=LINCT+1 "RTN","MAGJPRF1",127,0) . S $P(@GPREF@(TAGIEN,1,0),U,3,4)=TAGCT_U_TAGCT "RTN","MAGJPRF1",128,0) . I TAG="*DUM" S LINCT=LINCT-1 ; don't count dummy lines/labels "RTN","MAGJPRF1",129,0) . I LINE="*KEY" S KEYS=1 "RTN","MAGJPRF1",130,0) . I KEYS D "RTN","MAGJPRF1",131,0) . . S KEYCT=+$P($G(@GPREF@(TAGIEN,2,0)),U,4)+1,^(0)="^2006.6823^"_KEYCT_U_KEYCT "RTN","MAGJPRF1",132,0) . . S @GPREF@(TAGIEN,2,KEYCT,0)=LINE "RTN","MAGJPRF1",133,0) . I LINE="*END_KEY" S KEYS=0 "RTN","MAGJPRF1",134,0) I LINCT S REPLY=1_"~"_LINCT_" Text line"_$S(LINCT-1:"s",1:"")_" were stored for "_LBLCT_" label"_$S(LBLCT-1:"s.",1:".") "RTN","MAGJPRF1",135,0) E S REPLY="0~No data was stored." "RTN","MAGJPRF1",136,0) S @MAGGRY@(0)=0_U_REPLY "RTN","MAGJPRF1",137,0) Q "RTN","MAGJPRF1",138,0) ; "RTN","MAGJPRF1",139,0) ;+++++ Initialize a single User Preference tag, and some variables for SAVE. "RTN","MAGJPRF1",140,0) ; "RTN","MAGJPRF1",141,0) ; Internal entry point called by SAVE+7, SAVE+8. "RTN","MAGJPRF1",142,0) ; "RTN","MAGJPRF1",143,0) TAGINIT(TAG) ; Init storage space for a tag; inits some vars for SAVE "RTN","MAGJPRF1",144,0) N TAGCTRL "RTN","MAGJPRF1",145,0) I PDIV,(TAG'="*DUM") S TAG=PDIV_"*DIV*"_TAG ; tags tracked by division "RTN","MAGJPRF1",146,0) S TAGIEN=$O(@GPREF@("B",TAG,"")) I 'TAGIEN D ; for new tag, create a new LABEL node, "RTN","MAGJPRF1",147,0) . L +@GPREF@(0):10 "RTN","MAGJPRF1",148,0) . E Q "RTN","MAGJPRF1",149,0) . S X=$G(@GPREF@(0)) S:X="" X="^2006.682A^0^0" "RTN","MAGJPRF1",150,0) . S TAGIEN=$P(X,U,3) "RTN","MAGJPRF1",151,0) . F S TAGIEN=TAGIEN+1 I '$D(@GPREF@(TAGIEN)) Q "RTN","MAGJPRF1",152,0) . S T=$P(X,U,4)+1,$P(X,U,3)=TAGIEN,$P(X,U,4)=T "RTN","MAGJPRF1",153,0) . S @GPREF@(0)=X,@GPREF@("B",TAG,TAGIEN)="" "RTN","MAGJPRF1",154,0) . L -@GPREF@(0) "RTN","MAGJPRF1",155,0) . S $P(@GPREF@(TAGIEN,0),U)=TAG "RTN","MAGJPRF1",156,0) I TAG'="*DUM"!((TAG="*DUM")&'DUMMY) D "RTN","MAGJPRF1",157,0) . S TAGCTRL=$G(@GPREF@(TAGIEN,1,0)) K @GPREF@(TAGIEN,1),^(2) ; init Data & Keys "RTN","MAGJPRF1",158,0) . S $P(TAGCTRL,U,2)=2006.6821,$P(TAGCTRL,U,3,4)=0_U_0 "RTN","MAGJPRF1",159,0) . S @GPREF@(TAGIEN,1,0)=TAGCTRL "RTN","MAGJPRF1",160,0) . S TAGCT=0,LBLCT=LBLCT+1 "RTN","MAGJPRF1",161,0) I TAG="*DUM" S TAGCT=+$P(@GPREF@(TAGIEN,1,0),U,3),LBLCT=LBLCT-'DUMMY,DUMMY=1 ; don't count dummy label "RTN","MAGJPRF1",162,0) S NEWTAG=0,STUFF=1 "RTN","MAGJPRF1",163,0) Q "RTN","MAGJPRF1",164,0) ; "RTN","MAGJPRF1",165,0) ;+++++ Return list of workstation or hanging protocol User Preference tags for a user. "RTN","MAGJPRF1",166,0) ; "RTN","MAGJPRF1",167,0) ; Internal entry point branched to by RPCIN if TXID=2 or TXID=12. "RTN","MAGJPRF1",168,0) ; "RTN","MAGJPRF1",169,0) TAGS ; return list of tags stored "RTN","MAGJPRF1",170,0) ; don't report *DUM tags "RTN","MAGJPRF1",171,0) N CT,OTAG,TAG,TAGCT,TAGIEN "RTN","MAGJPRF1",172,0) S (CT,TAG,TAGCT)=0 "RTN","MAGJPRF1",173,0) F S TAG=$O(@GPREF@("B",TAG)) Q:TAG="" S TAGIEN=$O(^(TAG,"")) I TAG'="*DUM" D "RTN","MAGJPRF1",174,0) . I PDIV Q:PDIV'=+TAG S OTAG=$P(TAG,"*DIV*",2,99) "RTN","MAGJPRF1",175,0) . E S OTAG=TAG "RTN","MAGJPRF1",176,0) . S CT=CT+1,@MAGGRY@(CT)=OTAG,TAGCT=TAGCT+1 "RTN","MAGJPRF1",177,0) . I $D(@GPREF@(TAGIEN,2)) D "RTN","MAGJPRF1",178,0) . . N KEYCT S KEYCT=0 "RTN","MAGJPRF1",179,0) . . F S KEYCT=$O(@GPREF@(TAGIEN,2,KEYCT)) Q:'KEYCT S X=^(KEYCT,0),CT=CT+1,@MAGGRY@(CT)=X "RTN","MAGJPRF1",180,0) I TAGCT S REPLY=1_"~"_TAGCT_" tag"_$S(TAGCT-1:"s",1:"")_" returned." "RTN","MAGJPRF1",181,0) E S REPLY="0~No data found." "RTN","MAGJPRF1",182,0) S @MAGGRY@(0)=CT_U_REPLY "RTN","MAGJPRF1",183,0) Q "RTN","MAGJPRF1",184,0) ; "RTN","MAGJPRF1",185,0) SYSUSER(X) ; get System user DUZ value "RTN","MAGJPRF1",186,0) S X=.5 ; =Postmaster "RTN","MAGJPRF1",187,0) Q:$Q X Q "RTN","MAGJPRF1",188,0) ; "RTN","MAGJPRF1",189,0) USER(DUZ) ; get user name, initials & vrad user type "RTN","MAGJPRF1",190,0) N RSL,X S RSL=DUZ "RTN","MAGJPRF1",191,0) I DUZ=$$SYSUSER() S RSL="sysAdmin^SYS^9" "RTN","MAGJPRF1",192,0) E I DUZ D "RTN","MAGJPRF1",193,0) . S RSL=$$USERINF^MAGJUTL3(DUZ,".01;1") "RTN","MAGJPRF1",194,0) . F X="S","R","T" I $D(^VA(200,"ARC",X,DUZ)) Q "RTN","MAGJPRF1",195,0) . I S X=$S(X="S":3,X="R":2,X="T":1,1:0) "RTN","MAGJPRF1",196,0) . E S X=0 "RTN","MAGJPRF1",197,0) . S RSL=RSL_U_X "RTN","MAGJPRF1",198,0) Q:$Q RSL Q "RTN","MAGJPRF1",199,0) ; "RTN","MAGJPRF1",200,0) ;+++++ List MAGJ USER DATA File (#2006.28) user entries. "RTN","MAGJPRF1",201,0) ; "RTN","MAGJPRF1",202,0) ; Internal Entry Point branched to from tag RPCIN if TXID=6. "RTN","MAGJPRF1",203,0) ; "RTN","MAGJPRF1",204,0) ; Returns: "RTN","MAGJPRF1",205,0) ; "RTN","MAGJPRF1",206,0) ; ^(0) "RTN","MAGJPRF1",207,0) ; ^1: Count "RTN","MAGJPRF1",208,0) ; ^2: Reply Message "RTN","MAGJPRF1",209,0) ; ^(1:n) "RTN","MAGJPRF1",210,0) ; ^1: DUZ "RTN","MAGJPRF1",211,0) ; ^2: FULL NAME "RTN","MAGJPRF1",212,0) ; ^3: INITIALS "RTN","MAGJPRF1",213,0) ; ^4: USER TYPE "RTN","MAGJPRF1",214,0) ; "RTN","MAGJPRF1",215,0) ; Notes "RTN","MAGJPRF1",216,0) ; ===== "RTN","MAGJPRF1",217,0) ; "RTN","MAGJPRF1",218,0) ; Screened off are 1) The current user & 2) terminated or DISUSER'd users. "RTN","MAGJPRF1",219,0) ; If a terminated/DISUSER'd user's profile is still in use as a default "RTN","MAGJPRF1",220,0) ; profile, their entry will only be returned as its default. A terminated "RTN","MAGJPRF1",221,0) ; or DISUSER'd POSTMASTER (System User) is exempted from the screen. "RTN","MAGJPRF1",222,0) ; "RTN","MAGJPRF1",223,0) ; Sorting: Default profiles/System User/Radiologists/Non-Rist's. "RTN","MAGJPRF1",224,0) ; "RTN","MAGJPRF1",225,0) USERS ; "RTN","MAGJPRF1",226,0) N CT,IEN,INIT,NAME,REPLY,TOUT,USERDUZ,USERTYP "RTN","MAGJPRF1",227,0) S (CT,IEN)=0 "RTN","MAGJPRF1",228,0) F S IEN=$O(^MAG(2006.68,IEN)) Q:'IEN S X=^(IEN,0) D "RTN","MAGJPRF1",229,0) . S USERDUZ=$P(X,U,2) "RTN","MAGJPRF1",230,0) . S X=$$USER(USERDUZ),NAME=$P(X,U),INIT=$P(X,U,2),USERTYP=$P(X,U,3) "RTN","MAGJPRF1",231,0) . S:NAME="" NAME="~" "RTN","MAGJPRF1",232,0) . ; "RTN","MAGJPRF1",233,0) . ;--- Filter Terminants & DISUSER'd Users, except System User (MAG*3.0*115). "RTN","MAGJPRF1",234,0) . S:($$ZRUACTIV(USERDUZ)!(USERDUZ=$$SYSUSER())) TOUT(-USERTYP,NAME,USERDUZ)=INIT "RTN","MAGJPRF1",235,0) . ; "RTN","MAGJPRF1",236,0) . ;--- If client => 115, create dummies if profile is a default (MAG*3.0*115) "RTN","MAGJPRF1",237,0) . Q:$P(MAGJOB("VRVERSION"),".",3)<115 "RTN","MAGJPRF1",238,0) . N MAGJDUMY S MAGJDUMY=$$ZRUDFALT(IEN) Q:MAGJDUMY="" S CT=CT+1 "RTN","MAGJPRF1",239,0) . S TOUT(-(1000-CT),MAGJDUMY,"D*"_USERDUZ)=INIT "RTN","MAGJPRF1",240,0) S CT=0,USERTYP="" F S USERTYP=$O(TOUT(USERTYP)) Q:USERTYP="" S NAME="" D "RTN","MAGJPRF1",241,0) . F S NAME=$O(TOUT(USERTYP,NAME)) Q:NAME="" S USERDUZ="" D "RTN","MAGJPRF1",242,0) . . F S USERDUZ=$O(TOUT(USERTYP,NAME,USERDUZ)) Q:USERDUZ="" D "RTN","MAGJPRF1",243,0) . . . S CT=CT+1,@MAGGRY@(CT)=USERDUZ_U_NAME_U_TOUT(USERTYP,NAME,USERDUZ)_U_-USERTYP "RTN","MAGJPRF1",244,0) I CT S REPLY=1_"~"_CT_" user"_$S(CT-1:"s",1:"")_" returned." "RTN","MAGJPRF1",245,0) E S REPLY="0~No data found." "RTN","MAGJPRF1",246,0) S @MAGGRY@(0)=CT_U_REPLY "RTN","MAGJPRF1",247,0) Q "RTN","MAGJPRF1",248,0) ; "RTN","MAGJPRF1",249,0) ;+++++ Return XML User Preference data for input Labels. "RTN","MAGJPRF1",250,0) ; "RTN","MAGJPRF1",251,0) ; Internal entry point branched to by tag RPCIN if TXID=3 or TXID=13. "RTN","MAGJPRF1",252,0) ; "RTN","MAGJPRF1",253,0) PRFDATA ; RETURN data stored for input Labels "RTN","MAGJPRF1",254,0) N CT,IDATA,LINCT,NTAGS,OTAG,TAG,TAGCT,TAGIEN,TAGS,X "RTN","MAGJPRF1",255,0) S IDATA="",(CT,LINCT,NTAGS)=0 "RTN","MAGJPRF1",256,0) F S IDATA=$O(DATA(IDATA)) Q:IDATA="" S TAG=DATA(IDATA) I TAG]"" D "RTN","MAGJPRF1",257,0) . I PDIV,(TAG'="*DUM") S TAG=PDIV_"*DIV*"_TAG ; tags tracked by div "RTN","MAGJPRF1",258,0) . S TAGS(TAG)="" "RTN","MAGJPRF1",259,0) S TAG=0 "RTN","MAGJPRF1",260,0) F S TAG=$O(TAGS(TAG)) Q:TAG="" D "RTN","MAGJPRF1",261,0) . S TAGIEN=$O(@GPREF@("B",TAG,"")),NTAGS=NTAGS+1 "RTN","MAGJPRF1",262,0) . S OTAG=TAG I PDIV S OTAG=$P(TAG,"*DIV*",2,99) "RTN","MAGJPRF1",263,0) . S CT=CT+1,@MAGGRY@(CT)="*LABEL" "RTN","MAGJPRF1",264,0) . S CT=CT+1,@MAGGRY@(CT)=OTAG "RTN","MAGJPRF1",265,0) . I TAGIEN S TAGCT=0 D "RTN","MAGJPRF1",266,0) . . F S TAGCT=$O(@GPREF@(TAGIEN,1,TAGCT)) Q:'TAGCT S X=^(TAGCT,0),CT=CT+1,@MAGGRY@(CT)=X,LINCT=LINCT+1 "RTN","MAGJPRF1",267,0) . S CT=CT+1,@MAGGRY@(CT)="*END" "RTN","MAGJPRF1",268,0) I CT S REPLY=1_"~"_LINCT_" Text line"_$S(LINCT-1:"s",1:"")_" returned for "_NTAGS_" tags." "RTN","MAGJPRF1",269,0) E S REPLY="0~No data found." "RTN","MAGJPRF1",270,0) S @MAGGRY@(0)=CT_U_REPLY "RTN","MAGJPRF1",271,0) Q "RTN","MAGJPRF1",272,0) ; "RTN","MAGJPRF1",273,0) ;+++++ Delete XML User Preference data for input Labels. "RTN","MAGJPRF1",274,0) ; "RTN","MAGJPRF1",275,0) ; Internal entry point branched to by tag RPCIN if TXID=4 or TXID=14. "RTN","MAGJPRF1",276,0) ; "RTN","MAGJPRF1",277,0) TAGDEL ; Delete tags and assoc data. RPCIN calls only if 'READONLY. "RTN","MAGJPRF1",278,0) N CT,ERR,IDATA,TAG,TAGIEN "RTN","MAGJPRF1",279,0) S (CT,TAG)=0,(ERR,IDATA)="" "RTN","MAGJPRF1",280,0) F S IDATA=$O(DATA(IDATA)) Q:IDATA="" S TAG=DATA(IDATA) I TAG]"" D "RTN","MAGJPRF1",281,0) . I PDIV,(TAG'="*DUM") S TAG=PDIV_"*DIV*"_TAG ; tags tracked by div "RTN","MAGJPRF1",282,0) . S TAGIEN=$O(@GPREF@("B",TAG,"")) I TAGIEN D "RTN","MAGJPRF1",283,0) . . L +@GPREF@(0):10 I $T D "RTN","MAGJPRF1",284,0) . . . K @GPREF@(TAGIEN),@GPREF@("B",TAG) "RTN","MAGJPRF1",285,0) . . . S X=$G(@GPREF@(0),"^2006.682A^0^0") S T=+$P(X,U,4) S:T T=T-1 S $P(X,U,4)=T,^(0)=X "RTN","MAGJPRF1",286,0) . . . S CT=CT+1 "RTN","MAGJPRF1",287,0) . . . L -@GPREF@(0) "RTN","MAGJPRF1",288,0) . . E D "RTN","MAGJPRF1",289,0) . . . S ERR="0~Unable to perform Delete operation." "RTN","MAGJPRF1",290,0) I CT S REPLY=1_"~"_CT_" label"_$S(CT-1:"s",1:"")_" deleted." "RTN","MAGJPRF1",291,0) E S REPLY=$S(ERR]"":ERR,1:"0~No label data found.") "RTN","MAGJPRF1",292,0) S @MAGGRY@(0)=0_U_REPLY "RTN","MAGJPRF1",293,0) Q "RTN","MAGJPRF1",294,0) ; "RTN","MAGJPRF1",295,0) ;+++++ DELETE ALL SUB-FILE ENTRIES FOR WORKSTATION OR HANGING PROTOCOL DATA "RTN","MAGJPRF1",296,0) ; "RTN","MAGJPRF1",297,0) ; Internal entry point branched to by tag RPCIN if TXID=15 or TXID=16. "RTN","MAGJPRF1",298,0) ; "RTN","MAGJPRF1",299,0) ; Expects DUZ,MAGGRY,TXID "RTN","MAGJPRF1",300,0) ; "RTN","MAGJPRF1",301,0) ; Returns (in @MAGGRY): "RTN","MAGJPRF1",302,0) ; "RTN","MAGJPRF1",303,0) ; ^(0) "RTN","MAGJPRF1",304,0) ; ^1: 0 -- normal execution w/ reply string to follow. "RTN","MAGJPRF1",305,0) ; ^2: reply string w/ number/type of nodes deleted, or ... "RTN","MAGJPRF1",306,0) ; ... reason request not processed. "RTN","MAGJPRF1",307,0) ; "RTN","MAGJPRF1",308,0) TAGDEL2 ; "RTN","MAGJPRF1",309,0) N RETMSG "RTN","MAGJPRF1",310,0) D "RTN","MAGJPRF1",311,0) . N SUBDATA S SUBDATA=$S(TXID=15:"VR-HP",TXID=16:"VR-WS",1:0) "RTN","MAGJPRF1",312,0) . I SUBDATA=0 S RETMSG="Invalid request: "_TXID_"." Q "RTN","MAGJPRF1",313,0) . ; "RTN","MAGJPRF1",314,0) . ;--- Lookup D0 from DUZ via ^DIC from the "AC" x-ref, or return notFound. "RTN","MAGJPRF1",315,0) . N XIEN S XIEN=$$FIND1^DIC(2006.68,"","Q",DUZ,"AC","","") "RTN","MAGJPRF1",316,0) . I 'XIEN S RETMSG="No user entry in MAGJ USER DATA File." Q "RTN","MAGJPRF1",317,0) . ; "RTN","MAGJPRF1",318,0) . ;--- Initialize ^DIK call to delete requested tag data. "RTN","MAGJPRF1",319,0) . N DA,DIK "RTN","MAGJPRF1",320,0) . S DA(1)=XIEN,DIK="^MAG(2006.68,"_DA(1)_","""_SUBDATA_"""," "RTN","MAGJPRF1",321,0) . ; "RTN","MAGJPRF1",322,0) . ;--- Quit and report if "MAGJ USER DATA sub-file not found." "RTN","MAGJPRF1",323,0) . N MAGNOD S MAGNOD=DIK_"0)" "RTN","MAGJPRF1",324,0) . I '$D(@MAGNOD) S RETMSG="MAGJ USER DATA sub-file not found." Q "RTN","MAGJPRF1",325,0) . ; "RTN","MAGJPRF1",326,0) . ;--- Lock node, initialize counter & traverse for DA values to KILL. "RTN","MAGJPRF1",327,0) . L +^MAG(2006.68,DA(1),SUBDATA):5 I $T D "RTN","MAGJPRF1",328,0) . . N MAGCT S MAGCT=0 "RTN","MAGJPRF1",329,0) . . S DA="A" "RTN","MAGJPRF1",330,0) . . F S DA=$O(^MAG(2006.68,DA(1),SUBDATA,DA),-1) Q:DA=0 D ^DIK S MAGCT=MAGCT+1 "RTN","MAGJPRF1",331,0) . . ; "RTN","MAGJPRF1",332,0) . . ;--- Clean up dangling cross-references, set reply, & unlock. "RTN","MAGJPRF1",333,0) . . K:$D(^MAG(2006.68,DA(1),SUBDATA,"B")) ^MAG(2006.68,DA(1),SUBDATA,"B") "RTN","MAGJPRF1",334,0) . . S RETMSG=MAGCT_" "_SUBDATA_" nodes deleted." "RTN","MAGJPRF1",335,0) . . L -^MAG(2006.68,DA(1),SUBDATA) "RTN","MAGJPRF1",336,0) . . Q "RTN","MAGJPRF1",337,0) . E D "RTN","MAGJPRF1",338,0) . . S RETMSG="Unable to lock MAGJ USER DATA File." "RTN","MAGJPRF1",339,0) . . Q "RTN","MAGJPRF1",340,0) . Q "RTN","MAGJPRF1",341,0) ; "RTN","MAGJPRF1",342,0) S @MAGGRY@(0)=0_U_RETMSG "RTN","MAGJPRF1",343,0) Q "RTN","MAGJPRF1",344,0) ; "RTN","MAGJPRF1",345,0) ;+++++ Check if user terminated, or inactivated by DISUSER flag (MAG*3.0*115). "RTN","MAGJPRF1",346,0) ; "RTN","MAGJPRF1",347,0) ; Internal utility function called from USERS+9. "RTN","MAGJPRF1",348,0) ; "RTN","MAGJPRF1",349,0) ; Input: DUZ of user to check. "RTN","MAGJPRF1",350,0) ; "RTN","MAGJPRF1",351,0) ; Returns: 0 ... User is inactive. "RTN","MAGJPRF1",352,0) ; 1 ... User is active. "RTN","MAGJPRF1",353,0) ; "RTN","MAGJPRF1",354,0) ZRUACTIV(CHKDUZ) ; "RTN","MAGJPRF1",355,0) N YNACTIVE "RTN","MAGJPRF1",356,0) S YNACTIVE=0 D "RTN","MAGJPRF1",357,0) . N VADISUSR,VATERMDT "RTN","MAGJPRF1",358,0) . S VADISUSR=$$GET1^DIQ(200,CHKDUZ_",",7,"I") Q:VADISUSR=1 "RTN","MAGJPRF1",359,0) . S VATERMDT=$$GET1^DIQ(200,CHKDUZ_",",9.2,"I") "RTN","MAGJPRF1",360,0) . I $D(VATERMDT) N X,X1,X2 S X1=$$DT^XLFDT(),X2=VATERMDT D ^%DTC Q:X>0 "RTN","MAGJPRF1",361,0) . S YNACTIVE=1 "RTN","MAGJPRF1",362,0) Q YNACTIVE "RTN","MAGJPRF1",363,0) ; "RTN","MAGJPRF1",364,0) ;+++++ Check if a MAGJ USER DATA entry is designated as a default profile. "RTN","MAGJPRF1",365,0) ; "RTN","MAGJPRF1",366,0) ; Internal utility function called from USERS+12. "RTN","MAGJPRF1",367,0) ; "RTN","MAGJPRF1",368,0) ; Input: CHKIEN ... IEN of a MAGJ USER DATA File (#2006.68) entry. "RTN","MAGJPRF1",369,0) ; "RTN","MAGJPRF1",370,0) ; Returns: DEFFLAG "RTN","MAGJPRF1",371,0) ; null ... not a default "RTN","MAGJPRF1",372,0) ; default radiologist profile ... default "RTN","MAGJPRF1",373,0) ; default non-radiologist profile ... default "RTN","MAGJPRF1",374,0) ; "RTN","MAGJPRF1",375,0) ZRUDFALT(CHKIEN) ; "RTN","MAGJPRF1",376,0) ; "RTN","MAGJPRF1",377,0) ;--- Set the IMAGING SITE PARAMETERS IEN. "RTN","MAGJPRF1",378,0) N ISPIEN S ISPIEN=+$$IMGSIT^MAGJUTL1(DUZ(2),1) "RTN","MAGJPRF1",379,0) ; "RTN","MAGJPRF1",380,0) ;--- Retrieve default profile pointers from IMAGING SITE PARAMETERS (#2006.1). "RTN","MAGJPRF1",381,0) N MAGNOD S MAGNOD=$G(^MAG(2006.1,ISPIEN,5)) "RTN","MAGJPRF1",382,0) N DEFFLAG,DEFNON,DEFRAD S DEFRAD=$P(MAGNOD,U,7),DEFNON=$P(MAGNOD,U,8) "RTN","MAGJPRF1",383,0) ; "RTN","MAGJPRF1",384,0) S DEFFLAG=$S(CHKIEN=DEFRAD:"RADIOLOGIST",CHKIEN=DEFNON:"NON-RADIOLOGIST",1:"") "RTN","MAGJPRF1",385,0) S:DEFFLAG'="" DEFFLAG="DEFAULT "_DEFFLAG_" PROFILE" "RTN","MAGJPRF1",386,0) Q DEFFLAG "RTN","MAGJPRF1",387,0) ; "RTN","MAGJPRF1",388,0) ; "RTN","MAGJPRF1",389,0) END ; "RTN","MAGJTU4V") 0^4^B4995092 "RTN","MAGJTU4V",1,0) MAGJTU4V ;WOIFO/MAT - VERSION CONTROL (VISTARAD) ; 15-DEC-2010 6:13pm "RTN","MAGJTU4V",2,0) ;;3.0;IMAGING;**90,115**;Mar 19, 2002;Build 1912;Dec 17, 2010 "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.115 | 4 | ?? | Feb 2011 *Projected Seq # & Release | "RTN","MAGJTU4V",27,0) ;;| 3.0.90 | 9 | 66 | Aug 2010 | "RTN","MAGJTU4V",28,0) ;;| 3.0.101 | 10 | 61 | Feb 2010 | "RTN","MAGJTU4V",29,0) ;;================================================================== "RTN","MAGJTU4V",30,0) ; "RTN","MAGJTU4V",31,0) ; Each row of the version control table contains the version and "RTN","MAGJTU4V",32,0) ; build number of a supported client. Released patches must also "RTN","MAGJTU4V",33,0) ; indicate the sequential numbers. "RTN","MAGJTU4V",34,0) ; "RTN","MAGJTU4V",35,0) ; Sort order of the rows does not matter. However, the reversed "RTN","MAGJTU4V",36,0) ; order of patch sequential numbers is recommended. "RTN","MAGJTU4V",37,0) ; "RTN","MAGJTU4V",38,0) Q "RTN","MAGJTU4V",39,0) ; "RTN","MAGJTU4V",40,0) ;***** ADDS A CLIENT-SPECIFIC WARNING (IF NECESSARY) "RTN","MAGJTU4V",41,0) ; "RTN","MAGJTU4V",42,0) ; .MAGBUF Reference to a local array that the warning text "RTN","MAGJTU4V",43,0) ; is returned to. It is appended to the RPC result "RTN","MAGJTU4V",44,0) ; array by the caller (WARNING^MAGGTU41). "RTN","MAGJTU4V",45,0) ; "RTN","MAGJTU4V",46,0) ; CLVER Client application version (Major.Minor.Patch.Build) "RTN","MAGJTU4V",47,0) ; "RTN","MAGJTU4V",48,0) ; CVRC Version check code returned by the $$CHKVER1^MAGGTU41 "RTN","MAGJTU4V",49,0) ; "RTN","MAGJTU4V",50,0) ; Notes "RTN","MAGJTU4V",51,0) ; ===== "RTN","MAGJTU4V",52,0) ; "RTN","MAGJTU4V",53,0) ; If the RPC result array already contains an error message that "RTN","MAGJTU4V",54,0) ; will terminate the client, application, this procedure is not "RTN","MAGJTU4V",55,0) ; called. "RTN","MAGJTU4V",56,0) ; "RTN","MAGJTU4V",57,0) WARNING(MAGBUF,CLVER,CVRC) ; "RTN","MAGJTU4V",58,0) Q "RTN","MAGJUTL5") 0^5^B33147179 "RTN","MAGJUTL5",1,0) MAGJUTL5 ;WOIFO/JHC - VistARad RPCs ; 15-DEC-2010 6:11 PM "RTN","MAGJUTL5",2,0) ;;3.0;IMAGING;**65,76,101,90,115**;Mar 19, 2002;Build 1912;Dec 17, 2010 "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) ; "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.115",SVRTVER=4 ; <*> Edit this line for each patch/T-version "RTN","MAGJUTL5",28,0) ; "RTN","MAGJUTL5",29,0) S ALLOWCL="|3.0.101|3.0.90|" ; back-compatible with P101 & P90 client "RTN","MAGJUTL5",30,0) Q "RTN","MAGJUTL5",31,0) ; "RTN","MAGJUTL5",32,0) CHKVER(MAGRY,CLVER,PLC,SVERSION) ; "RTN","MAGJUTL5",33,0) ; Input CLVER is the version of the Client "RTN","MAGJUTL5",34,0) ; format: Major.Minor.Patch.Build# (Build #=T-ver) eg 3.0.18.132 "RTN","MAGJUTL5",35,0) ; 3 possible return codes in MAGRY: "RTN","MAGJUTL5",36,0) ; 2^n~msg : Client displays a message and continues "RTN","MAGJUTL5",37,0) ; 1^1~msg : Client continues without displaying a message "RTN","MAGJUTL5",38,0) ; 0^n~msg : Client displays a message then Aborts "RTN","MAGJUTL5",39,0) ; PLC returns 2006.1 pointer "RTN","MAGJUTL5",40,0) ; "RTN","MAGJUTL5",41,0) S CLVER=$G(CLVER),PLC="",MAGRY="" "RTN","MAGJUTL5",42,0) N SV,ST,CV,CT,CP,ALLOWV,TESTFLAG,SVSTAT "RTN","MAGJUTL5",43,0) ; SVERSION = Full Server Version -> (3.0.18.132 or 3.0.18); test has 4, release has 3 parts "RTN","MAGJUTL5",44,0) ; SV = Server Version -> (3.0.18); only 1st 3 parts "RTN","MAGJUTL5",45,0) ; ST = Server T Version -> defined to always match client part-4 "RTN","MAGJUTL5",46,0) ; CV = Client Version, w/out build # "RTN","MAGJUTL5",47,0) ; CT = Client T Version alone "RTN","MAGJUTL5",48,0) ; CP = Client Patch alone "RTN","MAGJUTL5",49,0) ; ALLOWV = Hard coded string of allowed clients for this KIDS. "RTN","MAGJUTL5",50,0) ; TESTFLAG = 1/0 -- 1=Test vs of server code; 0=Release vs "RTN","MAGJUTL5",51,0) ;Below is placeholder for future enhancement: "RTN","MAGJUTL5",52,0) ;I $P(CLVER,"|",2)="RIV" D Q "RTN","MAGJUTL5",53,0) ;. S MAGJOB("RIV")=1 "RTN","MAGJUTL5",54,0) ;. ; Allowing |RIV clients always "RTN","MAGJUTL5",55,0) ;. S MAGRY="1^1~Allowing Remote Image Connection" "RTN","MAGJUTL5",56,0) ; "RTN","MAGJUTL5",57,0) I $G(DUZ(2)) S PLC=$$PLACE^MAGBAPI(DUZ(2)) "RTN","MAGJUTL5",58,0) ; Quit if we don't have a valid DUZ(2) or valid PLACE: ^MAG(2006.1,PLC) "RTN","MAGJUTL5",59,0) I 'PLC S MAGRY="0^4~Error verifying Imaging Site (Place) -- Contact Imaging support." Q "RTN","MAGJUTL5",60,0) ; "RTN","MAGJUTL5",61,0) D GETVER(.SV,.ST,.ALLOWV) "RTN","MAGJUTL5",62,0) S CLVER=$P(CLVER,"|") "RTN","MAGJUTL5",63,0) S CV=$P(CLVER,".",1,3),CT=+$P(CLVER,".",4),CP=+$P(CLVER,".",3) "RTN","MAGJUTL5",64,0) ; "RTN","MAGJUTL5",65,0) D VERSTAT(.SVSTAT,SV) "RTN","MAGJUTL5",66,0) I 'SVSTAT S MAGRY(0)=SVSTAT Q ; KIDS status for this version indeterminate "RTN","MAGJUTL5",67,0) S TESTFLAG=(+SVSTAT=1) "RTN","MAGJUTL5",68,0) S SVERSION=SV "RTN","MAGJUTL5",69,0) I TESTFLAG S SVERSION=SV_"."_ST "RTN","MAGJUTL5",70,0) ; Check Version differences: "RTN","MAGJUTL5",71,0) I (CV'=SV) D Q "RTN","MAGJUTL5",72,0) . I '(ALLOWV[("|"_CV_"|")) D Q "RTN","MAGJUTL5",73,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",74,0) . ; Warn the Client, allow to continue "RTN","MAGJUTL5",75,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",76,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",77,0) . Q "RTN","MAGJUTL5",78,0) ; Versions are the Same: If T versions are not, warn the Client if needed. "RTN","MAGJUTL5",79,0) ; Released Client (of any version) will have the T version that the server "RTN","MAGJUTL5",80,0) ; expects, and no warning will be displayed. "RTN","MAGJUTL5",81,0) I CT,(CT'=ST) D Q "RTN","MAGJUTL5",82,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",83,0) . . I CT