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

ISIJNOTE.m

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