- 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 Jan 18, 2025@03:45:14 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 ;