MAGJUTL3 ;WIRMFO/JHC - VistARad subrtns & RPCs ; 10/17/2022
;;3.0;IMAGING;**16,9,22,18,65,76,101,90,120,133,341**;Dec 21, 2022;Build 28
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
;; ISI IMAGING;**99,101,102**
Q
;RPC Entry points:
; LISTINF--Custom list info
; LOGOFF--update session file
; CACHEQ--init session data
; PINF1--Patient info
; USERINF2--P18 inits for the session
;Subrtn EPs:
; LOG--Upd image access log
; MAGJOBNC--inits for non-client sessions
; USERKEYS--user key info
; USERINF--user info
;
LISTINF(MAGGRY) ; RPC: MAGJ CUSTOM LISTS
; get Exam List data
; Return in ^TMP($J,"MAGJLSTINF",0:N)
; 0)= # Entries below (0:n)
; 1:n)= Button Label^List #^Button Hints^List Type
;
; MAGGRY holds $NA ref to ^TMP for return message
; all refs to MAGGRY use SS indirection
;
; GLB has $NA ref to ^MAG(2006.631), Custom Lists
; refs to GLB use SS indirection to get data from this file
;
S X="ERR1^MAGJUTL3",@^%ZOSF("TRAP")
N D0,GLB,INF,MAGLST,NAM,T
N LSTNUM ; ISI
S MAGLST="MAGJLSTINF"
K MAGGRY S MAGGRY=$NA(^TMP($J,MAGLST)) K @MAGGRY S @MAGGRY@(0)=0
S GLB=$NA(^MAG(2006.631)),NAM=""
F S NAM=$O(@GLB@("B",NAM)) Q:NAM="" S D0="" D
. S D0=$O(@GLB@("B",NAM,D0)) Q:'D0 D
. . ; ISI begin
. . S X=$G(@GLB@(D0,0)) Q:'$P(X,U,6) ; List not Active
. . S LSTNUM=$P(X,U,2)
. . I LSTNUM>9900 Q:'$$MGRREV2^ISIJUTL9("CLIENT") ; ISI System-defined & Rev-2 not enabled; chg 9000 to 9900
. . I I LSTNUM'=9992,(LSTNUM'=9993) Q ; for Rev-2, these 2 lists move to Custom List tab
. . I LSTNUM=9820,'($P($G(^MAG(2006.69,1,"ISI")),U,2)="Y") Q ; Dynamic Query not enabled
. . I "^9800^9801^9802^9803^"[(U_LSTNUM_U) D Q:'LSTNUM ; Use Assign lists?
. . . I '($P($G(^MAG(2006.69,1,"ISI")),U,1)="Y") S LSTNUM=0 Q ; Assign feature not enabled
. . . I $$MGRREV2^ISIJUTL9("CLIENT") I LSTNUM=9800!(LSTNUM=9801) S LSTNUM=0 Q ; Rev-2, these 2 lists move to Main tab
. . . I LSTNUM=9802!(LSTNUM=9803),'$D(MAGJOB("KEYS","ISIJ ASSIGN EXAMS-VIEW ALL")) S LSTNUM=0 Q ; key needed for this list
. . . Q ; ISI end
. . 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
. . Q:T'="" ; req'd fields not all there
. . S T=@MAGGRY@(0)+1,^(0)=T,^(T)=INF ; add entry to reply
Q
;
LOG(ACTION,LOGDATA,PSETLST) ; Log exam access
; ACTION --- Action code string passed in (e.g. VR-VW for vrad view)
; LOGDATA - ^-delimited fields--see code immediately below
; PSETLST -- For Printset exams, has list of Rad Case Numbers included
;
N PTCT,TXT,RADFN,MAGIEN,NIMGS,REMOTE,PRTSET
S RADFN=$P(LOGDATA,U),MAGIEN=$P(LOGDATA,U,2),NIMGS=$P(LOGDATA,U,3),REMOTE=$P(LOGDATA,U,4)
;
; For Printset, append string to TXT
; string= "|VR-PRINTSET~"_CaseNum_~x~y ; x = nth; y = total PrtSet members
;
S PSETLST=$G(PSETLST)
S PRTSET=$L(PSETLST,U)
I PRTSET>1 D
. 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
I ACTION="" S ACTION="UNKNOWN" ; Should never happen
S PTCT=RADFN'=$G(MAGJOB("LASTPT",ACTION))
I PTCT S MAGJOB("LASTPT",ACTION)=RADFN
S TXT=ACTION_U_RADFN_U_MAGIEN_U_U_U_NIMGS
S TXT=TXT_U_PTCT_U_$S(+MAGJOB("USER",1):1,1:0)_U_REMOTE
;
;=== Log to Imaging Windows Sessions file (#2006.82).
; for PRTSET members 2 to N (prevent double-counting):
; set NIMGS = 0
; set PTCT to FALSE
;
I PRTSET>1 N I F I=1:1:PRTSET D
. I I>1 S $P(TXT,U,6)=0,$P(TXT,U,7)=0
. D ACTION^MAGGTAU(TXT_"|"_PRTSET(I),1)
E D ACTION^MAGGTAU(TXT,1)
;
;=== Log to Mag Log
; For Printset, add string to new Param-7 prior to calling ENTRY...
; string= s/a above, but no pipe char.
; for PRTSET members 2 to N set NIMGS = 0 to not double-count
;
I REMOTE S ACTION=ACTION_"/REM"
I PRTSET>1 N I F I=1:1:PRTSET D
. I I>1 S NIMGS=0
. D ENTRY^MAGLOG(ACTION,+DUZ,MAGIEN,"VRAD:"_MAGJOB("VRVERSION"),RADFN,NIMGS,PRTSET(I))
E D ENTRY^MAGLOG(ACTION,+DUZ,MAGIEN,"VRAD:"_MAGJOB("VRVERSION"),RADFN,NIMGS)
Q
;
LOGOFF(MAGGRY,DATA) ; RPC: MAGJ LOGOFF
;
;=== Update Imaging Windows Sessions file: logoff time & session entry closed.
D LOGOFF^MAGGTAU(.MAGGRY)
Q
;
CACHEQ(MAGGRY,DATA) ; RPC: MAGJ CACHELOCATION
; some logon inits & get alternate paths for Remote Reading
; input in DATA:
; - WSLOC = WS Loc'n
; - VRADVER = Client Vs -- p32 ONLY
; - OSVER = Client OS Vs -- p32 ONLY
; Return in ^TMP($J,"MAGJCACHE",0:N) (@MAGGRY)
; 0)= # Entries below (0:n)
; 1:n)= PhysName^Subdirectory^HashFlag^Username^Password^AltPath_IEN
;
; MAGGRY holds $NA reference to ^TMP for return message
; refs to MAGGRY use SS indirection
;
; Also builds local array: p32/p18 compatibility: Some of this is moved to userinf2 below
; MAGJOB("LOC",NetworkLocnIEN)=Site Abbrev
; ("REMOTE")=1/0 (T/F for "User is Remote")
; ("REMOTESCREEN")=0/1 (init User-switchable Remote Screening--P18 use only)
; ("WSLOC")=WS Loc'n String
; ("WSLOCTYP")=WS Loc'n Type
; ("WSNAME")=WS ID
; ("VRVERSION")=VRAD Vs
; ("OSVER")=O/S Vs
; ("ALTPATH")=1/0 ^ 1/0 (T/F Alt Paths are defined
; ^ Alt Paths Enabled/Disabled for most recent exam)
;
S X="ERR1^MAGJUTL3",@^%ZOSF("TRAP")
;
N I,MAGLST,REPLY,TMP,WSLOC,XX,VRADVER,OSVER,DIQUIET,ALTIEN
S DIQUIET=1 D DT^DICRW
S REPLY=0,MAGLST="MAGJCACHE"
K MAGGRY S MAGGRY=$NA(^TMP($J,MAGLST)) K @MAGGRY
S WSLOC=$$UPCASE($P(DATA,U)),VRADVER=$P(DATA,U,2),OSVER=$P(DATA,U,3)
I '$D(MAGJOB("OSVER")) D ; ID p32 initialization
. S MAGJOB("OSVER")=$S(OSVER]"":OSVER,1:"UNK")
. S MAGJOB("VRVERSION")=$S(VRADVER]"":VRADVER,1:"UNK")
. D MAGJOB ; p32 init of VRAD
; get alt paths location info
S MAGJOB("WSLOC")=WSLOC,MAGJOB("REMOTE")=0
S MAGJOB("REMOTESCREEN")=+$P($G(^MAG(2006.69,1,0)),U,10)
I WSLOC]"" D
. S X=$P($G(^MAG(2006.1,+MAGJOB("SITEP"),0)),U,9)
. I X]"",(X'=WSLOC) S MAGJOB("REMOTE")=1
. E Q
. D LIST^MAGBRTLD(WSLOC,.TMP)
. I TMP S REPLY=TMP,MAGJOB("ALTPATH")=$G(MAGJOB("ALTPATH"),"1^1") F I=1:1:TMP D
. . S ALTIEN=$P(TMP(I),U,7)
. . S XX=$P(TMP(I),U,1,5),X=$P(XX,U,3),$P(XX,U,3)=$S(X="Y":1,1: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
. . S @MAGGRY@(I)=XX,MAGJOB("LOC",ALTIEN)=$P(TMP(I),U,6)
I '$D(MAGJOB("ALTPATH")) S MAGJOB("ALTPATH")="0^0"
S @MAGGRY@(0)=REPLY
CACHEQZ Q
;
MAGJOBNC ; EP for Prefetch/Bkgnd calls (NOT a Vrad Client)
N NOTCLIEN S NOTCLIEN=1
D MAGJOB
Q
;
MAGJOB ; Init magjob array
N T,RIST
I $G(MAGJOB("VRVERSION")) S X=MAGJOB("VRVERSION")
E S X="" ; non-client process ; ISI
; ISI remove deprecated logic
D USERKEYS
S MAGJOB("CONSOLIDATED")=($G(^MAG(2006.1,"CONSOLIDATED"))="YES")
S MAGJOB("SITEP")=$$IMGSIT^MAGJUTL1(DUZ(2),1) ; Site Param ien
S RIST="" F X="S","R" I $D(^VA(200,"ARC",X,DUZ)) S RIST=X Q
S RIST=$S(RIST="S":15,RIST="R":12,1:0) ; Staff/Resident/Non rist
S MAGJOB("USER",1)=RIST_U_$$USERINF(+DUZ,".01;1") ; RIST_Type^NAME^INI
S X=$P($G(IO("CLNM")),"."),MAGJOB("WSNAME")=$S(X]"":X,1:"VistaradWS")
K MAGJOB("DIVSCRN") I MAGJOB("CONSOLIDATED") D
. ; include logon DIV, other DIVs to screen Unread Lists & Locking
. I $G(DUZ(2))]"" S MAGJOB("DIVSCRN",DUZ(2))=""
. S DIV=""
. I DUZ(2)'=$P(MAGJOB("SITEP"),U,3) D ; Assoc DIV
. . S IEN=$O(^MAG(2006.1,+MAGJOB("SITEP"),"INSTS","B",DUZ(2),0))
. . I IEN F S DIV=$O(^MAG(2006.1,+MAGJOB("SITEP"),"INSTS",IEN,201,"B",DIV)) Q:'DIV S MAGJOB("DIVSCRN",DIV)=""
. E D ; Parent DIV
. . F S DIV=$O(^MAG(2006.1,+MAGJOB("SITEP"),201,"B",DIV)) Q:'DIV S MAGJOB("DIVSCRN",DIV)=""
S MAGJOB("WSLOCTYP")=$S(+MAGJOB("USER",1):"RAD",1:"Non-Rad") ; USer is Rist/Not
I '$D(MAGJOB("WRKSIEN")) D
. Q:+$G(NOTCLIEN) ; proceed only if Vrad Client is attached
. S X=MAGJOB("WSNAME")
. S $P(X,U,4)=MAGJOB("WSLOCTYP")
. S $P(X,U,8)=1 ; StartupMode=Normal.
. S $P(X,U,9)=MAGJOB("OSVER")
. S $P(X,U,10)=MAGJOB("VRVERSION")
. S $P(X,U,17)=MAGJOB("VRBLDDTTM")
. D UPD^MAGGTAU(.Y,X)
. D REMLOCK^MAGJEX1B ; put here to only run 1x/ login
. D REMLOCK^ISIJRPT2 ; ISI, ditto
Q
;
USERINF(DUZ,FLDS) ; get data from user file
I FLDS=""!'DUZ Q ""
N I,RSL,T S RSL=""
D GETS^DIQ(200,+DUZ,FLDS,"E","T")
S T=+DUZ_","
F I=1:1:$L(FLDS,";") S RSL=RSL_$S(RSL="":"",1:U)_T(200,T,$P(FLDS,";",I),"E")
Q RSL
;
USERKEYS ; Store Security Keys in MagJob
N I,X,Y
N MATCH ; ISI
N MAGKS ; keys to send to XUS KEY CHECK
N MAGKG ; returned
K MAGJOB("KEYS")
S I=0 ; ISI
F MATCH="MAGJ","ISIJ" S X=MATCH D ; ISI
. F S X=$O(^XUSEC(X)) Q:$E(X,1,4)'=MATCH D ; ISI
. . S I=I+1,MAGKS(I)=X
I '$D(MAGKS) Q
D OWNSKEY^XUSRB(.MAGKG,.MAGKS)
S I=0 F S I=$O(MAGKG(I)) Q:'I I MAGKG(I) S MAGJOB("KEYS",MAGKS(I))=""
Q
;
PINF1(MAGGRY,MAGDFN) ;RPC Call MAGJ PT INFO -- Get pt info
N AGE,DFN,DOB,MAGSSN,X
S X="ERR3^MAGJUTL3",@^%ZOSF("TRAP")
S (AGE,MAGSSN)=""
D INFO^MAGGTPT1(.MAGGRY,MAGDFN_"^1^^^1") ; 1=Don't log to session file; 4-digit yr
I +MAGGRY D
. ; calculate Age & SSN/MRN display strings
. S DOB=$P(MAGGRY,U,5)
. I DOB D DT^DILF("",DOB,.X,"") S AGE=$$AGECALC(X)
. S DFN=MAGDFN D PID^VADPT6 S MAGSSN=$S(VAERR:"Unknown",1:VA("PID")) ; IA #10062 (Supported)
. K VA("PID"),VA("BID"),VAERR
S MAGGRY=MAGGRY_"|"_AGE_U_MAGSSN
Q
;
AGECALC(DOB) ; calculate age from DOB til now
; format for age-appropriate display
; Input DOB in Fileman format
; Note: assumes a previously validated date is passed in
N AGE,NDAYS,X,X1,X2
S AGE="unknown"
I DOB?7N1"."0.N S DOB=$E(DOB,1,7) ; strip off time value
I DOB?7N D
. D NOW^%DTC S X1=X K %I
. s X2=DOB D ^%DTC S NDAYS=X
. I NDAYS<0 Q ; * Invalid DOB later than today --> Unknown
. I NDAYS<32 S AGE=NDAYS_"d" Q ; days
. I NDAYS<365 S AGE=$J(NDAYS\30.5,0,0)_"m" Q ; months
. I NDAYS=365 S AGE="1y 0m" Q ; special case
. S AGE=NDAYS\365.25_"y" ; years
. I AGE<16 S AGE=AGE_" "_(($J(NDAYS#365.25,0,0))\30.5)_"m" Q ; years & months
Q AGE
;
;+++++ INITIALIZE SESSION (VERSION CHK, DISPLAY RES CHK, COLLECT USER INFO).
; RPC: MAGJ USER2
;
; MAGGRY Reference to a variable naming the global to store returned data
;
; DATA Information about the client and its workstation.
; ^01: MAMMORES -- Screen resolution of main viewer display:
;
; format is X_"x"_Y_","_ColorType (e.g., 2048x2580,GRAY)
; where X,Y are resolutions & ColorType={GRAY, COLOR}.
;
; ^02: Client Vs ....... Client software version for checking.
; ^03: Client O/S Vs ... Client OS version for logging.
; ^04: ClientBuildDayTime ..... for logging.
;
; Return Values
; =============
;
; ^(0)
; |01
; ^01: 1/0 -- Success/Fail flag for version check.
; ^02:
; ~01: code ... 4=fail.
; ~02: Msg .... Message to display if fail.
; |02
; ^01: DUZ
; ^02: NAME
; ^03: INITIALS
; ^04: REQFLAG .... 1/0 Enable/Disable Requisition for non-rad staff
; ^05: SVERSION ... VistARad Server Version
; ---- Patch MAG*3*101 ----
; ^06: DICTPREF ... 1/0 ENA DICT PREF-YES ALL LOCKED (File 2006.69,13)
; ---- Patch MAG*3*90 ----
; ^07: SSN
; ^08: UserLocalStationNumber
; ^09: LocalPrimaryDivision
; ^10: PrimarySiteStationNumber
; ^11: SiteServiceURL
; ^12: SiteCode
; ^13: ENABLE MANAGER REV-2? -- Conditionally, only if client is v1.1.1 or higher
; ^14: Place-holder for Coerce Dict (abandoned P108)
; ^15: NOTES ENABLE? ; ISI P341
; ^16: HL7 SENDING APPLICATION ; ISI P341
; ^17: ISI Rad Dictation Enable ; ISI P341
; ^18: Implementation Variant ; ISI P341
; ^(1)
; ^01: UserName ... Network UserName
; ^02: PSW ........ Network Password
; ^03: UserType ... 3=Staff R'ist, 2=Resident R'ist, 1=Rad Tech, 0=Non-Rad
; ^04: SYSADMIN ... 1/0 1=user has System User privileges
; ^05: Production account? 1/0 1=yes
;
; ^(2:N) Security Keys
; ^(N+1:M) Mammography display message data
;
USERINF2(MAGGRY,DATA) ; RPC: MAGJ USER2--get user info
S X="ERR2^MAGJUTL3",@^%ZOSF("TRAP")
K MAGGRY S MAGGRY(0)="",MAGGRY(1)=""
I +$G(DUZ)=0 S MAGGRY(0)="0^4~DUZ Undefined, Null or Zero|" Q
N I,J,K,Y,REQFLAG,VRADVER,OSVER,RADTECH,PLACE,REPLY,DICTPREF,MAMMORES,ICNT,MSG
S MAMMORES=$P(DATA,U),VRADVER=$P(DATA,U,2),OSVER=$P(DATA,U,3)
D CHKVER^MAGJUTL5(.REPLY,VRADVER,.PLACE,.SVERSION)
I 'REPLY S MAGGRY(0)=REPLY_"|^^^^",MAGGRY(1)="^^^" G USERIN2Z ; Version check or PLACE failed
S RADTECH=""
S MAGJOB("OSVER")=$S(OSVER]"":OSVER,1:"UNK") ; IDs P18 initialization; cf cacheq ep above
S MAGJOB("VRVERSION")=$S(VRADVER]"":VRADVER,1:"UNK")
S MAGJOB("VRBLDDTTM")=$P(DATA,U,4)
S MAGJOB("VSVERSION")=SVERSION
D MAGJOB
;
;=== Enable/Disable Requisition if not a radiology user
S REQFLAG=1
I 'MAGJOB("USER",1) D ; not a rist
. I $D(^VA(200,"ARC","T",+DUZ)) S RADTECH=1 Q ; Rad Tech OK
. S X=+$P($G(^MAG(2006.69,1,0)),U,16)
. I X S REQFLAG=0 ; Disable Req
S DICTPREF=+$P($G(^MAG(2006.69,1,0)),U,17)
S MAGGRY(0)=REPLY_"|"_DUZ_U_$$GET1^DIQ(200,DUZ_",",.01)_U_$$GET1^DIQ(200,DUZ_",",1)_U_REQFLAG_U_SVERSION_U_DICTPREF
;
;=== Add "^"-pieces 7:12 for ViX (MAG*3*90).
S MAGGRY(0)=MAGGRY(0)_U_$$GET1^DIQ(200,DUZ_",",9) ;...SSN
S MAGGRY(0)=MAGGRY(0)_U_$$GET1^DIQ(4,DUZ(2),99,"E") ;.UserLocalStationNumber
S MAGGRY(0)=MAGGRY(0)_U_$P($$SITE^VASITE(),U) ;.......LocalPrimaryDivision ; ISI correct bug $P-1
S MAGGRY(0)=MAGGRY(0)_U_$P($$SITE^VASITE(),U,3) ;.....PrimarySiteStationNumber
;
;=== Lookup SiteServiceURL.
N SSUNC,VIXPTR
S VIXPTR=$P($G(^MAG(2006.1,+MAGJOB("SITEP"),"NET")),"^",5)
;
;=== Return UNC only if OpStatus is 'online'.
I VIXPTR,+$P($G(^MAG(2005.2,VIXPTR,0)),"^",6) D
. S SSUNC=$P($G(^MAG(2005.2,VIXPTR,0)),"^",2)
S MAGGRY(0)=MAGGRY(0)_U_$G(SSUNC) ;...................SiteServiceURL
S MAGGRY(0)=MAGGRY(0)_U_$P(MAGJOB("SITEP"),U,2) ;.....SiteCode
;
; ISI begin; 101 -- Rev-2 enabled in v1.1.1
; ISI begin P341 --
N IMPLVARIANT,ISIDICTENA,NOTESENA,REV2,SENDAPP,T
S REV2=0,IMPLVARIANT=2 ; "NOT Jordan" implementation status
S X=MAGJOB("VRVERSION") I X?1"1.1.".E,($P(X,".",3)>0) S REV2=$$MGRREV2^ISIJUTL9("CLIENT")
S NOTESENA=+$P($G(^MAG(2006.69,1,"ISI")),U,9) ; Enable Notes?
S ISIDICTENA=+$P($G(^MAG(2006.69,1,"ISI")),U,10) ; Enable ISI Dictation option?
S SENDAPP="RA-ISIRAD-TCP"
I $$UJOCHECK^ISIJUTL9() S SENDAPP="RA-PSCRIBE-TCP" ; HL7 Send Applic for Jordan
I S IMPLVARIANT=1 ; "Jordan" implementation status
S MAGGRY(0)=MAGGRY(0)_U_REV2 ; Enable Revised Manager Tabs?
S MAGGRY(0)=MAGGRY(0)_U_0 ; place-holder for Coerce Dict (abandoned P108)
S MAGGRY(0)=MAGGRY(0)_U_NOTESENA
S MAGGRY(0)=MAGGRY(0)_U_SENDAPP
S MAGGRY(0)=MAGGRY(0)_U_ISIDICTENA
S MAGGRY(0)=MAGGRY(0)_U_IMPLVARIANT
; ISI end
;
;=== Network UserName and PSW
S MAGGRY(1)=$P($G(^MAG(2006.1,PLACE,"NET")),U,1,2)
S X=+MAGJOB("USER",1),X=$S(X=15:3,X=12:2,+RADTECH:1,1:0)
S MAGGRY(1)=MAGGRY(1)_U_X_U_$D(MAGJOB("KEYS","MAGJ SYSTEM USER"))
S MAGGRY(1)=MAGGRY(1)_U_$S($L($T(PROD^XUPROD)):+$$PROD^XUPROD,1:0)
S MAGGRY(2)="*KEYS",X="" F ICNT=3:1 S X=$O(MAGJOB("KEYS",X)) Q:X="" S MAGGRY(ICNT)=X
S MAGGRY(ICNT)="*END"
S ICNT=ICNT+1,MAGGRY(ICNT)="*MAMMO"
S MSG=$$MAMMOCHK(MAMMORES)
I MSG]"" S ICNT=ICNT+1,MAGGRY(ICNT)=MSG
S ICNT=ICNT+1,MAGGRY(ICNT)="*END"
USERIN2Z Q
;
MAMMOCHK(X) ; P133--now ignoring screen resolution, etc.
; note--as of ??/12 there are other sized displaysapproved for mammo
; now returns just a single disclaimer message, regardless of display
; keeping this structure for possible change in the future
N MSG
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."
Q:$Q MSG Q
;
UPCASE(X) ; strip spaces, and cx to uppercase
Q $TR(X,"abcdefghijklmnopqrstuvwxyz ","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
;
ERR1 N ERR S ERR=$$EC^%ZOSV S @MAGGRY@(0)="0^4~"_ERR G ERR
ERR2 N ERR S ERR=$$EC^%ZOSV S MAGGRY(0)="0^4~"_ERR G ERR
ERR3 N ERR S ERR=$$EC^%ZOSV S MAGGRY="0^4~"_ERR
ERR D @^%ZOSF("ERRTN")
Q:$Q 1 Q
;
END Q ;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGJUTL3 17467 printed Oct 16, 2024@18:07:42 Page 2
MAGJUTL3 ;WIRMFO/JHC - VistARad subrtns & RPCs ; 10/17/2022
+1 ;;3.0;IMAGING;**16,9,22,18,65,76,101,90,120,133,341**;Dec 21, 2022;Build 28
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+3 ;; +---------------------------------------------------------------+
+4 ;; | Property of the US Government. |
+5 ;; | No permission to copy or redistribute this software is given. |
+6 ;; | Use of unreleased versions of this software requires the user |
+7 ;; | to execute a written test agreement with the VistA Imaging |
+8 ;; | Development Office of the Department of Veterans Affairs, |
+9 ;; | telephone (301) 734-0100. |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 ;; ISI IMAGING;**99,101,102**
+18 QUIT
+19 ;RPC Entry points:
+20 ; LISTINF--Custom list info
+21 ; LOGOFF--update session file
+22 ; CACHEQ--init session data
+23 ; PINF1--Patient info
+24 ; USERINF2--P18 inits for the session
+25 ;Subrtn EPs:
+26 ; LOG--Upd image access log
+27 ; MAGJOBNC--inits for non-client sessions
+28 ; USERKEYS--user key info
+29 ; USERINF--user info
+30 ;
LISTINF(MAGGRY) ; RPC: MAGJ CUSTOM LISTS
+1 ; get Exam List data
+2 ; Return in ^TMP($J,"MAGJLSTINF",0:N)
+3 ; 0)= # Entries below (0:n)
+4 ; 1:n)= Button Label^List #^Button Hints^List Type
+5 ;
+6 ; MAGGRY holds $NA ref to ^TMP for return message
+7 ; all refs to MAGGRY use SS indirection
+8 ;
+9 ; GLB has $NA ref to ^MAG(2006.631), Custom Lists
+10 ; refs to GLB use SS indirection to get data from this file
+11 ;
+12 SET X="ERR1^MAGJUTL3"
SET @^%ZOSF("TRAP")
+13 NEW D0,GLB,INF,MAGLST,NAM,T
+14 ; ISI
NEW LSTNUM
+15 SET MAGLST="MAGJLSTINF"
+16 KILL MAGGRY
SET MAGGRY=$NAME(^TMP($JOB,MAGLST))
KILL @MAGGRY
SET @MAGGRY@(0)=0
+17 SET GLB=$NAME(^MAG(2006.631))
SET NAM=""
+18 FOR
SET NAM=$ORDER(@GLB@("B",NAM))
if NAM=""
QUIT
SET D0=""
Begin DoDot:1
+19 SET D0=$ORDER(@GLB@("B",NAM,D0))
if 'D0
QUIT
Begin DoDot:2
+20 ; ISI begin
+21 ; List not Active
SET X=$GET(@GLB@(D0,0))
if '$PIECE(X,U,6)
QUIT
+22 SET LSTNUM=$PIECE(X,U,2)
+23 ; ISI System-defined & Rev-2 not enabled; chg 9000 to 9900
IF LSTNUM>9900
if '$$MGRREV2^ISIJUTL9("CLIENT")
QUIT
+24 ; for Rev-2, these 2 lists move to Custom List tab
IF $TEST
IF LSTNUM'=9992
IF (LSTNUM'=9993)
QUIT
+25 ; Dynamic Query not enabled
IF LSTNUM=9820
IF '($PIECE($GET(^MAG(2006.69,1,"ISI")),U,2)="Y")
QUIT
+26 ; Use Assign lists?
IF "^9800^9801^9802^9803^"[(U_LSTNUM_U)
Begin DoDot:3
+27 ; Assign feature not enabled
IF '($PIECE($GET(^MAG(2006.69,1,"ISI")),U,1)="Y")
SET LSTNUM=0
QUIT
+28 ; Rev-2, these 2 lists move to Main tab
IF $$MGRREV2^ISIJUTL9("CLIENT")
IF LSTNUM=9800!(LSTNUM=9801)
SET LSTNUM=0
QUIT
+29 ; key needed for this list
IF LSTNUM=9802!(LSTNUM=9803)
IF '$DATA(MAGJOB("KEYS","ISIJ ASSIGN EXAMS-VIEW ALL"))
SET LSTNUM=0
QUIT
+30 ; ISI end
QUIT
End DoDot:3
if 'LSTNUM
QUIT
+31 SET INF=""
FOR I=1:1
SET T=$PIECE("7^2^1^3",U,I)
if T=""
QUIT
SET Y=$PIECE(X,U,T)
if Y=""
QUIT
SET $PIECE(INF,U,I)=Y
+32 ; req'd fields not all there
if T'=""
QUIT
+33 ; add entry to reply
SET T=@MAGGRY@(0)+1
SET ^(0)=T
SET ^(T)=INF
End DoDot:2
End DoDot:1
+34 QUIT
+35 ;
LOG(ACTION,LOGDATA,PSETLST) ; Log exam access
+1 ; ACTION --- Action code string passed in (e.g. VR-VW for vrad view)
+2 ; LOGDATA - ^-delimited fields--see code immediately below
+3 ; PSETLST -- For Printset exams, has list of Rad Case Numbers included
+4 ;
+5 NEW PTCT,TXT,RADFN,MAGIEN,NIMGS,REMOTE,PRTSET
+6 SET RADFN=$PIECE(LOGDATA,U)
SET MAGIEN=$PIECE(LOGDATA,U,2)
SET NIMGS=$PIECE(LOGDATA,U,3)
SET REMOTE=$PIECE(LOGDATA,U,4)
+7 ;
+8 ; For Printset, append string to TXT
+9 ; string= "|VR-PRINTSET~"_CaseNum_~x~y ; x = nth; y = total PrtSet members
+10 ;
+11 SET PSETLST=$GET(PSETLST)
+12 SET PRTSET=$LENGTH(PSETLST,U)
+13 IF PRTSET>1
Begin DoDot:1
+14 NEW I,T
FOR I=1:1:PRTSET
SET T=$PIECE(PSETLST,U,I)
SET T=$PIECE(T,"-",$LENGTH(T,"-"))
SET PRTSET(I)="VR-PRINTSET~"_T_"~"_I_"~"_PRTSET
End DoDot:1
+15 ; Should never happen
IF ACTION=""
SET ACTION="UNKNOWN"
+16 SET PTCT=RADFN'=$GET(MAGJOB("LASTPT",ACTION))
+17 IF PTCT
SET MAGJOB("LASTPT",ACTION)=RADFN
+18 SET TXT=ACTION_U_RADFN_U_MAGIEN_U_U_U_NIMGS
+19 SET TXT=TXT_U_PTCT_U_$SELECT(+MAGJOB("USER",1):1,1:0)_U_REMOTE
+20 ;
+21 ;=== Log to Imaging Windows Sessions file (#2006.82).
+22 ; for PRTSET members 2 to N (prevent double-counting):
+23 ; set NIMGS = 0
+24 ; set PTCT to FALSE
+25 ;
+26 IF PRTSET>1
NEW I
FOR I=1:1:PRTSET
Begin DoDot:1
+27 IF I>1
SET $PIECE(TXT,U,6)=0
SET $PIECE(TXT,U,7)=0
+28 DO ACTION^MAGGTAU(TXT_"|"_PRTSET(I),1)
End DoDot:1
+29 IF '$TEST
DO ACTION^MAGGTAU(TXT,1)
+30 ;
+31 ;=== Log to Mag Log
+32 ; For Printset, add string to new Param-7 prior to calling ENTRY...
+33 ; string= s/a above, but no pipe char.
+34 ; for PRTSET members 2 to N set NIMGS = 0 to not double-count
+35 ;
+36 IF REMOTE
SET ACTION=ACTION_"/REM"
+37 IF PRTSET>1
NEW I
FOR I=1:1:PRTSET
Begin DoDot:1
+38 IF I>1
SET NIMGS=0
+39 DO ENTRY^MAGLOG(ACTION,+DUZ,MAGIEN,"VRAD:"_MAGJOB("VRVERSION"),RADFN,NIMGS,PRTSET(I))
End DoDot:1
+40 IF '$TEST
DO ENTRY^MAGLOG(ACTION,+DUZ,MAGIEN,"VRAD:"_MAGJOB("VRVERSION"),RADFN,NIMGS)
+41 QUIT
+42 ;
LOGOFF(MAGGRY,DATA) ; RPC: MAGJ LOGOFF
+1 ;
+2 ;=== Update Imaging Windows Sessions file: logoff time & session entry closed.
+3 DO LOGOFF^MAGGTAU(.MAGGRY)
+4 QUIT
+5 ;
CACHEQ(MAGGRY,DATA) ; RPC: MAGJ CACHELOCATION
+1 ; some logon inits & get alternate paths for Remote Reading
+2 ; input in DATA:
+3 ; - WSLOC = WS Loc'n
+4 ; - VRADVER = Client Vs -- p32 ONLY
+5 ; - OSVER = Client OS Vs -- p32 ONLY
+6 ; Return in ^TMP($J,"MAGJCACHE",0:N) (@MAGGRY)
+7 ; 0)= # Entries below (0:n)
+8 ; 1:n)= PhysName^Subdirectory^HashFlag^Username^Password^AltPath_IEN
+9 ;
+10 ; MAGGRY holds $NA reference to ^TMP for return message
+11 ; refs to MAGGRY use SS indirection
+12 ;
+13 ; Also builds local array: p32/p18 compatibility: Some of this is moved to userinf2 below
+14 ; MAGJOB("LOC",NetworkLocnIEN)=Site Abbrev
+15 ; ("REMOTE")=1/0 (T/F for "User is Remote")
+16 ; ("REMOTESCREEN")=0/1 (init User-switchable Remote Screening--P18 use only)
+17 ; ("WSLOC")=WS Loc'n String
+18 ; ("WSLOCTYP")=WS Loc'n Type
+19 ; ("WSNAME")=WS ID
+20 ; ("VRVERSION")=VRAD Vs
+21 ; ("OSVER")=O/S Vs
+22 ; ("ALTPATH")=1/0 ^ 1/0 (T/F Alt Paths are defined
+23 ; ^ Alt Paths Enabled/Disabled for most recent exam)
+24 ;
+25 SET X="ERR1^MAGJUTL3"
SET @^%ZOSF("TRAP")
+26 ;
+27 NEW I,MAGLST,REPLY,TMP,WSLOC,XX,VRADVER,OSVER,DIQUIET,ALTIEN
+28 SET DIQUIET=1
DO DT^DICRW
+29 SET REPLY=0
SET MAGLST="MAGJCACHE"
+30 KILL MAGGRY
SET MAGGRY=$NAME(^TMP($JOB,MAGLST))
KILL @MAGGRY
+31 SET WSLOC=$$UPCASE($PIECE(DATA,U))
SET VRADVER=$PIECE(DATA,U,2)
SET OSVER=$PIECE(DATA,U,3)
+32 ; ID p32 initialization
IF '$DATA(MAGJOB("OSVER"))
Begin DoDot:1
+33 SET MAGJOB("OSVER")=$SELECT(OSVER]"":OSVER,1:"UNK")
+34 SET MAGJOB("VRVERSION")=$SELECT(VRADVER]"":VRADVER,1:"UNK")
+35 ; p32 init of VRAD
DO MAGJOB
End DoDot:1
+36 ; get alt paths location info
+37 SET MAGJOB("WSLOC")=WSLOC
SET MAGJOB("REMOTE")=0
+38 SET MAGJOB("REMOTESCREEN")=+$PIECE($GET(^MAG(2006.69,1,0)),U,10)
+39 IF WSLOC]""
Begin DoDot:1
+40 SET X=$PIECE($GET(^MAG(2006.1,+MAGJOB("SITEP"),0)),U,9)
+41 IF X]""
IF (X'=WSLOC)
SET MAGJOB("REMOTE")=1
+42 IF '$TEST
QUIT
+43 DO LIST^MAGBRTLD(WSLOC,.TMP)
+44 IF TMP
SET REPLY=TMP
SET MAGJOB("ALTPATH")=$GET(MAGJOB("ALTPATH"),"1^1")
FOR I=1:1:TMP
Begin DoDot:2
+45 SET ALTIEN=$PIECE(TMP(I),U,7)
+46 SET XX=$PIECE(TMP(I),U,1,5)
SET X=$PIECE(XX,U,3)
SET $PIECE(XX,U,3)=$SELECT(X="Y":1,1:0)
+47 SET X=$PIECE(XX,U,4)
SET $PIECE(XX,U,4)=$PIECE(XX,U,5)
SET $PIECE(XX,U,5)=X
SET $PIECE(XX,U,6)=ALTIEN
+48 SET @MAGGRY@(I)=XX
SET MAGJOB("LOC",ALTIEN)=$PIECE(TMP(I),U,6)
End DoDot:2
End DoDot:1
+49 IF '$DATA(MAGJOB("ALTPATH"))
SET MAGJOB("ALTPATH")="0^0"
+50 SET @MAGGRY@(0)=REPLY
CACHEQZ QUIT
+1 ;
MAGJOBNC ; EP for Prefetch/Bkgnd calls (NOT a Vrad Client)
+1 NEW NOTCLIEN
SET NOTCLIEN=1
+2 DO MAGJOB
+3 QUIT
+4 ;
MAGJOB ; Init magjob array
+1 NEW T,RIST
+2 IF $GET(MAGJOB("VRVERSION"))
SET X=MAGJOB("VRVERSION")
+3 ; non-client process ; ISI
IF '$TEST
SET X=""
+4 ; ISI remove deprecated logic
+5 DO USERKEYS
+6 SET MAGJOB("CONSOLIDATED")=($GET(^MAG(2006.1,"CONSOLIDATED"))="YES")
+7 ; Site Param ien
SET MAGJOB("SITEP")=$$IMGSIT^MAGJUTL1(DUZ(2),1)
+8 SET RIST=""
FOR X="S","R"
IF $DATA(^VA(200,"ARC",X,DUZ))
SET RIST=X
QUIT
+9 ; Staff/Resident/Non rist
SET RIST=$SELECT(RIST="S":15,RIST="R":12,1:0)
+10 ; RIST_Type^NAME^INI
SET MAGJOB("USER",1)=RIST_U_$$USERINF(+DUZ,".01;1")
+11 SET X=$PIECE($GET(IO("CLNM")),".")
SET MAGJOB("WSNAME")=$SELECT(X]"":X,1:"VistaradWS")
+12 KILL MAGJOB("DIVSCRN")
IF MAGJOB("CONSOLIDATED")
Begin DoDot:1
+13 ; include logon DIV, other DIVs to screen Unread Lists & Locking
+14 IF $GET(DUZ(2))]""
SET MAGJOB("DIVSCRN",DUZ(2))=""
+15 SET DIV=""
+16 ; Assoc DIV
IF DUZ(2)'=$PIECE(MAGJOB("SITEP"),U,3)
Begin DoDot:2
+17 SET IEN=$ORDER(^MAG(2006.1,+MAGJOB("SITEP"),"INSTS","B",DUZ(2),0))
+18 IF IEN
FOR
SET DIV=$ORDER(^MAG(2006.1,+MAGJOB("SITEP"),"INSTS",IEN,201,"B",DIV))
if 'DIV
QUIT
SET MAGJOB("DIVSCRN",DIV)=""
End DoDot:2
+19 ; Parent DIV
IF '$TEST
Begin DoDot:2
+20 FOR
SET DIV=$ORDER(^MAG(2006.1,+MAGJOB("SITEP"),201,"B",DIV))
if 'DIV
QUIT
SET MAGJOB("DIVSCRN",DIV)=""
End DoDot:2
End DoDot:1
+21 ; USer is Rist/Not
SET MAGJOB("WSLOCTYP")=$SELECT(+MAGJOB("USER",1):"RAD",1:"Non-Rad")
+22 IF '$DATA(MAGJOB("WRKSIEN"))
Begin DoDot:1
+23 ; proceed only if Vrad Client is attached
if +$GET(NOTCLIEN)
QUIT
+24 SET X=MAGJOB("WSNAME")
+25 SET $PIECE(X,U,4)=MAGJOB("WSLOCTYP")
+26 ; StartupMode=Normal.
SET $PIECE(X,U,8)=1
+27 SET $PIECE(X,U,9)=MAGJOB("OSVER")
+28 SET $PIECE(X,U,10)=MAGJOB("VRVERSION")
+29 SET $PIECE(X,U,17)=MAGJOB("VRBLDDTTM")
+30 DO UPD^MAGGTAU(.Y,X)
+31 ; put here to only run 1x/ login
DO REMLOCK^MAGJEX1B
+32 ; ISI, ditto
DO REMLOCK^ISIJRPT2
End DoDot:1
+33 QUIT
+34 ;
USERINF(DUZ,FLDS) ; get data from user file
+1 IF FLDS=""!'DUZ
QUIT ""
+2 NEW I,RSL,T
SET RSL=""
+3 DO GETS^DIQ(200,+DUZ,FLDS,"E","T")
+4 SET T=+DUZ_","
+5 FOR I=1:1:$LENGTH(FLDS,";")
SET RSL=RSL_$SELECT(RSL="":"",1:U)_T(200,T,$PIECE(FLDS,";",I),"E")
+6 QUIT RSL
+7 ;
USERKEYS ; Store Security Keys in MagJob
+1 NEW I,X,Y
+2 ; ISI
NEW MATCH
+3 ; keys to send to XUS KEY CHECK
NEW MAGKS
+4 ; returned
NEW MAGKG
+5 KILL MAGJOB("KEYS")
+6 ; ISI
SET I=0
+7 ; ISI
FOR MATCH="MAGJ","ISIJ"
SET X=MATCH
Begin DoDot:1
+8 ; ISI
FOR
SET X=$ORDER(^XUSEC(X))
if $EXTRACT(X,1,4)'=MATCH
QUIT
Begin DoDot:2
+9 SET I=I+1
SET MAGKS(I)=X
End DoDot:2
End DoDot:1
+10 IF '$DATA(MAGKS)
QUIT
+11 DO OWNSKEY^XUSRB(.MAGKG,.MAGKS)
+12 SET I=0
FOR
SET I=$ORDER(MAGKG(I))
if 'I
QUIT
IF MAGKG(I)
SET MAGJOB("KEYS",MAGKS(I))=""
+13 QUIT
+14 ;
PINF1(MAGGRY,MAGDFN) ;RPC Call MAGJ PT INFO -- Get pt info
+1 NEW AGE,DFN,DOB,MAGSSN,X
+2 SET X="ERR3^MAGJUTL3"
SET @^%ZOSF("TRAP")
+3 SET (AGE,MAGSSN)=""
+4 ; 1=Don't log to session file; 4-digit yr
DO INFO^MAGGTPT1(.MAGGRY,MAGDFN_"^1^^^1")
+5 IF +MAGGRY
Begin DoDot:1
+6 ; calculate Age & SSN/MRN display strings
+7 SET DOB=$PIECE(MAGGRY,U,5)
+8 IF DOB
DO DT^DILF("",DOB,.X,"")
SET AGE=$$AGECALC(X)
+9 ; IA #10062 (Supported)
SET DFN=MAGDFN
DO PID^VADPT6
SET MAGSSN=$SELECT(VAERR:"Unknown",1:VA("PID"))
+10 KILL VA("PID"),VA("BID"),VAERR
End DoDot:1
+11 SET MAGGRY=MAGGRY_"|"_AGE_U_MAGSSN
+12 QUIT
+13 ;
AGECALC(DOB) ; calculate age from DOB til now
+1 ; format for age-appropriate display
+2 ; Input DOB in Fileman format
+3 ; Note: assumes a previously validated date is passed in
+4 NEW AGE,NDAYS,X,X1,X2
+5 SET AGE="unknown"
+6 ; strip off time value
IF DOB?7N1"."0.N
SET DOB=$EXTRACT(DOB,1,7)
+7 IF DOB?7N
Begin DoDot:1
+8 DO NOW^%DTC
SET X1=X
KILL %I
+9 SET X2=DOB
DO ^%DTC
SET NDAYS=X
+10 ; * Invalid DOB later than today --> Unknown
IF NDAYS<0
QUIT
+11 ; days
IF NDAYS<32
SET AGE=NDAYS_"d"
QUIT
+12 ; months
IF NDAYS<365
SET AGE=$JUSTIFY(NDAYS\30.5,0,0)_"m"
QUIT
+13 ; special case
IF NDAYS=365
SET AGE="1y 0m"
QUIT
+14 ; years
SET AGE=NDAYS\365.25_"y"
+15 ; years & months
IF AGE<16
SET AGE=AGE_" "_(($JUSTIFY(NDAYS#365.25,0,0))\30.5)_"m"
QUIT
End DoDot:1
+16 QUIT AGE
+17 ;
+18 ;+++++ INITIALIZE SESSION (VERSION CHK, DISPLAY RES CHK, COLLECT USER INFO).
+19 ; RPC: MAGJ USER2
+20 ;
+21 ; MAGGRY Reference to a variable naming the global to store returned data
+22 ;
+23 ; DATA Information about the client and its workstation.
+24 ; ^01: MAMMORES -- Screen resolution of main viewer display:
+25 ;
+26 ; format is X_"x"_Y_","_ColorType (e.g., 2048x2580,GRAY)
+27 ; where X,Y are resolutions & ColorType={GRAY, COLOR}.
+28 ;
+29 ; ^02: Client Vs ....... Client software version for checking.
+30 ; ^03: Client O/S Vs ... Client OS version for logging.
+31 ; ^04: ClientBuildDayTime ..... for logging.
+32 ;
+33 ; Return Values
+34 ; =============
+35 ;
+36 ; ^(0)
+37 ; |01
+38 ; ^01: 1/0 -- Success/Fail flag for version check.
+39 ; ^02:
+40 ; ~01: code ... 4=fail.
+41 ; ~02: Msg .... Message to display if fail.
+42 ; |02
+43 ; ^01: DUZ
+44 ; ^02: NAME
+45 ; ^03: INITIALS
+46 ; ^04: REQFLAG .... 1/0 Enable/Disable Requisition for non-rad staff
+47 ; ^05: SVERSION ... VistARad Server Version
+48 ; ---- Patch MAG*3*101 ----
+49 ; ^06: DICTPREF ... 1/0 ENA DICT PREF-YES ALL LOCKED (File 2006.69,13)
+50 ; ---- Patch MAG*3*90 ----
+51 ; ^07: SSN
+52 ; ^08: UserLocalStationNumber
+53 ; ^09: LocalPrimaryDivision
+54 ; ^10: PrimarySiteStationNumber
+55 ; ^11: SiteServiceURL
+56 ; ^12: SiteCode
+57 ; ^13: ENABLE MANAGER REV-2? -- Conditionally, only if client is v1.1.1 or higher
+58 ; ^14: Place-holder for Coerce Dict (abandoned P108)
+59 ; ^15: NOTES ENABLE? ; ISI P341
+60 ; ^16: HL7 SENDING APPLICATION ; ISI P341
+61 ; ^17: ISI Rad Dictation Enable ; ISI P341
+62 ; ^18: Implementation Variant ; ISI P341
+63 ; ^(1)
+64 ; ^01: UserName ... Network UserName
+65 ; ^02: PSW ........ Network Password
+66 ; ^03: UserType ... 3=Staff R'ist, 2=Resident R'ist, 1=Rad Tech, 0=Non-Rad
+67 ; ^04: SYSADMIN ... 1/0 1=user has System User privileges
+68 ; ^05: Production account? 1/0 1=yes
+69 ;
+70 ; ^(2:N) Security Keys
+71 ; ^(N+1:M) Mammography display message data
+72 ;
USERINF2(MAGGRY,DATA) ; RPC: MAGJ USER2--get user info
+1 SET X="ERR2^MAGJUTL3"
SET @^%ZOSF("TRAP")
+2 KILL MAGGRY
SET MAGGRY(0)=""
SET MAGGRY(1)=""
+3 IF +$GET(DUZ)=0
SET MAGGRY(0)="0^4~DUZ Undefined, Null or Zero|"
QUIT
+4 NEW I,J,K,Y,REQFLAG,VRADVER,OSVER,RADTECH,PLACE,REPLY,DICTPREF,MAMMORES,ICNT,MSG
+5 SET MAMMORES=$PIECE(DATA,U)
SET VRADVER=$PIECE(DATA,U,2)
SET OSVER=$PIECE(DATA,U,3)
+6 DO CHKVER^MAGJUTL5(.REPLY,VRADVER,.PLACE,.SVERSION)
+7 ; Version check or PLACE failed
IF 'REPLY
SET MAGGRY(0)=REPLY_"|^^^^"
SET MAGGRY(1)="^^^"
GOTO USERIN2Z
+8 SET RADTECH=""
+9 ; IDs P18 initialization; cf cacheq ep above
SET MAGJOB("OSVER")=$SELECT(OSVER]"":OSVER,1:"UNK")
+10 SET MAGJOB("VRVERSION")=$SELECT(VRADVER]"":VRADVER,1:"UNK")
+11 SET MAGJOB("VRBLDDTTM")=$PIECE(DATA,U,4)
+12 SET MAGJOB("VSVERSION")=SVERSION
+13 DO MAGJOB
+14 ;
+15 ;=== Enable/Disable Requisition if not a radiology user
+16 SET REQFLAG=1
+17 ; not a rist
IF 'MAGJOB("USER",1)
Begin DoDot:1
+18 ; Rad Tech OK
IF $DATA(^VA(200,"ARC","T",+DUZ))
SET RADTECH=1
QUIT
+19 SET X=+$PIECE($GET(^MAG(2006.69,1,0)),U,16)
+20 ; Disable Req
IF X
SET REQFLAG=0
End DoDot:1
+21 SET DICTPREF=+$PIECE($GET(^MAG(2006.69,1,0)),U,17)
+22 SET MAGGRY(0)=REPLY_"|"_DUZ_U_$$GET1^DIQ(200,DUZ_",",.01)_U_$$GET1^DIQ(200,DUZ_",",1)_U_REQFLAG_U_SVERSION_U_DICTPREF
+23 ;
+24 ;=== Add "^"-pieces 7:12 for ViX (MAG*3*90).
+25 ;...SSN
SET MAGGRY(0)=MAGGRY(0)_U_$$GET1^DIQ(200,DUZ_",",9)
+26 ;.UserLocalStationNumber
SET MAGGRY(0)=MAGGRY(0)_U_$$GET1^DIQ(4,DUZ(2),99,"E")
+27 ;.......LocalPrimaryDivision ; ISI correct bug $P-1
SET MAGGRY(0)=MAGGRY(0)_U_$PIECE($$SITE^VASITE(),U)
+28 ;.....PrimarySiteStationNumber
SET MAGGRY(0)=MAGGRY(0)_U_$PIECE($$SITE^VASITE(),U,3)
+29 ;
+30 ;=== Lookup SiteServiceURL.
+31 NEW SSUNC,VIXPTR
+32 SET VIXPTR=$PIECE($GET(^MAG(2006.1,+MAGJOB("SITEP"),"NET")),"^",5)
+33 ;
+34 ;=== Return UNC only if OpStatus is 'online'.
+35 IF VIXPTR
IF +$PIECE($GET(^MAG(2005.2,VIXPTR,0)),"^",6)
Begin DoDot:1
+36 SET SSUNC=$PIECE($GET(^MAG(2005.2,VIXPTR,0)),"^",2)
End DoDot:1
+37 ;...................SiteServiceURL
SET MAGGRY(0)=MAGGRY(0)_U_$GET(SSUNC)
+38 ;.....SiteCode
SET MAGGRY(0)=MAGGRY(0)_U_$PIECE(MAGJOB("SITEP"),U,2)
+39 ;
+40 ; ISI begin; 101 -- Rev-2 enabled in v1.1.1
+41 ; ISI begin P341 --
+42 NEW IMPLVARIANT,ISIDICTENA,NOTESENA,REV2,SENDAPP,T
+43 ; "NOT Jordan" implementation status
SET REV2=0
SET IMPLVARIANT=2
+44 SET X=MAGJOB("VRVERSION")
IF X?1"1.1.".E
IF ($PIECE(X,".",3)>0)
SET REV2=$$MGRREV2^ISIJUTL9("CLIENT")
+45 ; Enable Notes?
SET NOTESENA=+$PIECE($GET(^MAG(2006.69,1,"ISI")),U,9)
+46 ; Enable ISI Dictation option?
SET ISIDICTENA=+$PIECE($GET(^MAG(2006.69,1,"ISI")),U,10)
+47 SET SENDAPP="RA-ISIRAD-TCP"
+48 ; HL7 Send Applic for Jordan
IF $$UJOCHECK^ISIJUTL9()
SET SENDAPP="RA-PSCRIBE-TCP"
+49 ; "Jordan" implementation status
IF $TEST
SET IMPLVARIANT=1
+50 ; Enable Revised Manager Tabs?
SET MAGGRY(0)=MAGGRY(0)_U_REV2
+51 ; place-holder for Coerce Dict (abandoned P108)
SET MAGGRY(0)=MAGGRY(0)_U_0
+52 SET MAGGRY(0)=MAGGRY(0)_U_NOTESENA
+53 SET MAGGRY(0)=MAGGRY(0)_U_SENDAPP
+54 SET MAGGRY(0)=MAGGRY(0)_U_ISIDICTENA
+55 SET MAGGRY(0)=MAGGRY(0)_U_IMPLVARIANT
+56 ; ISI end
+57 ;
+58 ;=== Network UserName and PSW
+59 SET MAGGRY(1)=$PIECE($GET(^MAG(2006.1,PLACE,"NET")),U,1,2)
+60 SET X=+MAGJOB("USER",1)
SET X=$SELECT(X=15:3,X=12:2,+RADTECH:1,1:0)
+61 SET MAGGRY(1)=MAGGRY(1)_U_X_U_$DATA(MAGJOB("KEYS","MAGJ SYSTEM USER"))
+62 SET MAGGRY(1)=MAGGRY(1)_U_$SELECT($LENGTH($TEXT(PROD^XUPROD)):+$$PROD^XUPROD,1:0)
+63 SET MAGGRY(2)="*KEYS"
SET X=""
FOR ICNT=3:1
SET X=$ORDER(MAGJOB("KEYS",X))
if X=""
QUIT
SET MAGGRY(ICNT)=X
+64 SET MAGGRY(ICNT)="*END"
+65 SET ICNT=ICNT+1
SET MAGGRY(ICNT)="*MAMMO"
+66 SET MSG=$$MAMMOCHK(MAMMORES)
+67 IF MSG]""
SET ICNT=ICNT+1
SET MAGGRY(ICNT)=MSG
+68 SET ICNT=ICNT+1
SET MAGGRY(ICNT)="*END"
USERIN2Z QUIT
+1 ;
MAMMOCHK(X) ; P133--now ignoring screen resolution, etc.
+1 ; note--as of ??/12 there are other sized displaysapproved for mammo
+2 ; now returns just a single disclaimer message, regardless of display
+3 ; keeping this structure for possible change in the future
+4 NEW MSG
+5 SET 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."
+6 if $QUIT
QUIT MSG
QUIT
+7 ;
UPCASE(X) ; strip spaces, and cx to uppercase
+1 QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz ","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+2 ;
ERR1 NEW ERR
SET ERR=$$EC^%ZOSV
SET @MAGGRY@(0)="0^4~"_ERR
GOTO ERR
ERR2 NEW ERR
SET ERR=$$EC^%ZOSV
SET MAGGRY(0)="0^4~"_ERR
GOTO ERR
ERR3 NEW ERR
SET ERR=$$EC^%ZOSV
SET MAGGRY="0^4~"_ERR
ERR DO @^%ZOSF("ERRTN")
+1 if $QUIT
QUIT 1
QUIT
+2 ;
END ;
QUIT
