Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ISIJFAV

ISIJFAV.m

Go to the documentation of this file.
  1. ISIJFAV ; ISI/JHC - ISIRAD Favorites functions ; 10/17/2022
  1. ;;1.1;ESL ISI IMAGING;**99,103,106,110**;Dec 21, 2022;Build 41
  1. ;; This routine is the property of ViTel Net, and should not be modified.
  1. ;; This software is a medical device and is subject to FDA regulation.
  1. ;; Modifications to this software may only be made under the terms of
  1. ;; 21CFR820 regulation. 21CFR Subpart A 820.1: "The failure to comply
  1. ;; with any applicable provision in this part renders a device
  1. ;; adulterated under section 501(h) of the act. Such a device,
  1. ;; as well as any person responsible for the failure to comply,
  1. ;; is subject to regulatory action."
  1. ; Reference to GETEXAM2^MAGJUTL1 in ICR #7404
  1. ; Reference to IMGINFO^MAGJUTL2 in ICR #7405
  1. Q
  1. ;;
  1. ERR ;
  1. N ERR S ERR=$$EC^%ZOSV S @MAGGRY@(0)="0^4~"_ERR
  1. D @^%ZOSF("ERRTN")
  1. Q:$Q 1 Q
  1. ;
  1. ; rpc ISIJ FAVORITE -- functions to create/update/retrieve Favorites exams
  1. ;
  1. FAVORITE(MAGGRY,PARAMS,DATA) ;
  1. ; PARAMS: TXID ^ RADFN ^ RADTI ^ RACNI ^ RARPT
  1. ; TXID: Req'd--action to take
  1. ; DATA--(opt) input array containing Notes text
  1. ; Pattern for DATA input & reply is:
  1. ; *KEYWORDS
  1. ; KEYWORD-1 (place holder required)
  1. ; KEYWORD-2 (ditto)
  1. ; *KEYWORDS_END
  1. ; *NOTES Start for NOTES
  1. ; (0:N lines of text follow)
  1. ; *NOTES_END end for note
  1. ;
  1. N $ETRAP,$ESTACK S $ETRAP="D ERR^ISIJFAV"
  1. N COMMA,DASH,EXAMID,EXAMFILE,RACNI,RADFN,RADTI,USERFILE ; vars global to all program subroutines
  1. N MAGLST,REPLY,RET,TXID,EXAMIEN,USERIEN
  1. S REPLY=""
  1. S USERFILE=23451,EXAMFILE=23451.01,COMMA=",",DASH="-"
  1. S TXID=+PARAMS,RADFN=+$P(PARAMS,U,2),RADTI=$P(PARAMS,U,3),RACNI=+$P(PARAMS,U,4)
  1. S MAGLST="ISIJRPC" S MAGGRY=$NA(^TMP($J,MAGLST)) K @MAGGRY
  1. N DIQUIET S DIQUIET=1 D DT^DICRW
  1. I RADFN,RADTI,RACNI,$D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) ; ICR 65
  1. E S REPLY="0^4~Invalid Request; no Exam found for input data ("_PARAMS_")" G FAVORITZ
  1. S EXAMID=RADFN_DASH_RADTI_DASH_RACNI
  1. S USERIEN=$$USERIEN(DUZ),EXAMIEN=$S('USERIEN:"",1:$$EXAMIEN(USERIEN,EXAMID))
  1. I TXID=1 D ; called from any exam list EXCEPT Fav list
  1. . I +EXAMIEN S REPLY="^0~View/edit Favorites list entry." ; not usual, but could happen...
  1. . E S REPLY="^0~Add exam to Favorites list." ; expected "typical" use of txid=1
  1. . D FAVGET("@MAGGRY",USERIEN,EXAMIEN)
  1. . S REPLY=@MAGGRY@(0)_REPLY
  1. E I TXID=2 D ; update new or existing entry; called from Fav DIALOG
  1. . D FAVUPD(.RET,.USERIEN,.EXAMIEN,.DATA)
  1. . S REPLY=0_U_RET
  1. E I TXID=3 D ; delete entry; called from Fav LIST
  1. . I '+EXAMIEN S REPLY="0^3~No Favorites entry exists for this exam.("_PARAMS_")" Q
  1. . D FAVDEL(.RET,USERIEN,EXAMIEN)
  1. . S REPLY=0_U_RET
  1. E I TXID=4 D ; get data to populate Fav Dialog; called from Fav LIST
  1. . I '+EXAMIEN S REPLY="0^4~Problem with Favorites entry for this exam *2 ("_PARAMS_")" Q
  1. . D FAVGET("@MAGGRY",USERIEN,EXAMIEN)
  1. . S REPLY=@MAGGRY@(0)_"^0~View/edit Favorites list entry."
  1. E S REPLY="0^4~Invalid 'Favorites' Transaction ID ("_$P(PARAMS,U)_")"
  1. ;
  1. FAVORITZ ;
  1. S @MAGGRY@(0)=REPLY
  1. Q
  1. ;
  1. FAVUPD(RET,USERIEN,EXAMIEN,DATA) ; Update favorite exam info
  1. N NEWEXAM,ZJ,REPLYTXT
  1. S RET="",NEWEXAM=0
  1. I 'USERIEN S USERIEN=$$NEWUSER(DUZ) ; add this user to Fav file
  1. I 'EXAMIEN D Q:'EXAMIEN
  1. . S EXAMIEN=$$NEWEXAM(USERIEN,EXAMID) ; add this exam to Fav file
  1. . I EXAMIEN S NEWEXAM=1
  1. . E S RET="4~Problem with adding Favorites entry for this exam *1 ("_PARAMS_")"
  1. E D UPDINI(USERIEN,EXAMIEN) ; initialize Keyword & Notes data for existing entry
  1. D PARSE(.ZJ,"ZJ",USERIEN,EXAMIEN,.DATA) ; load input data into zj array
  1. I $D(ZJ) D ; update Keywords & Notes if any
  1. . D FILE^DIE("","ZJ","RSL")
  1. . S X=$G(RSL("DIERR",1))
  1. . I X]"" S RET="4~Problem with adding Favorites entry for this exam *1 ("_PARAMS_")"
  1. I RET]"" Q
  1. S REPLYTXT=$S(NEWEXAM:"New exam added to Favorites.",1:"Favorites exam data updated.")
  1. I $$STSCHECK() S RET="0~"_REPLYTXT
  1. E S RET="3~"_REPLYTXT_" Note--this exam will not be displayed in your Favorites List until it has been interpreted."
  1. Q
  1. ;
  1. UPDINI(USERIEN,EXAMIEN) ; Initialize exam fields prior to update; only called if entry exists
  1. N IENS,KFNUM,ZJ
  1. S IENS=EXAMIEN_COMMA_USERIEN_COMMA
  1. F KFNUM=1,2 S ZJ(EXAMFILE,IENS,KFNUM)="@" ; delete data
  1. D FILE^DIE("","ZJ","RSL")
  1. D WP^DIE(EXAMFILE,IENS,3,"","@")
  1. Q
  1. ;
  1. 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
  1. ; name of the input array at the node defined below
  1. N IP,IENS,KFNUM,KW,NOTE
  1. S (KW,NOTE)=0
  1. S IENS=EXAMIEN_COMMA_USERIEN_COMMA
  1. S IP="" F S IP=$O(DATA(IP)) Q:IP="" S X=DATA(IP) D
  1. . I X="*KEYWORDS" S KW=1 Q
  1. . I X="*NOTES" S NOTE=1 Q
  1. . I KW D
  1. . . I X="*KEYWORDS_END" S KW=0 Q
  1. . . I KW>2 Q
  1. . . S KFNUM=$S(KW=1:1,KW=2:2,1:0)
  1. . . S RET(EXAMFILE,IENS,KFNUM)=$$STRIP(X) ; remove unwanted characters
  1. . . S KW=KW+1
  1. . I NOTE D
  1. . . I X="*NOTES_END" S NOTE=0 Q
  1. . . I NOTE=1 S RET(EXAMFILE,IENS,3)=RETNAM_"("_EXAMFILE_","""_IENS_""""_",3)" ; WP call needs this node
  1. . . S RET(EXAMFILE,IENS,3,NOTE)=X
  1. . . S NOTE=NOTE+1
  1. ;
  1. Q
  1. NEWUSER(DUZ) ; Create new user entry in Favorites file; only called if not yet defined
  1. N ZJ,ZJMSG,RSL
  1. S ZJ(USERFILE,"+1,",.01)=DUZ
  1. D UPDATE^DIE("","ZJ","RSL")
  1. Q:$Q RSL(1) Q
  1. ;
  1. NEWEXAM(USERIEN,EXAMID) ; Create new exam entry in Favorites file; only called if not yet defined
  1. N ZJ,ZJMSG,RSL
  1. S ZJ(EXAMFILE,"+1,"_USERIEN_",",.01)=EXAMID
  1. D UPDATE^DIE("","ZJ","RSL")
  1. Q:$Q RSL(1) Q
  1. ;
  1. STSCHECK() ; Flag (=0) if Exam Status not past Examined state; Else=1
  1. N OK,RADATA,STS,X ; other vars global to program
  1. S OK=1
  1. S RADATA=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
  1. S STS=$P(RADATA,U,3)
  1. I STS]"" D
  1. . S X=$$STATUS^ISIJLS1(STS)
  1. . I X="I"!(X=9) Q ; Interp/Complete
  1. . I X=0!(X=1)!(X="W")!(X="R")!(X="E") S OK=0 Q ; Cancelled/Waiting/Examined, P106 add "R"
  1. Q:$Q OK Q
  1. ;
  1. FAVDEL(RET,USERIEN,EXAMIEN) ; Delete favorite exam entry; only called if entry exists
  1. N IENS,ZJ
  1. S IENS=EXAMIEN_COMMA_USERIEN_COMMA
  1. S ZJ(EXAMFILE,IENS,.01)="@" ; delete entire exam record
  1. D FILE^DIE("","ZJ","RSL")
  1. S X=$G(RSL("DIERR",1))
  1. I X]"" S RET="4~Problem with deleting Favorites entry for this exam *4 ("_USERIEN_COMMA_EXAMIEN_"). "_X
  1. E S RET="0~Favorites entry deleted"
  1. Q
  1. ;
  1. FAVGET(RET,USERIEN,EXAMIEN) ; return favorites details
  1. N DAYCASE,IMGCNT,IENS,IRET,ISS,KEYWD1,KEYWD2,MAGDT,PROC,RADATA,RARPT,ZJ
  1. K ^TMP($J,"MAGRAEX")
  1. S (KEYWD1,KEYWD2)=""
  1. D GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,"",.X)
  1. S RADATA=$G(^TMP($J,"MAGRAEX",1,1))
  1. K ^TMP($J,"MAGRAEX")
  1. S RARPT=$P(RADATA,U,10),DAYCASE=$P(RADATA,U,12),PROC=$P(RADATA,U,9)
  1. D IMGINFO^MAGJUTL2(RARPT,.Y) S IMGCNT=+$P(Y,U),MAGDT=$P(Y,U,3)
  1. I MAGDT="" S MAGDT=$P(RADATA,U,7)
  1. S MAGDT=$$FMTE^XLFDT(MAGDT,"5Z")
  1. S IRET=0
  1. S IRET=IRET+1,@RET@(IRET)="Case #^Procedure^Image Date/Time^# Img"
  1. S IRET=IRET+1,@RET@(IRET)=DAYCASE_U_PROC_U_MAGDT_U_IMGCNT
  1. ;
  1. I USERIEN,EXAMIEN D
  1. . S IENS=EXAMIEN_COMMA_USERIEN_COMMA
  1. . D GETS^DIQ(EXAMFILE,IENS,"1;2;3","","ZJ")
  1. . S KEYWD1=$G(ZJ(EXAMFILE,IENS,1)) S:KEYWD1="" KEYWD1=" " ; workaround client bug
  1. . S KEYWD2=$G(ZJ(EXAMFILE,IENS,2)) S:KEYWD2="" KEYWD2=" " ; ditto
  1. . S IRET=IRET+1,@RET@(IRET)="*KEYWORDS"
  1. . S IRET=IRET+1,@RET@(IRET)=KEYWD1
  1. . S IRET=IRET+1,@RET@(IRET)=KEYWD2
  1. . S IRET=IRET+1,@RET@(IRET)="*KEYWORDS_END"
  1. . S IRET=IRET+1,@RET@(IRET)="*NOTES"
  1. . I $D(ZJ(EXAMFILE,IENS,3))>9 D
  1. . . S ISS=0
  1. . . F S ISS=$O(ZJ(EXAMFILE,IENS,3,ISS)) Q:'ISS S IRET=IRET+1,@RET@(IRET)=ZJ(EXAMFILE,IENS,3,ISS)
  1. . S IRET=IRET+1,@RET@(IRET)="*NOTES_END"
  1. S @RET@(0)=IRET
  1. ;
  1. Q
  1. ;
  1. USERIEN(DUZ) ; Return UserIEN for input duz
  1. N USERIEN,ZJ
  1. D FIND^DIC(USERFILE,,"@","OQ",DUZ,,,,,"ZJ")
  1. S USERIEN=$S(+ZJ("DILIST",0):ZJ("DILIST",2,1),1:"")
  1. Q:$Q USERIEN Q
  1. ;
  1. EXAMIEN(USERIEN,EXAMID) ; Return ExamIEN for input exam ID string
  1. N EXAMIEN,IENS,ZJ
  1. S IENS=COMMA_USERIEN_COMMA
  1. D FIND^DIC(EXAMFILE,IENS,"@","O",EXAMID,,,,,"ZJ")
  1. S EXAMIEN=$S(+ZJ("DILIST",0):ZJ("DILIST",2,1),1:"")
  1. Q:$Q EXAMIEN Q
  1. ;
  1. STRIP(X) ; remove up-carets & leading/trailing spaces
  1. N I,T
  1. S X=$TR(X,U," ")
  1. F I=$L(X):-1:0 I $E(X,I)'=" " Q
  1. S X=$E(X,1,I)
  1. F I=1:1:$L(X) I $E(X,I)'=" " Q
  1. S X=$E(X,I,999)
  1. Q:$Q X Q
  1. ;
  1. END Q
  1. ;