ISIJFAV ; ISI/JHC - ISIRAD Favorites functions ; 10/17/2022
;;1.1;ESL ISI IMAGING;**99,103,106,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 GETEXAM2^MAGJUTL1 in ICR #7404
; Reference to IMGINFO^MAGJUTL2 in ICR #7405
Q
;;
ERR ;
N ERR S ERR=$$EC^%ZOSV S @MAGGRY@(0)="0^4~"_ERR
D @^%ZOSF("ERRTN")
Q:$Q 1 Q
;
; rpc ISIJ FAVORITE -- functions to create/update/retrieve Favorites exams
;
FAVORITE(MAGGRY,PARAMS,DATA) ;
; PARAMS: TXID ^ RADFN ^ RADTI ^ RACNI ^ RARPT
; TXID: Req'd--action to take
; DATA--(opt) input array containing Notes text
; Pattern for DATA input & reply is:
; *KEYWORDS
; KEYWORD-1 (place holder required)
; KEYWORD-2 (ditto)
; *KEYWORDS_END
; *NOTES Start for NOTES
; (0:N lines of text follow)
; *NOTES_END end for note
;
N $ETRAP,$ESTACK S $ETRAP="D ERR^ISIJFAV"
N COMMA,DASH,EXAMID,EXAMFILE,RACNI,RADFN,RADTI,USERFILE ; vars global to all program subroutines
N MAGLST,REPLY,RET,TXID,EXAMIEN,USERIEN
S REPLY=""
S USERFILE=23451,EXAMFILE=23451.01,COMMA=",",DASH="-"
S TXID=+PARAMS,RADFN=+$P(PARAMS,U,2),RADTI=$P(PARAMS,U,3),RACNI=+$P(PARAMS,U,4)
S MAGLST="ISIJRPC" S MAGGRY=$NA(^TMP($J,MAGLST)) K @MAGGRY
N DIQUIET S DIQUIET=1 D DT^DICRW
I RADFN,RADTI,RACNI,$D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) ; ICR 65
E S REPLY="0^4~Invalid Request; no Exam found for input data ("_PARAMS_")" G FAVORITZ
S EXAMID=RADFN_DASH_RADTI_DASH_RACNI
S USERIEN=$$USERIEN(DUZ),EXAMIEN=$S('USERIEN:"",1:$$EXAMIEN(USERIEN,EXAMID))
I TXID=1 D ; called from any exam list EXCEPT Fav list
. I +EXAMIEN S REPLY="^0~View/edit Favorites list entry." ; not usual, but could happen...
. E S REPLY="^0~Add exam to Favorites list." ; expected "typical" use of txid=1
. D FAVGET("@MAGGRY",USERIEN,EXAMIEN)
. S REPLY=@MAGGRY@(0)_REPLY
E I TXID=2 D ; update new or existing entry; called from Fav DIALOG
. D FAVUPD(.RET,.USERIEN,.EXAMIEN,.DATA)
. S REPLY=0_U_RET
E I TXID=3 D ; delete entry; called from Fav LIST
. I '+EXAMIEN S REPLY="0^3~No Favorites entry exists for this exam.("_PARAMS_")" Q
. D FAVDEL(.RET,USERIEN,EXAMIEN)
. S REPLY=0_U_RET
E I TXID=4 D ; get data to populate Fav Dialog; called from Fav LIST
. I '+EXAMIEN S REPLY="0^4~Problem with Favorites entry for this exam *2 ("_PARAMS_")" Q
. D FAVGET("@MAGGRY",USERIEN,EXAMIEN)
. S REPLY=@MAGGRY@(0)_"^0~View/edit Favorites list entry."
E S REPLY="0^4~Invalid 'Favorites' Transaction ID ("_$P(PARAMS,U)_")"
;
FAVORITZ ;
S @MAGGRY@(0)=REPLY
Q
;
FAVUPD(RET,USERIEN,EXAMIEN,DATA) ; Update favorite exam info
N NEWEXAM,ZJ,REPLYTXT
S RET="",NEWEXAM=0
I 'USERIEN S USERIEN=$$NEWUSER(DUZ) ; add this user to Fav file
I 'EXAMIEN D Q:'EXAMIEN
. S EXAMIEN=$$NEWEXAM(USERIEN,EXAMID) ; add this exam to Fav file
. I EXAMIEN S NEWEXAM=1
. E S RET="4~Problem with adding Favorites entry for this exam *1 ("_PARAMS_")"
E D UPDINI(USERIEN,EXAMIEN) ; initialize Keyword & Notes data for existing entry
D PARSE(.ZJ,"ZJ",USERIEN,EXAMIEN,.DATA) ; load input data into zj array
I $D(ZJ) D ; update Keywords & Notes if any
. D FILE^DIE("","ZJ","RSL")
. S X=$G(RSL("DIERR",1))
. I X]"" S RET="4~Problem with adding Favorites entry for this exam *1 ("_PARAMS_")"
I RET]"" Q
S REPLYTXT=$S(NEWEXAM:"New exam added to Favorites.",1:"Favorites exam data updated.")
I $$STSCHECK() S RET="0~"_REPLYTXT
E S RET="3~"_REPLYTXT_" Note--this exam will not be displayed in your Favorites List until it has been interpreted."
Q
;
UPDINI(USERIEN,EXAMIEN) ; Initialize exam fields prior to update; only called if entry exists
N IENS,KFNUM,ZJ
S IENS=EXAMIEN_COMMA_USERIEN_COMMA
F KFNUM=1,2 S ZJ(EXAMFILE,IENS,KFNUM)="@" ; delete data
D FILE^DIE("","ZJ","RSL")
D WP^DIE(EXAMFILE,IENS,3,"","@")
Q
;
PARSE(RET,RETNAM,USERIEN,EXAMIEN,DATA) ; package input data and format for fileman DBS calls
; re RETNAM: the fileman update call for a WP field needs the
; name of the input array at the node defined below
N IP,IENS,KFNUM,KW,NOTE
S (KW,NOTE)=0
S IENS=EXAMIEN_COMMA_USERIEN_COMMA
S IP="" F S IP=$O(DATA(IP)) Q:IP="" S X=DATA(IP) D
. I X="*KEYWORDS" S KW=1 Q
. I X="*NOTES" S NOTE=1 Q
. I KW D
. . I X="*KEYWORDS_END" S KW=0 Q
. . I KW>2 Q
. . S KFNUM=$S(KW=1:1,KW=2:2,1:0)
. . S RET(EXAMFILE,IENS,KFNUM)=$$STRIP(X) ; remove unwanted characters
. . S KW=KW+1
. I NOTE D
. . I X="*NOTES_END" S NOTE=0 Q
. . I NOTE=1 S RET(EXAMFILE,IENS,3)=RETNAM_"("_EXAMFILE_","""_IENS_""""_",3)" ; WP call needs this node
. . S RET(EXAMFILE,IENS,3,NOTE)=X
. . S NOTE=NOTE+1
;
Q
NEWUSER(DUZ) ; Create new user entry in Favorites file; only called if not yet defined
N ZJ,ZJMSG,RSL
S ZJ(USERFILE,"+1,",.01)=DUZ
D UPDATE^DIE("","ZJ","RSL")
Q:$Q RSL(1) Q
;
NEWEXAM(USERIEN,EXAMID) ; Create new exam entry in Favorites file; only called if not yet defined
N ZJ,ZJMSG,RSL
S ZJ(EXAMFILE,"+1,"_USERIEN_",",.01)=EXAMID
D UPDATE^DIE("","ZJ","RSL")
Q:$Q RSL(1) Q
;
STSCHECK() ; Flag (=0) if Exam Status not past Examined state; Else=1
N OK,RADATA,STS,X ; other vars global to program
S OK=1
S RADATA=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
S STS=$P(RADATA,U,3)
I STS]"" D
. S X=$$STATUS^ISIJLS1(STS)
. I X="I"!(X=9) Q ; Interp/Complete
. I X=0!(X=1)!(X="W")!(X="R")!(X="E") S OK=0 Q ; Cancelled/Waiting/Examined, P106 add "R"
Q:$Q OK Q
;
FAVDEL(RET,USERIEN,EXAMIEN) ; Delete favorite exam entry; only called if entry exists
N IENS,ZJ
S IENS=EXAMIEN_COMMA_USERIEN_COMMA
S ZJ(EXAMFILE,IENS,.01)="@" ; delete entire exam record
D FILE^DIE("","ZJ","RSL")
S X=$G(RSL("DIERR",1))
I X]"" S RET="4~Problem with deleting Favorites entry for this exam *4 ("_USERIEN_COMMA_EXAMIEN_"). "_X
E S RET="0~Favorites entry deleted"
Q
;
FAVGET(RET,USERIEN,EXAMIEN) ; return favorites details
N DAYCASE,IMGCNT,IENS,IRET,ISS,KEYWD1,KEYWD2,MAGDT,PROC,RADATA,RARPT,ZJ
K ^TMP($J,"MAGRAEX")
S (KEYWD1,KEYWD2)=""
D GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,"",.X)
S RADATA=$G(^TMP($J,"MAGRAEX",1,1))
K ^TMP($J,"MAGRAEX")
S RARPT=$P(RADATA,U,10),DAYCASE=$P(RADATA,U,12),PROC=$P(RADATA,U,9)
D IMGINFO^MAGJUTL2(RARPT,.Y) S IMGCNT=+$P(Y,U),MAGDT=$P(Y,U,3)
I MAGDT="" S MAGDT=$P(RADATA,U,7)
S MAGDT=$$FMTE^XLFDT(MAGDT,"5Z")
S IRET=0
S IRET=IRET+1,@RET@(IRET)="Case #^Procedure^Image Date/Time^# Img"
S IRET=IRET+1,@RET@(IRET)=DAYCASE_U_PROC_U_MAGDT_U_IMGCNT
;
I USERIEN,EXAMIEN D
. S IENS=EXAMIEN_COMMA_USERIEN_COMMA
. D GETS^DIQ(EXAMFILE,IENS,"1;2;3","","ZJ")
. S KEYWD1=$G(ZJ(EXAMFILE,IENS,1)) S:KEYWD1="" KEYWD1=" " ; workaround client bug
. S KEYWD2=$G(ZJ(EXAMFILE,IENS,2)) S:KEYWD2="" KEYWD2=" " ; ditto
. S IRET=IRET+1,@RET@(IRET)="*KEYWORDS"
. S IRET=IRET+1,@RET@(IRET)=KEYWD1
. S IRET=IRET+1,@RET@(IRET)=KEYWD2
. S IRET=IRET+1,@RET@(IRET)="*KEYWORDS_END"
. S IRET=IRET+1,@RET@(IRET)="*NOTES"
. I $D(ZJ(EXAMFILE,IENS,3))>9 D
. . S ISS=0
. . F S ISS=$O(ZJ(EXAMFILE,IENS,3,ISS)) Q:'ISS S IRET=IRET+1,@RET@(IRET)=ZJ(EXAMFILE,IENS,3,ISS)
. S IRET=IRET+1,@RET@(IRET)="*NOTES_END"
S @RET@(0)=IRET
;
Q
;
USERIEN(DUZ) ; Return UserIEN for input duz
N USERIEN,ZJ
D FIND^DIC(USERFILE,,"@","OQ",DUZ,,,,,"ZJ")
S USERIEN=$S(+ZJ("DILIST",0):ZJ("DILIST",2,1),1:"")
Q:$Q USERIEN Q
;
EXAMIEN(USERIEN,EXAMID) ; Return ExamIEN for input exam ID string
N EXAMIEN,IENS,ZJ
S IENS=COMMA_USERIEN_COMMA
D FIND^DIC(EXAMFILE,IENS,"@","O",EXAMID,,,,,"ZJ")
S EXAMIEN=$S(+ZJ("DILIST",0):ZJ("DILIST",2,1),1:"")
Q:$Q EXAMIEN Q
;
STRIP(X) ; remove up-carets & leading/trailing spaces
N I,T
S X=$TR(X,U," ")
F I=$L(X):-1:0 I $E(X,I)'=" " Q
S X=$E(X,1,I)
F I=1:1:$L(X) I $E(X,I)'=" " Q
S X=$E(X,I,999)
Q:$Q X Q
;
END Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HISIJFAV 8331 printed Apr 09, 2024@21:46:39 Page 2
ISIJFAV ; ISI/JHC - ISIRAD Favorites functions ; 10/17/2022
+1 ;;1.1;ESL ISI IMAGING;**99,103,106,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 GETEXAM2^MAGJUTL1 in ICR #7404
+11 ; Reference to IMGINFO^MAGJUTL2 in ICR #7405
+12 QUIT
+13 ;;
ERR ;
+1 NEW ERR
SET ERR=$$EC^%ZOSV
SET @MAGGRY@(0)="0^4~"_ERR
+2 DO @^%ZOSF("ERRTN")
+3 if $QUIT
QUIT 1
QUIT
+4 ;
+5 ; rpc ISIJ FAVORITE -- functions to create/update/retrieve Favorites exams
+6 ;
FAVORITE(MAGGRY,PARAMS,DATA) ;
+1 ; PARAMS: TXID ^ RADFN ^ RADTI ^ RACNI ^ RARPT
+2 ; TXID: Req'd--action to take
+3 ; DATA--(opt) input array containing Notes text
+4 ; Pattern for DATA input & reply is:
+5 ; *KEYWORDS
+6 ; KEYWORD-1 (place holder required)
+7 ; KEYWORD-2 (ditto)
+8 ; *KEYWORDS_END
+9 ; *NOTES Start for NOTES
+10 ; (0:N lines of text follow)
+11 ; *NOTES_END end for note
+12 ;
+13 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR^ISIJFAV"
+14 ; vars global to all program subroutines
NEW COMMA,DASH,EXAMID,EXAMFILE,RACNI,RADFN,RADTI,USERFILE
+15 NEW MAGLST,REPLY,RET,TXID,EXAMIEN,USERIEN
+16 SET REPLY=""
+17 SET USERFILE=23451
SET EXAMFILE=23451.01
SET COMMA=","
SET DASH="-"
+18 SET TXID=+PARAMS
SET RADFN=+$PIECE(PARAMS,U,2)
SET RADTI=$PIECE(PARAMS,U,3)
SET RACNI=+$PIECE(PARAMS,U,4)
+19 SET MAGLST="ISIJRPC"
SET MAGGRY=$NAME(^TMP($JOB,MAGLST))
KILL @MAGGRY
+20 NEW DIQUIET
SET DIQUIET=1
DO DT^DICRW
+21 ; ICR 65
IF RADFN
IF RADTI
IF RACNI
IF $DATA(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
+22 IF '$TEST
SET REPLY="0^4~Invalid Request; no Exam found for input data ("_PARAMS_")"
GOTO FAVORITZ
+23 SET EXAMID=RADFN_DASH_RADTI_DASH_RACNI
+24 SET USERIEN=$$USERIEN(DUZ)
SET EXAMIEN=$SELECT('USERIEN:"",1:$$EXAMIEN(USERIEN,EXAMID))
+25 ; called from any exam list EXCEPT Fav list
IF TXID=1
Begin DoDot:1
+26 ; not usual, but could happen...
IF +EXAMIEN
SET REPLY="^0~View/edit Favorites list entry."
+27 ; expected "typical" use of txid=1
IF '$TEST
SET REPLY="^0~Add exam to Favorites list."
+28 DO FAVGET("@MAGGRY",USERIEN,EXAMIEN)
+29 SET REPLY=@MAGGRY@(0)_REPLY
End DoDot:1
+30 ; update new or existing entry; called from Fav DIALOG
IF '$TEST
IF TXID=2
Begin DoDot:1
+31 DO FAVUPD(.RET,.USERIEN,.EXAMIEN,.DATA)
+32 SET REPLY=0_U_RET
End DoDot:1
+33 ; delete entry; called from Fav LIST
IF '$TEST
IF TXID=3
Begin DoDot:1
+34 IF '+EXAMIEN
SET REPLY="0^3~No Favorites entry exists for this exam.("_PARAMS_")"
QUIT
+35 DO FAVDEL(.RET,USERIEN,EXAMIEN)
+36 SET REPLY=0_U_RET
End DoDot:1
+37 ; get data to populate Fav Dialog; called from Fav LIST
IF '$TEST
IF TXID=4
Begin DoDot:1
+38 IF '+EXAMIEN
SET REPLY="0^4~Problem with Favorites entry for this exam *2 ("_PARAMS_")"
QUIT
+39 DO FAVGET("@MAGGRY",USERIEN,EXAMIEN)
+40 SET REPLY=@MAGGRY@(0)_"^0~View/edit Favorites list entry."
End DoDot:1
+41 IF '$TEST
SET REPLY="0^4~Invalid 'Favorites' Transaction ID ("_$PIECE(PARAMS,U)_")"
+42 ;
FAVORITZ ;
+1 SET @MAGGRY@(0)=REPLY
+2 QUIT
+3 ;
FAVUPD(RET,USERIEN,EXAMIEN,DATA) ; Update favorite exam info
+1 NEW NEWEXAM,ZJ,REPLYTXT
+2 SET RET=""
SET NEWEXAM=0
+3 ; add this user to Fav file
IF 'USERIEN
SET USERIEN=$$NEWUSER(DUZ)
+4 IF 'EXAMIEN
Begin DoDot:1
+5 ; add this exam to Fav file
SET EXAMIEN=$$NEWEXAM(USERIEN,EXAMID)
+6 IF EXAMIEN
SET NEWEXAM=1
+7 IF '$TEST
SET RET="4~Problem with adding Favorites entry for this exam *1 ("_PARAMS_")"
End DoDot:1
if 'EXAMIEN
QUIT
+8 ; initialize Keyword & Notes data for existing entry
IF '$TEST
DO UPDINI(USERIEN,EXAMIEN)
+9 ; load input data into zj array
DO PARSE(.ZJ,"ZJ",USERIEN,EXAMIEN,.DATA)
+10 ; update Keywords & Notes if any
IF $DATA(ZJ)
Begin DoDot:1
+11 DO FILE^DIE("","ZJ","RSL")
+12 SET X=$GET(RSL("DIERR",1))
+13 IF X]""
SET RET="4~Problem with adding Favorites entry for this exam *1 ("_PARAMS_")"
End DoDot:1
+14 IF RET]""
QUIT
+15 SET REPLYTXT=$SELECT(NEWEXAM:"New exam added to Favorites.",1:"Favorites exam data updated.")
+16 IF $$STSCHECK()
SET RET="0~"_REPLYTXT
+17 IF '$TEST
SET RET="3~"_REPLYTXT_" Note--this exam will not be displayed in your Favorites List until it has been interpreted."
+18 QUIT
+19 ;
UPDINI(USERIEN,EXAMIEN) ; Initialize exam fields prior to update; only called if entry exists
+1 NEW IENS,KFNUM,ZJ
+2 SET IENS=EXAMIEN_COMMA_USERIEN_COMMA
+3 ; delete data
FOR KFNUM=1,2
SET ZJ(EXAMFILE,IENS,KFNUM)="@"
+4 DO FILE^DIE("","ZJ","RSL")
+5 DO WP^DIE(EXAMFILE,IENS,3,"","@")
+6 QUIT
+7 ;
PARSE(RET,RETNAM,USERIEN,EXAMIEN,DATA) ; package input data and format for fileman DBS calls
+1 ; re RETNAM: the fileman update call for a WP field needs the
+2 ; name of the input array at the node defined below
+3 NEW IP,IENS,KFNUM,KW,NOTE
+4 SET (KW,NOTE)=0
+5 SET IENS=EXAMIEN_COMMA_USERIEN_COMMA
+6 SET IP=""
FOR
SET IP=$ORDER(DATA(IP))
if IP=""
QUIT
SET X=DATA(IP)
Begin DoDot:1
+7 IF X="*KEYWORDS"
SET KW=1
QUIT
+8 IF X="*NOTES"
SET NOTE=1
QUIT
+9 IF KW
Begin DoDot:2
+10 IF X="*KEYWORDS_END"
SET KW=0
QUIT
+11 IF KW>2
QUIT
+12 SET KFNUM=$SELECT(KW=1:1,KW=2:2,1:0)
+13 ; remove unwanted characters
SET RET(EXAMFILE,IENS,KFNUM)=$$STRIP(X)
+14 SET KW=KW+1
End DoDot:2
+15 IF NOTE
Begin DoDot:2
+16 IF X="*NOTES_END"
SET NOTE=0
QUIT
+17 ; WP call needs this node
IF NOTE=1
SET RET(EXAMFILE,IENS,3)=RETNAM_"("_EXAMFILE_","""_IENS_""""_",3)"
+18 SET RET(EXAMFILE,IENS,3,NOTE)=X
+19 SET NOTE=NOTE+1
End DoDot:2
End DoDot:1
+20 ;
+21 QUIT
NEWUSER(DUZ) ; Create new user entry in Favorites file; only called if not yet defined
+1 NEW ZJ,ZJMSG,RSL
+2 SET ZJ(USERFILE,"+1,",.01)=DUZ
+3 DO UPDATE^DIE("","ZJ","RSL")
+4 if $QUIT
QUIT RSL(1)
QUIT
+5 ;
NEWEXAM(USERIEN,EXAMID) ; Create new exam entry in Favorites file; only called if not yet defined
+1 NEW ZJ,ZJMSG,RSL
+2 SET ZJ(EXAMFILE,"+1,"_USERIEN_",",.01)=EXAMID
+3 DO UPDATE^DIE("","ZJ","RSL")
+4 if $QUIT
QUIT RSL(1)
QUIT
+5 ;
STSCHECK() ; Flag (=0) if Exam Status not past Examined state; Else=1
+1 ; other vars global to program
NEW OK,RADATA,STS,X
+2 SET OK=1
+3 SET RADATA=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
+4 SET STS=$PIECE(RADATA,U,3)
+5 IF STS]""
Begin DoDot:1
+6 SET X=$$STATUS^ISIJLS1(STS)
+7 ; Interp/Complete
IF X="I"!(X=9)
QUIT
+8 ; Cancelled/Waiting/Examined, P106 add "R"
IF X=0!(X=1)!(X="W")!(X="R")!(X="E")
SET OK=0
QUIT
End DoDot:1
+9 if $QUIT
QUIT OK
QUIT
+10 ;
FAVDEL(RET,USERIEN,EXAMIEN) ; Delete favorite exam entry; only called if entry exists
+1 NEW IENS,ZJ
+2 SET IENS=EXAMIEN_COMMA_USERIEN_COMMA
+3 ; delete entire exam record
SET ZJ(EXAMFILE,IENS,.01)="@"
+4 DO FILE^DIE("","ZJ","RSL")
+5 SET X=$GET(RSL("DIERR",1))
+6 IF X]""
SET RET="4~Problem with deleting Favorites entry for this exam *4 ("_USERIEN_COMMA_EXAMIEN_"). "_X
+7 IF '$TEST
SET RET="0~Favorites entry deleted"
+8 QUIT
+9 ;
FAVGET(RET,USERIEN,EXAMIEN) ; return favorites details
+1 NEW DAYCASE,IMGCNT,IENS,IRET,ISS,KEYWD1,KEYWD2,MAGDT,PROC,RADATA,RARPT,ZJ
+2 KILL ^TMP($JOB,"MAGRAEX")
+3 SET (KEYWD1,KEYWD2)=""
+4 DO GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,"",.X)
+5 SET RADATA=$GET(^TMP($JOB,"MAGRAEX",1,1))
+6 KILL ^TMP($JOB,"MAGRAEX")
+7 SET RARPT=$PIECE(RADATA,U,10)
SET DAYCASE=$PIECE(RADATA,U,12)
SET PROC=$PIECE(RADATA,U,9)
+8 DO IMGINFO^MAGJUTL2(RARPT,.Y)
SET IMGCNT=+$PIECE(Y,U)
SET MAGDT=$PIECE(Y,U,3)
+9 IF MAGDT=""
SET MAGDT=$PIECE(RADATA,U,7)
+10 SET MAGDT=$$FMTE^XLFDT(MAGDT,"5Z")
+11 SET IRET=0
+12 SET IRET=IRET+1
SET @RET@(IRET)="Case #^Procedure^Image Date/Time^# Img"
+13 SET IRET=IRET+1
SET @RET@(IRET)=DAYCASE_U_PROC_U_MAGDT_U_IMGCNT
+14 ;
+15 IF USERIEN
IF EXAMIEN
Begin DoDot:1
+16 SET IENS=EXAMIEN_COMMA_USERIEN_COMMA
+17 DO GETS^DIQ(EXAMFILE,IENS,"1;2;3","","ZJ")
+18 ; workaround client bug
SET KEYWD1=$GET(ZJ(EXAMFILE,IENS,1))
if KEYWD1=""
SET KEYWD1=" "
+19 ; ditto
SET KEYWD2=$GET(ZJ(EXAMFILE,IENS,2))
if KEYWD2=""
SET KEYWD2=" "
+20 SET IRET=IRET+1
SET @RET@(IRET)="*KEYWORDS"
+21 SET IRET=IRET+1
SET @RET@(IRET)=KEYWD1
+22 SET IRET=IRET+1
SET @RET@(IRET)=KEYWD2
+23 SET IRET=IRET+1
SET @RET@(IRET)="*KEYWORDS_END"
+24 SET IRET=IRET+1
SET @RET@(IRET)="*NOTES"
+25 IF $DATA(ZJ(EXAMFILE,IENS,3))>9
Begin DoDot:2
+26 SET ISS=0
+27 FOR
SET ISS=$ORDER(ZJ(EXAMFILE,IENS,3,ISS))
if 'ISS
QUIT
SET IRET=IRET+1
SET @RET@(IRET)=ZJ(EXAMFILE,IENS,3,ISS)
End DoDot:2
+28 SET IRET=IRET+1
SET @RET@(IRET)="*NOTES_END"
End DoDot:1
+29 SET @RET@(0)=IRET
+30 ;
+31 QUIT
+32 ;
USERIEN(DUZ) ; Return UserIEN for input duz
+1 NEW USERIEN,ZJ
+2 DO FIND^DIC(USERFILE,,"@","OQ",DUZ,,,,,"ZJ")
+3 SET USERIEN=$SELECT(+ZJ("DILIST",0):ZJ("DILIST",2,1),1:"")
+4 if $QUIT
QUIT USERIEN
QUIT
+5 ;
EXAMIEN(USERIEN,EXAMID) ; Return ExamIEN for input exam ID string
+1 NEW EXAMIEN,IENS,ZJ
+2 SET IENS=COMMA_USERIEN_COMMA
+3 DO FIND^DIC(EXAMFILE,IENS,"@","O",EXAMID,,,,,"ZJ")
+4 SET EXAMIEN=$SELECT(+ZJ("DILIST",0):ZJ("DILIST",2,1),1:"")
+5 if $QUIT
QUIT EXAMIEN
QUIT
+6 ;
STRIP(X) ; remove up-carets & leading/trailing spaces
+1 NEW I,T
+2 SET X=$TRANSLATE(X,U," ")
+3 FOR I=$LENGTH(X):-1:0
IF $EXTRACT(X,I)'=" "
QUIT
+4 SET X=$EXTRACT(X,1,I)
+5 FOR I=1:1:$LENGTH(X)
IF $EXTRACT(X,I)'=" "
QUIT
+6 SET X=$EXTRACT(X,I,999)
+7 if $QUIT
QUIT X
QUIT
+8 ;
END QUIT
+1 ;
