ISIJUTL9 ; ISI/JHC - ISI Rad subroutines ; 10/17/2022
;;1.1;ESL ISI IMAGING;**100,101,110**;Dec 21, 2022;Build 41
;; This routine is the property of ViTel Net, and should not be modified.
;; This software is a medical device and is subject to FDA regulation.
;; Modifications to this software may only be made under the terms of
;; 21CFR820 regulation. 21CFR Subpart A 820.1: "The failure to comply
;; with any applicable provision in this part renders a device
;; adulterated under section 501(h) of the act. Such a device,
;; as well as any person responsible for the failure to comply,
;; is subject to regulatory action."
; Reference to File #2006.631 in ICR #7409
; Reference to File #2006.69 in ICR #7410
Q
;
ERR ;
S @MAGRY@(0)="0^4~ERROR "_$$EC^%ZOSV
D @^%ZOSF("ERRTN")
Q:$Q 1 Q
;
;
MGRREV2(CLIENT) ; Return 1/0 for Manager Revision-2 is enabled
; Input CLIENT optional:
; "CLIENT" indicates Client-side Tab changes only concern
; Else, concern is Server-side processes disabled/enabled
N X S X=$P($G(^MAG(2006.69,1,"ISI")),U,5)
I +X D
. S CLIENT=$G(CLIENT)="CLIENT"
. I CLIENT S X=1 ; Level-1 or Level-2 true/enable
. E S X=$S(X=2:1,1:0) ; Server-side processes enable for Level-2 only
Q:$Q X Q
;
UJOCHECK(OUT) ;
; Check to see if UJO National Patient ID (#2,400000000) exists.
; Used to verify this is an EHS/EHSI system
N $ETRAP,$ESTACK S $ETRAP="D ERR^ISIJUTL9"
K OUT
S OUT=$$VFIELD^DILFD(2,400000000)
Q:$Q OUT Q
;
LSTSTATU(LSTID,HDATE) ; Exam list statistics update
; LSTID = ien of Exam list requested by user
; HDATE = $H of date to be filed; default is today
N CT,DAT,IEN,IENDAT,IENSIT,FIL,X
S HDATE=$G(HDATE,$H) ; programmer's test routine is the only use of passed in value
S FIL=$NA(^ISI(23452)) ; statistics file
I '$D(@FIL) Q
I '$D(^MAG(2006.631,LSTID)) Q ; should never happen
;
S DAT=$$WEEKOF(HDATE) ; stats are aggregated weekly
;
L +@FIL@(0):1
E Q ; should not happen, but don't bother if lock fails
S IEN=$O(@FIL@("B",LSTID,""))
I 'IEN D ; create new list entry
. S X=@FIL@(0),IEN=$P(X,U,3)+1,CT=$P(X,U,4)+1,$P(X,U,3)=IEN,$P(X,U,4)=CT,^(0)=X
. S @FIL@(IEN,0)=LSTID,@FIL@("B",LSTID,IEN)=""
L -@FIL@(0)
;
L +@FIL@(IEN):1
E Q ; ditto
S IENDAT=$O(@FIL@(IEN,1,"B",DAT,""))
I 'IENDAT D ; create new DATE for this list
. S X=$G(@FIL@(IEN,1,0)),IENDAT=$P(X,U,3)+1,CT=$P(X,U,4)+1,$P(X,U,3)=IENDAT,$P(X,U,4)=CT,^(0)=X
. S @FIL@(IEN,1,IENDAT,0)=DAT,@FIL@(IEN,1,"B",DAT,IENDAT)=""
L -@FIL@(IEN)
;
L +@FIL@(IEN,DUZ(2)):1
E Q ; ditto
S IENSIT=$O(@FIL@(IEN,1,IENDAT,1,"B",DUZ(2),""))
I 'IENSIT D ; create new SITE for this list/date
. S X=$G(@FIL@(IEN,1,IENDAT,1,0)),IENSIT=$P(X,U,3)+1,CT=$P(X,U,4)+1,$P(X,U,3)=IENSIT,$P(X,U,4)=CT,^(0)=X
. S @FIL@(IEN,1,IENDAT,1,IENSIT,0)=DUZ(2)_U_0,@FIL@(IEN,1,IENDAT,1,"B",DUZ(2),IENSIT)=""
S X=$G(@FIL@(IEN,1,IENDAT,1,IENSIT,0)),CT=$P(X,U,2)+1,$P(X,U,2)=CT,^(0)=X
;
L -@FIL@(IEN,DUZ(2))
Q
;
WEEKOF(H) ; Calculate a "week-of" date for input $H value
S %H=H D YMD^%DTC ; returns fman date in X
I H#7 D
. S X1=X,X2=-(H#7) D C^%DTC ; returns fman date in X
Q:$Q X Q
;
LSTSTATD ; Exam list statistics dump
;
S DIC=23452,L=0
S DHD=""
S FLDS="[LIST STATS",BY="[LIST STATS"
S DIOEND="D LISTDEFS^ISIJUTL9"
D EN1^DIP
Q
;
LISTDEFS ; dump out exam list definitions
;
W !!,"LIST DEFINITIONS:",!
N FIL,IEN,I,LSTNUM,X
S FIL=$NA(^MAG(2006.631))
S LSTNUM=""
F S LSTNUM=$O(@FIL@("C",LSTNUM)) Q:LSTNUM>9799 S IEN=$O(^(LSTNUM,"")) D
. W !,$J(LSTNUM,4)," "
. I 'IEN W " * * * No report defined for List # * * *",! Q
. S X=@FIL@(IEN,0)
. F I=3,6,7,1 W " ",U," ",$P(X,U,I)
. I $D(@FIL@(IEN,"DEF",5,1)) F I=1:1 S X=$G(^(I)) Q:X="" W !,?6,X
. W !
W !!,"<END>",!
Q
;
END Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HISIJUTL9 3853 printed Sep 23, 2025@20:20:38 Page 2
ISIJUTL9 ; ISI/JHC - ISI Rad subroutines ; 10/17/2022
+1 ;;1.1;ESL ISI IMAGING;**100,101,110**;Dec 21, 2022;Build 41
+2 ;; This routine is the property of ViTel Net, and should not be modified.
+3 ;; This software is a medical device and is subject to FDA regulation.
+4 ;; Modifications to this software may only be made under the terms of
+5 ;; 21CFR820 regulation. 21CFR Subpart A 820.1: "The failure to comply
+6 ;; with any applicable provision in this part renders a device
+7 ;; adulterated under section 501(h) of the act. Such a device,
+8 ;; as well as any person responsible for the failure to comply,
+9 ;; is subject to regulatory action."
+10 ; Reference to File #2006.631 in ICR #7409
+11 ; Reference to File #2006.69 in ICR #7410
+12 QUIT
+13 ;
ERR ;
+1 SET @MAGRY@(0)="0^4~ERROR "_$$EC^%ZOSV
+2 DO @^%ZOSF("ERRTN")
+3 if $QUIT
QUIT 1
QUIT
+4 ;
+5 ;
MGRREV2(CLIENT) ; Return 1/0 for Manager Revision-2 is enabled
+1 ; Input CLIENT optional:
+2 ; "CLIENT" indicates Client-side Tab changes only concern
+3 ; Else, concern is Server-side processes disabled/enabled
+4 NEW X
SET X=$PIECE($GET(^MAG(2006.69,1,"ISI")),U,5)
+5 IF +X
Begin DoDot:1
+6 SET CLIENT=$GET(CLIENT)="CLIENT"
+7 ; Level-1 or Level-2 true/enable
IF CLIENT
SET X=1
+8 ; Server-side processes enable for Level-2 only
IF '$TEST
SET X=$SELECT(X=2:1,1:0)
End DoDot:1
+9 if $QUIT
QUIT X
QUIT
+10 ;
UJOCHECK(OUT) ;
+1 ; Check to see if UJO National Patient ID (#2,400000000) exists.
+2 ; Used to verify this is an EHS/EHSI system
+3 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR^ISIJUTL9"
+4 KILL OUT
+5 SET OUT=$$VFIELD^DILFD(2,400000000)
+6 if $QUIT
QUIT OUT
QUIT
+7 ;
LSTSTATU(LSTID,HDATE) ; Exam list statistics update
+1 ; LSTID = ien of Exam list requested by user
+2 ; HDATE = $H of date to be filed; default is today
+3 NEW CT,DAT,IEN,IENDAT,IENSIT,FIL,X
+4 ; programmer's test routine is the only use of passed in value
SET HDATE=$GET(HDATE,$HOROLOG)
+5 ; statistics file
SET FIL=$NAME(^ISI(23452))
+6 IF '$DATA(@FIL)
QUIT
+7 ; should never happen
IF '$DATA(^MAG(2006.631,LSTID))
QUIT
+8 ;
+9 ; stats are aggregated weekly
SET DAT=$$WEEKOF(HDATE)
+10 ;
+11 LOCK +@FIL@(0):1
+12 ; should not happen, but don't bother if lock fails
IF '$TEST
QUIT
+13 SET IEN=$ORDER(@FIL@("B",LSTID,""))
+14 ; create new list entry
IF 'IEN
Begin DoDot:1
+15 SET X=@FIL@(0)
SET IEN=$PIECE(X,U,3)+1
SET CT=$PIECE(X,U,4)+1
SET $PIECE(X,U,3)=IEN
SET $PIECE(X,U,4)=CT
SET ^(0)=X
+16 SET @FIL@(IEN,0)=LSTID
SET @FIL@("B",LSTID,IEN)=""
End DoDot:1
+17 LOCK -@FIL@(0)
+18 ;
+19 LOCK +@FIL@(IEN):1
+20 ; ditto
IF '$TEST
QUIT
+21 SET IENDAT=$ORDER(@FIL@(IEN,1,"B",DAT,""))
+22 ; create new DATE for this list
IF 'IENDAT
Begin DoDot:1
+23 SET X=$GET(@FIL@(IEN,1,0))
SET IENDAT=$PIECE(X,U,3)+1
SET CT=$PIECE(X,U,4)+1
SET $PIECE(X,U,3)=IENDAT
SET $PIECE(X,U,4)=CT
SET ^(0)=X
+24 SET @FIL@(IEN,1,IENDAT,0)=DAT
SET @FIL@(IEN,1,"B",DAT,IENDAT)=""
End DoDot:1
+25 LOCK -@FIL@(IEN)
+26 ;
+27 LOCK +@FIL@(IEN,DUZ(2)):1
+28 ; ditto
IF '$TEST
QUIT
+29 SET IENSIT=$ORDER(@FIL@(IEN,1,IENDAT,1,"B",DUZ(2),""))
+30 ; create new SITE for this list/date
IF 'IENSIT
Begin DoDot:1
+31 SET X=$GET(@FIL@(IEN,1,IENDAT,1,0))
SET IENSIT=$PIECE(X,U,3)+1
SET CT=$PIECE(X,U,4)+1
SET $PIECE(X,U,3)=IENSIT
SET $PIECE(X,U,4)=CT
SET ^(0)=X
+32 SET @FIL@(IEN,1,IENDAT,1,IENSIT,0)=DUZ(2)_U_0
SET @FIL@(IEN,1,IENDAT,1,"B",DUZ(2),IENSIT)=""
End DoDot:1
+33 SET X=$GET(@FIL@(IEN,1,IENDAT,1,IENSIT,0))
SET CT=$PIECE(X,U,2)+1
SET $PIECE(X,U,2)=CT
SET ^(0)=X
+34 ;
+35 LOCK -@FIL@(IEN,DUZ(2))
+36 QUIT
+37 ;
WEEKOF(H) ; Calculate a "week-of" date for input $H value
+1 ; returns fman date in X
SET %H=H
DO YMD^%DTC
+2 IF H#7
Begin DoDot:1
+3 ; returns fman date in X
SET X1=X
SET X2=-(H#7)
DO C^%DTC
End DoDot:1
+4 if $QUIT
QUIT X
QUIT
+5 ;
LSTSTATD ; Exam list statistics dump
+1 ;
+2 SET DIC=23452
SET L=0
+3 SET DHD=""
+4 SET FLDS="[LIST STATS"
SET BY="[LIST STATS"
+5 SET DIOEND="D LISTDEFS^ISIJUTL9"
+6 DO EN1^DIP
+7 QUIT
+8 ;
LISTDEFS ; dump out exam list definitions
+1 ;
+2 WRITE !!,"LIST DEFINITIONS:",!
+3 NEW FIL,IEN,I,LSTNUM,X
+4 SET FIL=$NAME(^MAG(2006.631))
+5 SET LSTNUM=""
+6 FOR
SET LSTNUM=$ORDER(@FIL@("C",LSTNUM))
if LSTNUM>9799
QUIT
SET IEN=$ORDER(^(LSTNUM,""))
Begin DoDot:1
+7 WRITE !,$JUSTIFY(LSTNUM,4)," "
+8 IF 'IEN
WRITE " * * * No report defined for List # * * *",!
QUIT
+9 SET X=@FIL@(IEN,0)
+10 FOR I=3,6,7,1
WRITE " ",U," ",$PIECE(X,U,I)
+11 IF $DATA(@FIL@(IEN,"DEF",5,1))
FOR I=1:1
SET X=$GET(^(I))
if X=""
QUIT
WRITE !,?6,X
+12 WRITE !
End DoDot:1
+13 WRITE !!,"<END>",!
+14 QUIT
+15 ;
END QUIT
+1 ;
