- ISIJNOTE ; ISI/JHC - ISIRAD Notes functions ; 10/17/2022
- ;;1.1;ESL ISI IMAGING;**104,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 MAGJOBNC^MAGJUTL3 in ICR #7406
- Q
- ;;
- ERR ;
- N ERR S ERR=$$EC^%ZOSV S @MAGGRY@(0)="0^4~"_ERR
- D @^%ZOSF("ERRTN")
- Q:$Q 1 Q
- ;
- ; rpc ISIJ NOTE -- functions to create/retrieve Notes
- ;
- NOTE(MAGGRY,PARAMS,DATA) ;
- ; * this ep also called directly as subroutine by magjrpt for req/rpt display
- ; PARAMS: TXID ^ RADFN ^ RADTI ^ RACNI ^ RARPT ^ FLAG
- ; TXID: Req'd--action to take
- ; FLAG: Optional--use to flag RAD-Dept-only note
- ; DATA--(required for create note) input array containing Notes text
- ; Pattern for DATA input & reply is:
- ; *NOTES Start for NOTES
- ; (1:N lines of text follow)
- ; *NOTES_END end for note
- ;
- N $ETRAP,$ESTACK S $ETRAP="D ERR^ISIJNOTE"
- N COMMA,DASH,EXAMID,FILEREF,NOTEMULT,RACNI,RADFN,RADTI,NOTEFILE ; vars global to all program subroutines
- N FLAG,MAGLST,REPLY,RET,TXID,EXAMIEN,USERIEN,TIMESTMP
- I '$D(MAGJOB("USER")) D MAGJOBNC^MAGJUTL3 ; support non-isirad client calls
- S REPLY=""
- S NOTEFILE=23453,NOTEMULT=23453.01,FILEREF=$NA(^ISI(NOTEFILE))
- S COMMA=",",DASH="-"
- S TXID=+PARAMS,RADFN=+$P(PARAMS,U,2),RADTI=$P(PARAMS,U,3),RACNI=+$P(PARAMS,U,4),FLAG=$P(PARAMS,U,6)
- S MAGLST="ISIJRPC" S MAGGRY=$NA(^TMP($J,MAGLST)) K @MAGGRY
- N DIQUIET S DIQUIET=1 D DT^DICRW,NOW^%DTC S TIMESTMP=$E(%,1,12)
- 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 NOTEZ
- S EXAMID=$$EXAMID(RADFN,RADTI,RACNI)
- S EXAMIEN=$$EXAMIEN(EXAMID)
- I TXID=1 D ; get notes for display
- . I +EXAMIEN S REPLY="0~View Notes."
- . D NOTEGET(.REPLY,"@MAGGRY",EXAMIEN,0,RADFN,RADTI,RACNI)
- . S REPLY=@MAGGRY@(0)_U_REPLY
- E I TXID=2 D ; update new or existing entry; called from Notes form
- . D NOTEUPD(.RET,.EXAMIEN,.DATA,RADFN,RADTI,RACNI)
- . S REPLY=0_U_RET
- E I TXID=3 D STATUS(.REPLY,RADFN,RADTI,RACNI)
- E S REPLY="0^4~Invalid 'Notes' Transaction ID ("_$P(PARAMS,U)_")"
- NOTEZ ;
- S @MAGGRY@(0)=REPLY
- Q
- ;
- STATUS(REPLY,RADFN,RADTI,RACNI) ; Return status information for inserting at top of Requisition
- ; EP called by MAGJRPT
- N COMMA,DASH,EXAMID,EXAMIEN,RET,NOTEFILE,NOTEMULT,FILEREF
- S REPLY="0^0~NOTES: n/a",EXAMIEN=""
- S NOTEFILE=23453,NOTEMULT=23453.01,FILEREF=$NA(^ISI(NOTEFILE))
- S COMMA=",",DASH="-"
- I RADFN,RADTI,RACNI,$D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) D ; ICR 65
- . S EXAMID=$$EXAMID(RADFN,RADTI,RACNI)
- . S EXAMIEN=$$EXAMIEN(EXAMID)
- I EXAMIEN D NOTEGET(.REPLY,.RET,EXAMIEN,1,RADFN,RADTI,RACNI)
- Q
- ;
- EXAMID(RADFN,RADTI,RACNI) ; calculate examid; printsets share a single examid
- N DASH,PSET,RAPRTSET S DASH="-"
- I RADFN,RADTI,RACNI,$D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) D ; ICR 65
- . D EN2^RAUTL20(.PSET) ; get info re rad PrintSet
- . I RAPRTSET S RACNI=$O(PSET(""))
- Q (RADFN_DASH_RADTI_DASH_RACNI) ; for printsets, only racni varies for the members
- ;
- EXAMIEN(EXAMID) ; Return ExamIEN for input examid
- N EXAMIEN,ZJ
- S EXAMIEN="" I EXAMID]"" D
- . D FIND^DIC(NOTEFILE,,"@","OQ",EXAMID,,,,,"ZJ")
- . S EXAMIEN=$S(+ZJ("DILIST",0):ZJ("DILIST",2,1),1:"")
- Q:$Q EXAMIEN Q
- ;
- NOTEUPD(RET,EXAMIEN,DATA,RADFN,RADTI,RACNI) ; Update Note
- N NEWEXAM,NOTIEN,NOTETXT,ZJ,REPLYTXT
- S RET="",NEWEXAM=0,NOTETXT=0
- D CHKTXT(.NOTETXT,.DATA)
- I 'NOTETXT S RET="4~Missing Notes text data ("_PARAMS_")" Q
- I 'EXAMIEN D Q:'EXAMIEN
- . S EXAMIEN=$$NEWEXAM(EXAMID,RADFN,RADTI,RACNI) ; add this exam to Note file
- . I EXAMIEN S NEWEXAM=1
- . E S RET="4~Problem with adding Notes entry for this exam *1 ("_PARAMS_")"
- S NOTIEN=$$NEWNOTE(EXAMIEN,TIMESTMP,DUZ,FLAG) ; initialize Notes data
- I 'NOTIEN S RET="4~Problem with adding Notes entry for this exam *2 ("_PARAMS_")" Q
- D ADDNOTES(.ZJ,"ZJ",EXAMIEN,NOTIEN,.NOTETXT) ; load input data into zj array
- I $D(ZJ) D ; update Notes if any
- . D FILE^DIE("","ZJ","RSL")
- . S X=$G(RSL("DIERR",1))
- . I X]"" S RET="4~Problem with adding Notes entry for this exam *3 ("_PARAMS_")"
- I RET]"" Q
- S REPLYTXT=$S(NEWEXAM:"Note created for exam.",1:"Note added to exam.")
- S RET="0~"_REPLYTXT
- Q
- ;
- CHKTXT(NOTETXT,DATA) ; check for any notes in input data
- ; NOTETXT: return extracted text, if any
- N IP,NOTE
- S IP="" F S IP=$O(DATA(IP)) Q:IP="" S X=DATA(IP) D
- . I X="*NOTES" S NOTE=1 Q
- . I NOTE D
- . . I X="*NOTES_END" S NOTE=0 Q
- . . S X=$$STRIP(X) Q:X="" ; remove blank lines
- . . S NOTETXT=NOTETXT+1,NOTETXT(NOTETXT)=X
- Q
- ;
- ADDNOTES(RET,RETNAM,EXAMIEN,NOTIEN,NOTETXT) ; format notes text data 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
- S IENS=NOTIEN_COMMA_EXAMIEN_COMMA
- F IP=1:1:NOTETXT S X=NOTETXT(IP) D
- . I IP=1 S RET(NOTEMULT,IENS,4)=RETNAM_"("_NOTEMULT_","""_IENS_""""_",4)" ; WP call needs this node
- . S RET(NOTEMULT,IENS,4,IP)=X
- Q
- ;
- NEWEXAM(EXAMID,RADFN,RADTI,RACNI) ; Create new Exam entry in Notes file; only called if not yet defined
- N DAYCASE,DC1,PSET,RADATA,RAPRTSET,ZJ,ZJMSG,RSL
- S ZJ(NOTEFILE,"+1,",.01)=EXAMID
- D UPDATE^DIE("","ZJ","RSL")
- I +RSL(1) D ACNINDX(+RSL(1),RADFN,RADTI,RACNI)
- Q:$Q RSL(1) Q
- ;
- ACNINDX(EXAMIEN,RADFN,RADTI,RACNI,KILL) ; update C index by accession number
- ; --> if a printset, index for all pset members
- ; * * This also callable by fileman Index creation * *
- ; KILL--only set by fileman indexer code if deleting entry
- I '(EXAMIEN&RADFN&RADTI&RACNI) Q
- N DAYCASE,DC1,I,NOTEFILE,FILEREF,PSET,RAPRTSET
- S NOTEFILE=23453,FILEREF=$NA(^ISI(NOTEFILE))
- S DAYCASE=$$DAYCASE(RADFN,RADTI,RACNI)
- Q:'DAYCASE
- I +$G(KILL) K @FILEREF@("C",DAYCASE,EXAMIEN)
- E S @FILEREF@("C",DAYCASE,EXAMIEN)=""
- D EN2^RAUTL20(.PSET) ; get info re rad PrintSet
- I RAPRTSET S I="",DC1=$P(DAYCASE,"-") D
- . F S I=$O(PSET(I)) Q:'I S DAYCASE=DC1_"-"_$P(PSET(I),U) D
- . . I +$G(KILL) K @FILEREF@("C",DAYCASE,EXAMIEN)
- . . E S @FILEREF@("C",DAYCASE,EXAMIEN)=""
- Q
- ;
- DAYCASE(RADFN,RADTI,RACNI) ; return daycase
- N RADTE,RACN,DAYCASE
- S DAYCASE="",RADTE=9999999.9999-RADTI
- S RACN=$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),U)
- I RACN S DAYCASE=$E(RADTE,4,7)_$E(RADTE,2,3)_"-"_RACN
- Q:$Q DAYCASE Q
- ;
- NEWNOTE(EXAMIEN,TIMESTMP,DUZ,FLAG) ; Create new Note entry in file; only called if not yet defined
- N ZJ,ZJMSG,RSL
- S ZJ(NOTEMULT,"+1,"_EXAMIEN_",",.01)=TIMESTMP
- S ZJ(NOTEMULT,"+1,"_EXAMIEN_",",2)=DUZ
- S ZJ(NOTEMULT,"+1,"_EXAMIEN_",",3)=FLAG
- D UPDATE^DIE("","ZJ","RSL")
- Q:$Q RSL(1) Q
- ;
- NOTEGET(REPLY,RET,EXAMIEN,STATUS,RADFN,RADTI,RACNI) ; return Notes details
- ; STATUS-optional; if true, return status only, no details
- ; package mult notes into one array, formatted per each note...
- ; filter for flagged RAD-Only notes--only rad personnel may view
- N DAYCASE,FLAG,IENS,IRET,ISS
- N NOGO,NOTECT,NOTIEN,NOTWHO,NOTTIME,PROC,RADATA,WHO,ZJ
- K ^TMP($J,"MAGRAEX")
- S STATUS=$G(STATUS,0),NOTECT=0
- S RADATA=$$RADATA(RADFN,RADTI,RACNI)
- S DAYCASE=$P(RADATA,U,12),PROC=$P(RADATA,U,9)
- S IRET=0
- S:'STATUS IRET=IRET+1,@RET@(IRET)="NOTES: "_DAYCASE_" "_PROC
- ;
- I EXAMIEN D
- . S:'STATUS IRET=IRET+1,@RET@(IRET)="*NOTES"
- . S NOTIEN=0
- . F S NOTIEN=$O(@FILEREF@(EXAMIEN,1,NOTIEN)) Q:'NOTIEN D
- . . S IENS=NOTIEN_COMMA_EXAMIEN_COMMA
- . . D GETS^DIQ(NOTEMULT,IENS,"2;3","IE","ZJ")
- . . S FLAG=$G(ZJ(NOTEMULT,IENS,3,"I"))
- . . I FLAG=1 S NOGO=1 D Q:NOGO ; indicate or show flagged note only if Rad dept user
- . . . I +$G(MAGJOB("USER",1))!$D(^VA(200,"ARC","T",+DUZ)) S NOGO=0 Q ; OK if rist or tech
- . . I STATUS S NOTECT=NOTECT+1 Q ; no details needed
- . . D GETS^DIQ(NOTEMULT,IENS,".01;4","","ZJ")
- . . S NOTWHO=$G(ZJ(NOTEMULT,IENS,2,"E"))
- . . S NOTTIME=$G(ZJ(NOTEMULT,IENS,.01))
- . . S IRET=IRET+1,@RET@(IRET)=" "_NOTTIME_" "_NOTWHO
- . . I FLAG S IRET=IRET+1,@RET@(IRET)=" << Radiology internal note >>" ; flagged notes clearly indicated to user
- . . I $D(ZJ(NOTEMULT,IENS,4))>9 D
- . . . S ISS=0
- . . . F S ISS=$O(ZJ(NOTEMULT,IENS,4,ISS)) Q:'ISS S IRET=IRET+1,@RET@(IRET)=ZJ(NOTEMULT,IENS,4,ISS)
- . . S IRET=IRET+1,@RET@(IRET)=" "
- . I STATUS S REPLY="0^"_NOTECT_"~NOTES: "_$S('NOTECT:"n/a",1:NOTECT_" note"_$S(NOTECT-1:"s",1:"")_" on file.") ;special format for Status only
- . E S %H=$H D YX^%DTC S IRET=IRET+1,@RET@(IRET)="** END NOTES "_Y_" **"
- . S:'STATUS IRET=IRET+1,@RET@(IRET)="*NOTES_END"
- E S REPLY="2~ [ Notes not entered for this exam. ]",@RET@(0)=1 ; Q ;
- I IRET=4 D
- . F I=2,3,4 K @RET@(I)
- . S @RET@(0)=1,REPLY="2~ [Notes not available for this exam. ]" ; everything filtered out
- E S:'STATUS @RET@(0)=IRET
- Q
- ;
- RADATA(RADFN,RADTI,RACNI) ; get rad data
- N RADATA
- D GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,"",.X)
- S RADATA=$G(^TMP($J,"MAGRAEX",1,1))
- K ^TMP($J,"MAGRAEX")
- Q:$Q RADATA 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[HISIJNOTE 9670 printed Jan 18, 2025@03:45:20 Page 2
- ISIJNOTE ; ISI/JHC - ISIRAD Notes functions ; 10/17/2022
- +1 ;;1.1;ESL ISI IMAGING;**104,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 MAGJOBNC^MAGJUTL3 in ICR #7406
- +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 NOTE -- functions to create/retrieve Notes
- +6 ;
- NOTE(MAGGRY,PARAMS,DATA) ;
- +1 ; * this ep also called directly as subroutine by magjrpt for req/rpt display
- +2 ; PARAMS: TXID ^ RADFN ^ RADTI ^ RACNI ^ RARPT ^ FLAG
- +3 ; TXID: Req'd--action to take
- +4 ; FLAG: Optional--use to flag RAD-Dept-only note
- +5 ; DATA--(required for create note) input array containing Notes text
- +6 ; Pattern for DATA input & reply is:
- +7 ; *NOTES Start for NOTES
- +8 ; (1:N lines of text follow)
- +9 ; *NOTES_END end for note
- +10 ;
- +11 NEW $ETRAP,$ESTACK
- SET $ETRAP="D ERR^ISIJNOTE"
- +12 ; vars global to all program subroutines
- NEW COMMA,DASH,EXAMID,FILEREF,NOTEMULT,RACNI,RADFN,RADTI,NOTEFILE
- +13 NEW FLAG,MAGLST,REPLY,RET,TXID,EXAMIEN,USERIEN,TIMESTMP
- +14 ; support non-isirad client calls
- IF '$DATA(MAGJOB("USER"))
- DO MAGJOBNC^MAGJUTL3
- +15 SET REPLY=""
- +16 SET NOTEFILE=23453
- SET NOTEMULT=23453.01
- SET FILEREF=$NAME(^ISI(NOTEFILE))
- +17 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)
- SET FLAG=$PIECE(PARAMS,U,6)
- +19 SET MAGLST="ISIJRPC"
- SET MAGGRY=$NAME(^TMP($JOB,MAGLST))
- KILL @MAGGRY
- +20 NEW DIQUIET
- SET DIQUIET=1
- DO DT^DICRW
- DO NOW^%DTC
- SET TIMESTMP=$EXTRACT(%,1,12)
- +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 NOTEZ
- +23 SET EXAMID=$$EXAMID(RADFN,RADTI,RACNI)
- +24 SET EXAMIEN=$$EXAMIEN(EXAMID)
- +25 ; get notes for display
- IF TXID=1
- Begin DoDot:1
- +26 IF +EXAMIEN
- SET REPLY="0~View Notes."
- +27 DO NOTEGET(.REPLY,"@MAGGRY",EXAMIEN,0,RADFN,RADTI,RACNI)
- +28 SET REPLY=@MAGGRY@(0)_U_REPLY
- End DoDot:1
- +29 ; update new or existing entry; called from Notes form
- IF '$TEST
- IF TXID=2
- Begin DoDot:1
- +30 DO NOTEUPD(.RET,.EXAMIEN,.DATA,RADFN,RADTI,RACNI)
- +31 SET REPLY=0_U_RET
- End DoDot:1
- +32 IF '$TEST
- IF TXID=3
- DO STATUS(.REPLY,RADFN,RADTI,RACNI)
- +33 IF '$TEST
- SET REPLY="0^4~Invalid 'Notes' Transaction ID ("_$PIECE(PARAMS,U)_")"
- NOTEZ ;
- +1 SET @MAGGRY@(0)=REPLY
- +2 QUIT
- +3 ;
- STATUS(REPLY,RADFN,RADTI,RACNI) ; Return status information for inserting at top of Requisition
- +1 ; EP called by MAGJRPT
- +2 NEW COMMA,DASH,EXAMID,EXAMIEN,RET,NOTEFILE,NOTEMULT,FILEREF
- +3 SET REPLY="0^0~NOTES: n/a"
- SET EXAMIEN=""
- +4 SET NOTEFILE=23453
- SET NOTEMULT=23453.01
- SET FILEREF=$NAME(^ISI(NOTEFILE))
- +5 SET COMMA=","
- SET DASH="-"
- +6 ; ICR 65
- IF RADFN
- IF RADTI
- IF RACNI
- IF $DATA(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
- Begin DoDot:1
- +7 SET EXAMID=$$EXAMID(RADFN,RADTI,RACNI)
- +8 SET EXAMIEN=$$EXAMIEN(EXAMID)
- End DoDot:1
- +9 IF EXAMIEN
- DO NOTEGET(.REPLY,.RET,EXAMIEN,1,RADFN,RADTI,RACNI)
- +10 QUIT
- +11 ;
- EXAMID(RADFN,RADTI,RACNI) ; calculate examid; printsets share a single examid
- +1 NEW DASH,PSET,RAPRTSET
- SET DASH="-"
- +2 ; ICR 65
- IF RADFN
- IF RADTI
- IF RACNI
- IF $DATA(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
- Begin DoDot:1
- +3 ; get info re rad PrintSet
- DO EN2^RAUTL20(.PSET)
- +4 IF RAPRTSET
- SET RACNI=$ORDER(PSET(""))
- End DoDot:1
- +5 ; for printsets, only racni varies for the members
- QUIT (RADFN_DASH_RADTI_DASH_RACNI)
- +6 ;
- EXAMIEN(EXAMID) ; Return ExamIEN for input examid
- +1 NEW EXAMIEN,ZJ
- +2 SET EXAMIEN=""
- IF EXAMID]""
- Begin DoDot:1
- +3 DO FIND^DIC(NOTEFILE,,"@","OQ",EXAMID,,,,,"ZJ")
- +4 SET EXAMIEN=$SELECT(+ZJ("DILIST",0):ZJ("DILIST",2,1),1:"")
- End DoDot:1
- +5 if $QUIT
- QUIT EXAMIEN
- QUIT
- +6 ;
- NOTEUPD(RET,EXAMIEN,DATA,RADFN,RADTI,RACNI) ; Update Note
- +1 NEW NEWEXAM,NOTIEN,NOTETXT,ZJ,REPLYTXT
- +2 SET RET=""
- SET NEWEXAM=0
- SET NOTETXT=0
- +3 DO CHKTXT(.NOTETXT,.DATA)
- +4 IF 'NOTETXT
- SET RET="4~Missing Notes text data ("_PARAMS_")"
- QUIT
- +5 IF 'EXAMIEN
- Begin DoDot:1
- +6 ; add this exam to Note file
- SET EXAMIEN=$$NEWEXAM(EXAMID,RADFN,RADTI,RACNI)
- +7 IF EXAMIEN
- SET NEWEXAM=1
- +8 IF '$TEST
- SET RET="4~Problem with adding Notes entry for this exam *1 ("_PARAMS_")"
- End DoDot:1
- if 'EXAMIEN
- QUIT
- +9 ; initialize Notes data
- SET NOTIEN=$$NEWNOTE(EXAMIEN,TIMESTMP,DUZ,FLAG)
- +10 IF 'NOTIEN
- SET RET="4~Problem with adding Notes entry for this exam *2 ("_PARAMS_")"
- QUIT
- +11 ; load input data into zj array
- DO ADDNOTES(.ZJ,"ZJ",EXAMIEN,NOTIEN,.NOTETXT)
- +12 ; update Notes if any
- IF $DATA(ZJ)
- Begin DoDot:1
- +13 DO FILE^DIE("","ZJ","RSL")
- +14 SET X=$GET(RSL("DIERR",1))
- +15 IF X]""
- SET RET="4~Problem with adding Notes entry for this exam *3 ("_PARAMS_")"
- End DoDot:1
- +16 IF RET]""
- QUIT
- +17 SET REPLYTXT=$SELECT(NEWEXAM:"Note created for exam.",1:"Note added to exam.")
- +18 SET RET="0~"_REPLYTXT
- +19 QUIT
- +20 ;
- CHKTXT(NOTETXT,DATA) ; check for any notes in input data
- +1 ; NOTETXT: return extracted text, if any
- +2 NEW IP,NOTE
- +3 SET IP=""
- FOR
- SET IP=$ORDER(DATA(IP))
- if IP=""
- QUIT
- SET X=DATA(IP)
- Begin DoDot:1
- +4 IF X="*NOTES"
- SET NOTE=1
- QUIT
- +5 IF NOTE
- Begin DoDot:2
- +6 IF X="*NOTES_END"
- SET NOTE=0
- QUIT
- +7 ; remove blank lines
- SET X=$$STRIP(X)
- if X=""
- QUIT
- +8 SET NOTETXT=NOTETXT+1
- SET NOTETXT(NOTETXT)=X
- End DoDot:2
- End DoDot:1
- +9 QUIT
- +10 ;
- ADDNOTES(RET,RETNAM,EXAMIEN,NOTIEN,NOTETXT) ; format notes text data 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
- +4 SET IENS=NOTIEN_COMMA_EXAMIEN_COMMA
- +5 FOR IP=1:1:NOTETXT
- SET X=NOTETXT(IP)
- Begin DoDot:1
- +6 ; WP call needs this node
- IF IP=1
- SET RET(NOTEMULT,IENS,4)=RETNAM_"("_NOTEMULT_","""_IENS_""""_",4)"
- +7 SET RET(NOTEMULT,IENS,4,IP)=X
- End DoDot:1
- +8 QUIT
- +9 ;
- NEWEXAM(EXAMID,RADFN,RADTI,RACNI) ; Create new Exam entry in Notes file; only called if not yet defined
- +1 NEW DAYCASE,DC1,PSET,RADATA,RAPRTSET,ZJ,ZJMSG,RSL
- +2 SET ZJ(NOTEFILE,"+1,",.01)=EXAMID
- +3 DO UPDATE^DIE("","ZJ","RSL")
- +4 IF +RSL(1)
- DO ACNINDX(+RSL(1),RADFN,RADTI,RACNI)
- +5 if $QUIT
- QUIT RSL(1)
- QUIT
- +6 ;
- ACNINDX(EXAMIEN,RADFN,RADTI,RACNI,KILL) ; update C index by accession number
- +1 ; --> if a printset, index for all pset members
- +2 ; * * This also callable by fileman Index creation * *
- +3 ; KILL--only set by fileman indexer code if deleting entry
- +4 IF '(EXAMIEN&RADFN&RADTI&RACNI)
- QUIT
- +5 NEW DAYCASE,DC1,I,NOTEFILE,FILEREF,PSET,RAPRTSET
- +6 SET NOTEFILE=23453
- SET FILEREF=$NAME(^ISI(NOTEFILE))
- +7 SET DAYCASE=$$DAYCASE(RADFN,RADTI,RACNI)
- +8 if 'DAYCASE
- QUIT
- +9 IF +$GET(KILL)
- KILL @FILEREF@("C",DAYCASE,EXAMIEN)
- +10 IF '$TEST
- SET @FILEREF@("C",DAYCASE,EXAMIEN)=""
- +11 ; get info re rad PrintSet
- DO EN2^RAUTL20(.PSET)
- +12 IF RAPRTSET
- SET I=""
- SET DC1=$PIECE(DAYCASE,"-")
- Begin DoDot:1
- +13 FOR
- SET I=$ORDER(PSET(I))
- if 'I
- QUIT
- SET DAYCASE=DC1_"-"_$PIECE(PSET(I),U)
- Begin DoDot:2
- +14 IF +$GET(KILL)
- KILL @FILEREF@("C",DAYCASE,EXAMIEN)
- +15 IF '$TEST
- SET @FILEREF@("C",DAYCASE,EXAMIEN)=""
- End DoDot:2
- End DoDot:1
- +16 QUIT
- +17 ;
- DAYCASE(RADFN,RADTI,RACNI) ; return daycase
- +1 NEW RADTE,RACN,DAYCASE
- +2 SET DAYCASE=""
- SET RADTE=9999999.9999-RADTI
- +3 SET RACN=$PIECE($GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),U)
- +4 IF RACN
- SET DAYCASE=$EXTRACT(RADTE,4,7)_$EXTRACT(RADTE,2,3)_"-"_RACN
- +5 if $QUIT
- QUIT DAYCASE
- QUIT
- +6 ;
- NEWNOTE(EXAMIEN,TIMESTMP,DUZ,FLAG) ; Create new Note entry in file; only called if not yet defined
- +1 NEW ZJ,ZJMSG,RSL
- +2 SET ZJ(NOTEMULT,"+1,"_EXAMIEN_",",.01)=TIMESTMP
- +3 SET ZJ(NOTEMULT,"+1,"_EXAMIEN_",",2)=DUZ
- +4 SET ZJ(NOTEMULT,"+1,"_EXAMIEN_",",3)=FLAG
- +5 DO UPDATE^DIE("","ZJ","RSL")
- +6 if $QUIT
- QUIT RSL(1)
- QUIT
- +7 ;
- NOTEGET(REPLY,RET,EXAMIEN,STATUS,RADFN,RADTI,RACNI) ; return Notes details
- +1 ; STATUS-optional; if true, return status only, no details
- +2 ; package mult notes into one array, formatted per each note...
- +3 ; filter for flagged RAD-Only notes--only rad personnel may view
- +4 NEW DAYCASE,FLAG,IENS,IRET,ISS
- +5 NEW NOGO,NOTECT,NOTIEN,NOTWHO,NOTTIME,PROC,RADATA,WHO,ZJ
- +6 KILL ^TMP($JOB,"MAGRAEX")
- +7 SET STATUS=$GET(STATUS,0)
- SET NOTECT=0
- +8 SET RADATA=$$RADATA(RADFN,RADTI,RACNI)
- +9 SET DAYCASE=$PIECE(RADATA,U,12)
- SET PROC=$PIECE(RADATA,U,9)
- +10 SET IRET=0
- +11 if 'STATUS
- SET IRET=IRET+1
- SET @RET@(IRET)="NOTES: "_DAYCASE_" "_PROC
- +12 ;
- +13 IF EXAMIEN
- Begin DoDot:1
- +14 if 'STATUS
- SET IRET=IRET+1
- SET @RET@(IRET)="*NOTES"
- +15 SET NOTIEN=0
- +16 FOR
- SET NOTIEN=$ORDER(@FILEREF@(EXAMIEN,1,NOTIEN))
- if 'NOTIEN
- QUIT
- Begin DoDot:2
- +17 SET IENS=NOTIEN_COMMA_EXAMIEN_COMMA
- +18 DO GETS^DIQ(NOTEMULT,IENS,"2;3","IE","ZJ")
- +19 SET FLAG=$GET(ZJ(NOTEMULT,IENS,3,"I"))
- +20 ; indicate or show flagged note only if Rad dept user
- IF FLAG=1
- SET NOGO=1
- Begin DoDot:3
- +21 ; OK if rist or tech
- IF +$GET(MAGJOB("USER",1))!$DATA(^VA(200,"ARC","T",+DUZ))
- SET NOGO=0
- QUIT
- End DoDot:3
- if NOGO
- QUIT
- +22 ; no details needed
- IF STATUS
- SET NOTECT=NOTECT+1
- QUIT
- +23 DO GETS^DIQ(NOTEMULT,IENS,".01;4","","ZJ")
- +24 SET NOTWHO=$GET(ZJ(NOTEMULT,IENS,2,"E"))
- +25 SET NOTTIME=$GET(ZJ(NOTEMULT,IENS,.01))
- +26 SET IRET=IRET+1
- SET @RET@(IRET)=" "_NOTTIME_" "_NOTWHO
- +27 ; flagged notes clearly indicated to user
- IF FLAG
- SET IRET=IRET+1
- SET @RET@(IRET)=" << Radiology internal note >>"
- +28 IF $DATA(ZJ(NOTEMULT,IENS,4))>9
- Begin DoDot:3
- +29 SET ISS=0
- +30 FOR
- SET ISS=$ORDER(ZJ(NOTEMULT,IENS,4,ISS))
- if 'ISS
- QUIT
- SET IRET=IRET+1
- SET @RET@(IRET)=ZJ(NOTEMULT,IENS,4,ISS)
- End DoDot:3
- +31 SET IRET=IRET+1
- SET @RET@(IRET)=" "
- End DoDot:2
- +32 ;special format for Status only
- IF STATUS
- SET REPLY="0^"_NOTECT_"~NOTES: "_$SELECT('NOTECT:"n/a",1:NOTECT_" note"_$SELECT(NOTECT-1:"s",1:"")_" on file.")
- +33 IF '$TEST
- SET %H=$HOROLOG
- DO YX^%DTC
- SET IRET=IRET+1
- SET @RET@(IRET)="** END NOTES "_Y_" **"
- +34 if 'STATUS
- SET IRET=IRET+1
- SET @RET@(IRET)="*NOTES_END"
- End DoDot:1
- +35 ; Q ;
- IF '$TEST
- SET REPLY="2~ [ Notes not entered for this exam. ]"
- SET @RET@(0)=1
- +36 IF IRET=4
- Begin DoDot:1
- +37 FOR I=2,3,4
- KILL @RET@(I)
- +38 ; everything filtered out
- SET @RET@(0)=1
- SET REPLY="2~ [Notes not available for this exam. ]"
- End DoDot:1
- +39 IF '$TEST
- if 'STATUS
- SET @RET@(0)=IRET
- +40 QUIT
- +41 ;
- RADATA(RADFN,RADTI,RACNI) ; get rad data
- +1 NEW RADATA
- +2 DO GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,"",.X)
- +3 SET RADATA=$GET(^TMP($JOB,"MAGRAEX",1,1))
- +4 KILL ^TMP($JOB,"MAGRAEX")
- +5 if $QUIT
- QUIT RADATA
- 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 ;