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 Apr 09, 2024@21:46:42 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 ;
