- 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 Jan 18, 2025@03:08:13 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