TIUDTBPN ;AITC/CR/SGM - BOOKMARK TIU NOTE AFTER DOWNTIME ;8/20/18 3:59pm
;;1.0;TEXT INTEGRATION UTILITIES;**305**;JUN 20, 1997;Build 27
;
; Last Edited: 09/22/2017 09:46 / Leidos/sgm
;*****************************************************************
; CHANGE LOG
; DATE PATCH DESCRIPTION
;-------- ---------- -----------------------------------------
;09/2017 ICR documentatation in ^TIUDTBP0
; Description of format of @GLT in ^TIUDTBP0
;09/18/17 305 Class III code remediated to class I
;
;---------------------------------------------------------------------
; Option: TIU DOWNTIME BOOKMARK PN
;---------------------------------------------------------------------
START ;
N X,Y,TEXT,TIUD
D ENOUT
D TEXT("T1",1,0,1,5,"-") ; display opening header
Q:'$$ESIGCK ; must have valid esig
Q:'$$DIC(1) ; TIUD("TITLE") = ien, TIU("TITLE",0)=name
Q:'$$DIR(1) ; TIUD("SCH") = (S/U) / sched vs unsched
Q:'$$DIR(2) ; TIUD("TIMS") = fm_dt / downtime start
Q:'$$DIR(3) ; TIUD("TIME") = fm_dt / downtime end
I TIUD("TIMS")=TIUD("TIME") D Q
. W $C(7),!!,"Can't have the same start and end date/time."
Q:'$$DIR(6) ; TIUD("TYPE") = E/A |type of sig (E/A)
Q:'$$DIC(2) ; TIUD("SIGN") = ien,TIUD("SIGN",0)=name/signer
Q:'$$DIR(4) ; TIUD("NOTEDT") = date/time of note
Q:'$$DIR(5) ; TIUD("CLSEL") = 0:No, 1:Some, 2:All
Q:'$$DIC(3) ; TIUD("CLSEL",ien) = name
Q:'$$DIC(4) ; TIUD("MAIL",duz) = name
Q:$$DIVISION<0 ; TIUD("DIV")= 0:if multiple divisions selected
; TIUD("DIV",ien)=name
; 1:if there is only one division
; 2:all divisions
Q:$$CREATE<1 ; Build the text of the note
; Only need full note TEXT at this point
K X M X=TEXT(3) K TEXT M TEXT=X
; Ask queue/run report now, Y may be <0
S Y=$$DIR(9) I Y>-1 D QUEUE:Y,EN:'Y
Q
;
;===============================================
; Taskman Reentry
;-----------------------------------------------
EN ;
N I,X,Y,GLT,HDR,TRM,TIUST
D ENOUT
S X=$$FMADD^XLFDT(DT,7)_U_DT
S GLT=$NA(^TMP("TIUDTBPN",$J)) S @GLT=X
M @GLT@("VAR")=TIUD
S TRM=($E(IOST)="C")
D TEXT("T16",0,0,0,0,,.HDR) ; header for screen display
D TEXT("T17",0,0,0,0,,.TIUST) ; getting patients message
; get all current inpatients whose admit<downtime_endtime
; use admit movement xref as possible to admit without a ward
W:TRM !!,TIUST(1),! D GETINP
W:TRM !!,TIUST(2),! D GETINPD
S X=+TIUD("CLSEL"),Y=+$O(TIUD("CLSEL",0))
I X,$S(X=2:1,1:Y) W:TRM !!,TIUST(3),! D GETOUT
S TIUD("MAILz")=$$MAIL
I $D(ZTQUEUED) S ZTREQ="@" I +$G(ERRON) D SAVE^TIUDTBP0
Q:$G(NOKILL)
;
ENOUT K ^TMP("TIUDTBPN",$J) Q
;
;===============================================
; Create the Default Text of the Note
;-----------------------------------------------
CREATE() ;
; Create the text of the downtime note
; Use text stored in 8925.1 BOILERPLATE TEXT field
; If no text there, move canned text into that field
; TEXT(1,i,0) contains the header, uneditable portion
; TEXT(2,i,0) contains the body, editable portion
; Text(3,i,0) contains the entire text of the note
; TEXT(4,i,0) contains the body, canned text
;
N I,J,X,Y,Z,GLN,LN,TMP,TIUDA
K TEXT
S TIUDA=+TIUD("TITLE")
S GLN=$NA(^TIU(8925.1,TIUDA,"DFLT"))
W @IOF
D CRE1,CRE2,CRE9
S Y=$$CRE3 I Y<0 Q Y
D CRE4
S TIUD("NOW")=$$NOW^XLFDT
S TIUD("AUTH")=TIUD("SIGN")
S TIUD("ESBY")=$S(TIUD("AUTH")=DUZ:DUZ,1:"")
I TIUD("TYPE")="E" D TEXT("T10",1)
I TIUD("TYPE")="A" D TEXT("T11",1)
I '$$CRE5 Q 0
Q 1
;
CRE1 ; get header, uneditable
N I,X,Z,TMP
D TEXT("T61",0,0,0,0,"-",.TMP)
F I=1:1 Q:'$D(TMP(I)) S TEXT(1,I,0)=TMP(I)
; place computed values in header
F I=1:1 Q:'$D(TEXT(1,I)) S X=TEXT(1,I,0) D
. S Z="|ST|" I X[Z S X=$P(X,Z)_TIUD("TIMS",0)_$P(X,Z,2)
. S Z="|END|" I X[Z S X=$P(X,Z)_TIUD("TIME",0)_$P(X,Z,2)
. S Z="|SU|" I X[Z S X=$P(X,Z)_TIUD("SCH",0)_$P(X,Z,2)
. S Z="|DUR|" I X[Z S X=$P(X,Z)_$$CRE12()_$P(X,Z,2)
. S TEXT(1,I,0)=X
. Q
Q
;
CRE12() ;
N X,Y,DAY,ED,HR,MIN,SEC,ST
S ST=TIUD("TIMS"),ED=TIUD("TIME")
I '(ST&ED) Q ""
S X=$$FMDIFF^XLFDT(ED,ST,3) ; d hh:mm:ss
S DAY=+$P(X," ") S X=$P(X," ",2)
S HR=+$P(X,":"),MIN=+$P(X,":",2),SEC=+$P(X,":",3)
I SEC>29 S MIN=MIN+1
I MIN>59 S HR=HR+(MIN\60),MIN=(MIN#60)
I HR>23 S DAY=DAY+(HR\24),HR=(HR#24)
S Y="" I DAY S Y=DAY_" day"_$S(DAY=1:"",1:"s") S:DAY>0 Y=Y_" "
I HR S Y=Y_HR_" hour"_$S(HR=1:"",1:"s") S:MIN>0 Y=Y_" and "
I MIN S Y=Y_MIN_" minute"_$S(MIN=1:"",1:"s")
I $E(Y,$L(Y))=" " S Y=$E(Y,1,$L(Y)-1)
Q Y
;
CRE2 ; get body, editable
N I,TMP
D TEXT("T62",0,0,0,0,,.TMP)
F I=1:1 Q:'$D(TMP(I)) S TEXT(4,I,0)=TMP(I)
S TEXT(4,0)=U_U_(I-1)_U_(I-1)_U_DT_U_U
M TEXT(2)=TEXT(4) I '$O(@GLN@(0)) M @GLN=TEXT(2)
Q
;
; allow user to edit the text of the note
CRE3() ;
N X,Y,DIC,DIWESUB
CRE31 ;
S Y=$$DIR(7) I Y<1 Q Y
S DIC=$TR(GLN,")",","),DIWESUB="Progress Note Text"
D EN^DIWE,CRE9
S Y=$$DIR(8) I Y=1 G CRE31
Q Y
;
CRE4 ;
; display if administrative closure
I TIUD("TYPE")="A" D
. D TEXT("T8",1,,,0)
. W !,"Administrative Closure: "_$$FMTE^XLFDT(DT,"2D")
. W !,?20,"By: "_$$GET1(200,DUZ,20.2)
. W !,?24,$$GET1(200,DUZ,20.3)
. Q
; display if electronic signature
I TIUD("TYPE")'="A",TIUD("SIGN")=DUZ D
. D TEXT("T9",1,,,0) S X=$$ESBLOCK^XUSESIG1(DUZ)
. W !,?35,"/es/ "_$P(X,U)
. W !,?40,$P(X,U,3)
. Q
W !!
Q
;
CRE5() ; ask for user's electronic signature
N X,Y,X1,X2
D TEXT("T13",1,1,,0),SIG^XUSESIG
Q $L(X1)>0
;
CRE9 ;
; rebuild TEXT(2) and TEXT(3)
; GLN=$NA(^TIU(8925.1,TIUDA,"DFLT"))
N I,J,LN
I '$O(@GLN@(0)),'$O(TEXT(4,0)) Q
I '$O(@GLN@(0)) K @GLN M @GLN=TEXT(4)
K TEXT(2),TEXT(3) S LN=0 M TEXT(2)=@GLN
F J=1,2 F I=1:1 Q:'$D(TEXT(J,I)) S LN=LN+1,TEXT(3,LN,0)=TEXT(J,I,0)
I LN>0 S TEXT(3,0)=U_U_LN_U_LN_U_DT_U_U
Q
;
;===============================================
; Search for Patients
;-----------------------------------------------
; programmer notes at end of TIUDTBP0 routine for these modules
;
TOTADD(P) S $P(TOTAL,U,P)=1+$P(TOTAL,U,P) Q
;
GETINP ;
N Z,STOP,TIUDSP,TMP,TOTAL,TYP
S TYP=1,TOTAL=0 M TIUDSP=HDR
; sort current inpatients by ward, then name
S TMP=$NA(^DPT("ACA"))
F S TMP=$Q(@TMP) Q:$QS(TMP,1)'="ACA" D
. N X,Y,DFN,PNM,WARD
. S DFN=$QS(TMP,3) S X=$$CK2(DFN) Q:'X S PNM=$P(X,U,2)
. S WARD=$G(^DPT(DFN,.1)) S X=$$CK42(WARD) Q:'X S WARD=$P(X,U,2)
. S @GLT@("SORT",TYP,WARD,PNM,DFN)=""
. Q
S TMP=$NA(@GLT@("SORT",TYP)),STOP=$TR(TMP,")",",")
F S TMP=$Q(@TMP) Q:TMP'[STOP D
. N DATE,DFN,PNM,WARD
. S WARD=$QS(TMP,5),PNM=$QS(TMP,6),DFN=$QS(TMP,7)
. S DATE=$E($$NOW^XLFDT,1,12)
. D INPCOM(DFN,DATE)
. Q
D DSP(,,,1)
Q
;
GETINPD ;
N X,Y,STOP,TIUDSP,TIUNOW,TMP,TOTAL,TYP
S TYP=2,TOTAL=0 M TIUDSP=HDR
S X=TIUD("TIME")-.000001
S TMP=$NA(^DGPM("AMV3",X,"~~~"))
S TIUNOW=$$NOW^XLFDT
; sort discharged patients by patient name
S STOP=0 F S TMP=$Q(@TMP) D Q:STOP
. N X,Y,DFN,DATE,PNM
. I $QS(TMP,1)'="AMV3" S STOP=1 Q
. S DATE=$QS(TMP,2)
. S DFN=$QS(TMP,3) S X=$$CK2(DFN) Q:'X S PNM=$P(X,U,2)
. S @GLT@("SORT",TYP,PNM,DFN,DATE)=""
. Q
S TMP=$NA(@GLT@("SORT",TYP)),STOP=$TR(TMP,")",",")
F S TMP=$Q(@TMP) Q:TMP'[STOP D
. N DATE,DFN,PNM
. S PNM=$QS(TMP,5),DFN=$QS(TMP,6),DATE=$QS(TMP,7)
. I DATE>TIUNOW S STOP=1 Q
. D INPCOM(DFN,DATE)
. Q
D DSP(,,,1)
Q
;
INPCOM(DFN,DATE) ;
N I,X,Y,Z,DIV,HL,PNM,STAT,STATX,VAERR,VAIP,WARD,WNM
Q:$G(DFN)<1 Q:$G(DATE)<1
S X=$$CK2(DFN) S PNM=$P(X,U,2)
S Y=TIUD("TIME") I +$G(DATE),DATE<TIUD("TIME") S Y=DATE
S VAIP("D")=Y,VAIP("M")=1
D IN5^VADPT S:+$G(VAERR) VAIP(1)="" I 'VAIP(1) Q
S WARD=+VAIP(5),WNM=$P(VAIP(5),U,2)
S X=$$CK42(WARD),DIV=$P(X,U,3),HL=$P(X,U,4)
S X=0 S:+HL X=$$CK44(HL) I 'HL!'X D TOTADD(2) Q ; no hospital loc
I 'TIUD("DIV") Q:'DIV Q:'$D(TIUD("DIV",DIV))
S STAT=$$NEWNOTE(HL) ; create the patient's downtime note
S STATX=$$STATUS(STAT)
D TOTADD(1+(STATX<1))
D DSP(PNM,WNM,STATX)
D TIUTX(STATX,DFN,PNM,WNM)
S ^TMP("TIUDTBPN",$J,"DUPECHK",DFN)="" ;track inpatients with outpatient appts
Q
;
GETOUT ;
N X,DFN,STOP,TIUDSP,TMP,TOTAL,TYP
S TYP=3,TOTAL=0 M TIUDSP=HDR
S X=TIUD("CLSEL") Q:'X I X=1,'$O(TIUD("CLSEL",0)) Q
S TMP=$NA(^TMP($J,"SDAMA301")) K @TMP S STOP=$TR(TMP,")",",")
;
N I,Y,TIUIN
S TIUIN(1)=TIUD("TIMS")_";"_TIUD("TIME")
I $O(TIUD("CLSEL",0)) S TIUIN(2)="TIUD(""CLSEL"","
S TIUIN(3)="R;I;NT"
S TIUIN("SORT")="P"
S TIUIN("FLDS")="1;2;3;4"
S X=$$SDAPI^SDAMA301(.TIUIN)
;I $G(ERRON) W !!!,"SDAMA301 return value: "_X,!!!
I X<1 D DSP(,,,1) K @TMP Q ;print zero count when applicable
; just get the last appt
S DFN=0 F S DFN=$O(@TMP@(DFN)) Q:'DFN D
. N DATE,HL,HLN,PNM
. S DATE=$O(@TMP@(DFN," "),-1)
. S X=@TMP@(DFN,DATE)
. S Y=$P(X,U,2),HL=+Y,HLN=$P(Y,";",2)
. S Y=$P(X,U,4),DFN=+Y,PNM=$P(Y,";",2)
. S @GLT@("SORT",TYP,PNM,DFN,DATE)=HL_U_HLN
. Q
S TMP=$NA(@GLT@("SORT",TYP)),STOP=$TR(TMP,")",",")
F S TMP=$Q(@TMP) Q:TMP'[STOP S X=@TMP D
. N DATE,DFN,HL,HLN,PNM,STAT,STATX
. S PNM=$QS(TMP,5),DFN=$QS(TMP,6),DATE=$QS(TMP,7)
. S HL=$P(X,U),HLN=$P(X,U,2)
. ; don't file outpatient note if patient already had an inpatient note
. S STAT=-1 I +HL I '$D(^TMP("TIUDTBPN",$J,"DUPECHK",DFN)) S STAT=$$NEWNOTE(HL)
. S STATX=$$STATUS(STAT)
. D TOTADD(1+(STATX<1))
. D DSP(PNM,HLN,STATX)
. D TIUTX(STATX,DFN,PNM,HLN)
. Q
D DSP(,,,1)
Q
;
;===============================================
; Miscellaneous
;-----------------------------------------------
CK2(DFN) ;
; return -1 or dfn^name
N I,X,Y,NM
S DFN=$G(DFN) I (DFN'=+DFN)!(DFN<1) Q 0
S X=$G(@GLT@("F",2,DFN)) I $L(X) Q X
S NM=$P($G(^DPT(DFN,0)),U) I NM="" Q 0
S X=DFN_U_NM
S @GLT@("F",2,DFN)=X
Q X
;
CK42(VAL) ;
; return -1 file_42_ien ^ 42_name ^ division_ien ^ hosp_loc_ien
; find1 call assures one and only one entry matching name
N I,X,Y,DIV,HL,NM
I 0[VAL Q 0
S X=$G(@GLT@("F",42,VAL)) I $L(X) Q X
I VAL=+VAL,VAL<1 Q 0
I VAL'=+VAL S VAL=+$$FIND1(42,,,VAL) Q:VAL<1 0
S IEN=VAL_","
S NM=$$GET1(42,IEN,.01)
S DIV=$$GET1(42,IEN,.015,"I")
S HL=$$GET1(42,IEN,44,"I")
S X=VAL_U_NM_U_DIV_U_HL
S @GLT@("F",42,VAL)=X
S @GLT@("F",42,NM)=X
Q X
;
CK44(IEN) ;
; return -1 or file_44_ien ^ 44_name ^ division
N I,X,Y,DIV,IENS,NM
I (IEN'=+IEN)!(IEN<1) Q 0
S X=$G(@GLT@("F",44,IEN)) I $L(X) Q X
S IENS=IEN_","
S NM=$$GET1(44,IENS,.01) I NM="" Q 0
S DIV=$$GET1(44,IENS,3.5,"I")
S X=IEN_U_NM_U_DIV
S @GLT@("F",44,IEN)=X
Q X
;
DIC(CH) Q $$DIC^TIUDTBP0(CH)
;
DIR(CH) Q $$DIR^TIUDTBP0(CH)
;
DIVISION() Q $$DIVISION^TIUDTBP0
;
DSP(PNM,LNM,STATX,END) ; screen display
; update screen 20 lines at a time
N I,L,X,Y
S PNM=$G(PNM),LNM=$G(LNM),STATX=$G(STATX),END=+$G(END)
I END D
. N FAIL S FAIL=+$P(TOTAL,U,2)
. S X="Notes created: "_(+TOTAL)
. S:FAIL X=X_" Notes failed to be created: "_FAIL
. S I=1+$O(TIUDSP("A"),-1),TIUDSP(I)="",TIUDSP(I+1)=X
. S L=20
. Q
I 'END D
. S X=$$DSPFMT(PNM,LNM,STATX)
. S L=1+$O(TIUDSP("A"),-1) S TIUDSP(L)=X
. Q
I L>19 D
. S L=+$O(@GLT@("DSP",TYP,"A"),-1)
. F I=1:1 Q:'$D(TIUDSP(I)) S X=TIUDSP(I) D
. . W:TRM !,X S L=L+1,@GLT@("DSP",TYP,L)=X
. . Q
. K TIUDSP
. Q
Q
;
DSPFMT(PNM,LNM,STATX) ; format display line
N X,SP,TIUDA
S $P(SP," ",41)=""
S PNM=$G(PNM) S:PNM="" PNM="NoName"
S LNM=$G(LNM) S:LNM="" LNM="NoLocation"
S STATX=$G(STATX)
S TIUDA=$P(STATX,";",2)
I +STATX=1 S X=" Yes | "
I +STATX=2 S X="Unsign | "
I +STATX=0 S X=" No | "
I +STATX=-1 S X=" Error | "
S X=X_$E(LNM_SP,1,25)_" | "_PNM
I +$G(ERRON),TIUDA>0 S X=X_" ["_TIUDA_"]"
Q X
;
ESIGCK() ;
N X,Y S Y=$$GET1(200,DUZ,20.4,"I") I Y="" D TEXT("T12",1,12)
Q Y'=""
;
FIND1(FILE,IEN,FLG,VAL,IDX,SCR) ;
Q $$FIND1^TIUDTBP0(.FILE,.IEN,.FLG,.VAL,.IDX,.SCR)
;
GET1(FILE,IEN,FLD,FLG) ;
Q $$GET1^TIUDTBP0(.FILE,.IEN,.FLD,.FLG)
;
MAIL() ;
N I,X,Y,Z,CNT,GLE,GLX,LIN,NEWFORM,STOP,TIU,TMP
N XMDUZ,XMSUB,XMTEXT,XMY
S NEWFORM=+$G(EFORM)
S GLE=$NA(^TMP("XMERR",$J)) K @GLE
S XMDUZ=DUZ
S XMSUB="Record of Progress Notes for VistA Downtime"
S GLX=$NA(@GLT@("SEND")),XMTEXT=$TR(GLX,")",",")
M XMY=TIUD("MAIL")
I NEWFORM D
. D TEXT("T16",0,0,0,0,,.TIU)
. F I=1:1 Q:'$D(TIU(I)) S @GLX@(I,0)=TIU(I)
. S L=I-1
. Q
I 'NEWFORM D
. S @GLX@(1,0)="PATIENT NAME^WARD LOCATION^STATUS OF NOTE INSERTION"
. S @GLX@(2,0)=" "
. S L=2
. Q
S CNT=0
S TMP=$NA(@GLT@("MSG")),STOP=$TR(TMP,")",",")
F S TMP=$Q(@TMP) Q:TMP'[STOP D
. N X,DFN,HLN,PNM,STATX
. S PNM=$QS(TMP,4),DFN=$QS(TMP,5),HLN=$QS(TMP,6)
. S STATX=@TMP
. S X=PNM_U_HLN_U_$P(STATX,";",3)
. I NEWFORM S X=$$DSPFMT(PNM,HLN,STATX)
. S CNT=CNT+1,L=L+1,@GLX@(L,0)=X
. Q
I TRM,'CNT W !!,"No patients found who had downtime note created.",!
N TMAIL S TMAIL=$S('CNT:0,1:-1)
I CNT D
. N XMERR,XMMG,XMSTRIP,XMYBLOG,XMZ
. S @GLX@(0)=U_U_CNT_U_CNT_U_DT_U_U
. D ^XMD I TRM D
. . W ! S Y=$L($G(XMMG))
. . W:'Y !,"Email notification sent in message number "_XMZ_"."
. . W:Y !!,"ERROR: mail message not created",!?5,XMMG,!
. . Q
. S TMAIL=$G(XMZ)_"^Error: "_$G(XMMG)
. Q
K @GLE
Q TMAIL
;
NEWNOTE(LOC) ;
; Create New TIU Note
; loc = file 44 ien / expects DFN to be defined
; FINDPAT should have set up @GLT@() for all LOCs
; Extrinsic return value: -1 ; -1^-1 ; TIUDA ; TIUDA^-1
; Any place where STAT is referenced it will be this value
N I,X,Y,GL,LOCNM,STAT,TIUADM
N AUTH,ESBY,TITLE,TIUDT,TYPE
M X=TEXT N TEXT
S GL=$NA(^TMP("TIUP",$J)) K @GL M @GL=X
F X="AUTH","ESBY","TITLE","TYPE" S @X=TIUD(X)
S TIUDT=TIUD("NOTEDT")
I +$G(LOC) D
. S LOCNM=$P($$CK44(LOC),U,2)
. S I=1+$O(@GL@("A"),-1),@GL@(I,0)=" "
. S X="Patient location at the conclusion of the downtime: "_LOCNM
. S I=I+1,@GL@(I,0)=X
. S $P(@GL@(0),U,3,4)=I_U_I
. Q
; TIUPNAPI is expecting note to be in ^TMP("TIUP",$J,n,0)
I TYPE="E" D NEW^TIUPNAPI(.STAT,DFN,AUTH,TIUDT,TITLE,LOC,0,0,ESBY)
I TYPE="A" D NEW^TIUPNAPI(.STAT,DFN,AUTH,TIUDT,TITLE,LOC)
S X=STAT,$P(X,U,3)=ESBY
I STAT>0,TYPE="A" D ADMNCLOS^TIUSRVPT(.TIUADM,+STAT,"M")
K @GL
Q STAT
;
QUEUE ;
N X,Y,DESC,OTH,RTN,VAR,ZTSK
S RTN="EN^TIUDTBPN"
S DESC="TIU Contingency Downtime Bookmark Progress Notes"
S VAR="TIUD(;TEXT("
S:$D(EFORM) VAR=VAR_";EFORM" S:$D(ERRON) VAR=VAR_";ERRON"
S OTH("ZTDTH")=$H
S ZTSK=$$NODEV^XUTMDEVQ(RTN,DESC,VAR,.OTH,1)
Q
;
STATUS(TIUDA) ;
; TIUDA can be ien, -1, ien^-1, -1^-1
; Return: -1/0/1/2 ; note_ien or -1 ; format text
N Y,TIUDA,TXT
S STAT=$G(STAT),TIUDA=+STAT
I STAT'["-1" S TXT="Successful",Y=1
I '$D(TXT),TIUDA=-1 S TXT="Unsuccessful",Y=0
I '$D(TXT),TIUDA>0,STAT["-1" S TXT="Successful/unsigned",Y=2
I '$D(TXT) S TXT="Error",Y=-1
S:$G(ERRON) TXT=TXT_" ["_STAT_"]"
Q Y_";"_TIUDA_";"_TXT
;
TEXT(TAG,WR,LF,CLR,PAD,CHR,TIUR) ; Generic Text Handler
; TAG - line label containing the text
; all groups of text should end with ' ;;---'
; WR - Boolean, write or do not write
; LF - 0:no extra line feeds; 1:leading line feed; 2:trailing feed
; CLR - Boolean, clear screen first
; PAD - number of spaces begin each line with
; If PAD="" then default to 3. If PAD=0 then no padding
; CHR - for center justify, character to pad line, default is space
S TAG=$G(TAG),WR=+$G(WR),LF=+$G(LF),CLR=+$G(CLR)
S CHR=$G(CHR) S:CHR="" CHR=" "
S PAD=$G(PAD) I PAD'?1.N S PAD=3
D TEXT^TIUDTBP0(TAG,WR,LF,CLR,PAD,CHR,.TIUR)
Q
;
TIUTX(STATX,DFN,PNM,LNM) ; text for mail message
; statx = -1/0/1/2 ; note_ien or -1 ; format text
N I,X
Q:'$G(DFN) Q:'$L($G(PNM)) Q:'$L($G(LNM))
S I=1+$O(@GLT@("MSG",PNM,DFN,LNM,"A"),-1)
S @GLT@("MSG",PNM,DFN,LNM,I)=$G(STATX)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUDTBPN 16179 printed Apr 09, 2024@21:49:11 Page 2
TIUDTBPN ;AITC/CR/SGM - BOOKMARK TIU NOTE AFTER DOWNTIME ;8/20/18 3:59pm
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**305**;JUN 20, 1997;Build 27
+2 ;
+3 ; Last Edited: 09/22/2017 09:46 / Leidos/sgm
+4 ;*****************************************************************
+5 ; CHANGE LOG
+6 ; DATE PATCH DESCRIPTION
+7 ;-------- ---------- -----------------------------------------
+8 ;09/2017 ICR documentatation in ^TIUDTBP0
+9 ; Description of format of @GLT in ^TIUDTBP0
+10 ;09/18/17 305 Class III code remediated to class I
+11 ;
+12 ;---------------------------------------------------------------------
+13 ; Option: TIU DOWNTIME BOOKMARK PN
+14 ;---------------------------------------------------------------------
START ;
+1 NEW X,Y,TEXT,TIUD
+2 DO ENOUT
+3 ; display opening header
DO TEXT("T1",1,0,1,5,"-")
+4 ; must have valid esig
if '$$ESIGCK
QUIT
+5 ; TIUD("TITLE") = ien, TIU("TITLE",0)=name
if '$$DIC(1)
QUIT
+6 ; TIUD("SCH") = (S/U) / sched vs unsched
if '$$DIR(1)
QUIT
+7 ; TIUD("TIMS") = fm_dt / downtime start
if '$$DIR(2)
QUIT
+8 ; TIUD("TIME") = fm_dt / downtime end
if '$$DIR(3)
QUIT
+9 IF TIUD("TIMS")=TIUD("TIME")
Begin DoDot:1
+10 WRITE $CHAR(7),!!,"Can't have the same start and end date/time."
End DoDot:1
QUIT
+11 ; TIUD("TYPE") = E/A |type of sig (E/A)
if '$$DIR(6)
QUIT
+12 ; TIUD("SIGN") = ien,TIUD("SIGN",0)=name/signer
if '$$DIC(2)
QUIT
+13 ; TIUD("NOTEDT") = date/time of note
if '$$DIR(4)
QUIT
+14 ; TIUD("CLSEL") = 0:No, 1:Some, 2:All
if '$$DIR(5)
QUIT
+15 ; TIUD("CLSEL",ien) = name
if '$$DIC(3)
QUIT
+16 ; TIUD("MAIL",duz) = name
if '$$DIC(4)
QUIT
+17 ; TIUD("DIV")= 0:if multiple divisions selected
if $$DIVISION<0
QUIT
+18 ; TIUD("DIV",ien)=name
+19 ; 1:if there is only one division
+20 ; 2:all divisions
+21 ; Build the text of the note
if $$CREATE<1
QUIT
+22 ; Only need full note TEXT at this point
+23 KILL X
MERGE X=TEXT(3)
KILL TEXT
MERGE TEXT=X
+24 ; Ask queue/run report now, Y may be <0
+25 SET Y=$$DIR(9)
IF Y>-1
if Y
DO QUEUE
if 'Y
DO EN
+26 QUIT
+27 ;
+28 ;===============================================
+29 ; Taskman Reentry
+30 ;-----------------------------------------------
EN ;
+1 NEW I,X,Y,GLT,HDR,TRM,TIUST
+2 DO ENOUT
+3 SET X=$$FMADD^XLFDT(DT,7)_U_DT
+4 SET GLT=$NAME(^TMP("TIUDTBPN",$JOB))
SET @GLT=X
+5 MERGE @GLT@("VAR")=TIUD
+6 SET TRM=($EXTRACT(IOST)="C")
+7 ; header for screen display
DO TEXT("T16",0,0,0,0,,.HDR)
+8 ; getting patients message
DO TEXT("T17",0,0,0,0,,.TIUST)
+9 ; get all current inpatients whose admit<downtime_endtime
+10 ; use admit movement xref as possible to admit without a ward
+11 if TRM
WRITE !!,TIUST(1),!
DO GETINP
+12 if TRM
WRITE !!,TIUST(2),!
DO GETINPD
+13 SET X=+TIUD("CLSEL")
SET Y=+$ORDER(TIUD("CLSEL",0))
+14 IF X
IF $SELECT(X=2:1,1:Y)
if TRM
WRITE !!,TIUST(3),!
DO GETOUT
+15 SET TIUD("MAILz")=$$MAIL
+16 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
IF +$GET(ERRON)
DO SAVE^TIUDTBP0
+17 if $GET(NOKILL)
QUIT
+18 ;
ENOUT KILL ^TMP("TIUDTBPN",$JOB)
QUIT
+1 ;
+2 ;===============================================
+3 ; Create the Default Text of the Note
+4 ;-----------------------------------------------
CREATE() ;
+1 ; Create the text of the downtime note
+2 ; Use text stored in 8925.1 BOILERPLATE TEXT field
+3 ; If no text there, move canned text into that field
+4 ; TEXT(1,i,0) contains the header, uneditable portion
+5 ; TEXT(2,i,0) contains the body, editable portion
+6 ; Text(3,i,0) contains the entire text of the note
+7 ; TEXT(4,i,0) contains the body, canned text
+8 ;
+9 NEW I,J,X,Y,Z,GLN,LN,TMP,TIUDA
+10 KILL TEXT
+11 SET TIUDA=+TIUD("TITLE")
+12 SET GLN=$NAME(^TIU(8925.1,TIUDA,"DFLT"))
+13 WRITE @IOF
+14 DO CRE1
DO CRE2
DO CRE9
+15 SET Y=$$CRE3
IF Y<0
QUIT Y
+16 DO CRE4
+17 SET TIUD("NOW")=$$NOW^XLFDT
+18 SET TIUD("AUTH")=TIUD("SIGN")
+19 SET TIUD("ESBY")=$SELECT(TIUD("AUTH")=DUZ:DUZ,1:"")
+20 IF TIUD("TYPE")="E"
DO TEXT("T10",1)
+21 IF TIUD("TYPE")="A"
DO TEXT("T11",1)
+22 IF '$$CRE5
QUIT 0
+23 QUIT 1
+24 ;
CRE1 ; get header, uneditable
+1 NEW I,X,Z,TMP
+2 DO TEXT("T61",0,0,0,0,"-",.TMP)
+3 FOR I=1:1
if '$DATA(TMP(I))
QUIT
SET TEXT(1,I,0)=TMP(I)
+4 ; place computed values in header
+5 FOR I=1:1
if '$DATA(TEXT(1,I))
QUIT
SET X=TEXT(1,I,0)
Begin DoDot:1
+6 SET Z="|ST|"
IF X[Z
SET X=$PIECE(X,Z)_TIUD("TIMS",0)_$PIECE(X,Z,2)
+7 SET Z="|END|"
IF X[Z
SET X=$PIECE(X,Z)_TIUD("TIME",0)_$PIECE(X,Z,2)
+8 SET Z="|SU|"
IF X[Z
SET X=$PIECE(X,Z)_TIUD("SCH",0)_$PIECE(X,Z,2)
+9 SET Z="|DUR|"
IF X[Z
SET X=$PIECE(X,Z)_$$CRE12()_$PIECE(X,Z,2)
+10 SET TEXT(1,I,0)=X
+11 QUIT
End DoDot:1
+12 QUIT
+13 ;
CRE12() ;
+1 NEW X,Y,DAY,ED,HR,MIN,SEC,ST
+2 SET ST=TIUD("TIMS")
SET ED=TIUD("TIME")
+3 IF '(ST&ED)
QUIT ""
+4 ; d hh:mm:ss
SET X=$$FMDIFF^XLFDT(ED,ST,3)
+5 SET DAY=+$PIECE(X," ")
SET X=$PIECE(X," ",2)
+6 SET HR=+$PIECE(X,":")
SET MIN=+$PIECE(X,":",2)
SET SEC=+$PIECE(X,":",3)
+7 IF SEC>29
SET MIN=MIN+1
+8 IF MIN>59
SET HR=HR+(MIN\60)
SET MIN=(MIN#60)
+9 IF HR>23
SET DAY=DAY+(HR\24)
SET HR=(HR#24)
+10 SET Y=""
IF DAY
SET Y=DAY_" day"_$SELECT(DAY=1:"",1:"s")
if DAY>0
SET Y=Y_" "
+11 IF HR
SET Y=Y_HR_" hour"_$SELECT(HR=1:"",1:"s")
if MIN>0
SET Y=Y_" and "
+12 IF MIN
SET Y=Y_MIN_" minute"_$SELECT(MIN=1:"",1:"s")
+13 IF $EXTRACT(Y,$LENGTH(Y))=" "
SET Y=$EXTRACT(Y,1,$LENGTH(Y)-1)
+14 QUIT Y
+15 ;
CRE2 ; get body, editable
+1 NEW I,TMP
+2 DO TEXT("T62",0,0,0,0,,.TMP)
+3 FOR I=1:1
if '$DATA(TMP(I))
QUIT
SET TEXT(4,I,0)=TMP(I)
+4 SET TEXT(4,0)=U_U_(I-1)_U_(I-1)_U_DT_U_U
+5 MERGE TEXT(2)=TEXT(4)
IF '$ORDER(@GLN@(0))
MERGE @GLN=TEXT(2)
+6 QUIT
+7 ;
+8 ; allow user to edit the text of the note
CRE3() ;
+1 NEW X,Y,DIC,DIWESUB
CRE31 ;
+1 SET Y=$$DIR(7)
IF Y<1
QUIT Y
+2 SET DIC=$TRANSLATE(GLN,")",",")
SET DIWESUB="Progress Note Text"
+3 DO EN^DIWE
DO CRE9
+4 SET Y=$$DIR(8)
IF Y=1
GOTO CRE31
+5 QUIT Y
+6 ;
CRE4 ;
+1 ; display if administrative closure
+2 IF TIUD("TYPE")="A"
Begin DoDot:1
+3 DO TEXT("T8",1,,,0)
+4 WRITE !,"Administrative Closure: "_$$FMTE^XLFDT(DT,"2D")
+5 WRITE !,?20,"By: "_$$GET1(200,DUZ,20.2)
+6 WRITE !,?24,$$GET1(200,DUZ,20.3)
+7 QUIT
End DoDot:1
+8 ; display if electronic signature
+9 IF TIUD("TYPE")'="A"
IF TIUD("SIGN")=DUZ
Begin DoDot:1
+10 DO TEXT("T9",1,,,0)
SET X=$$ESBLOCK^XUSESIG1(DUZ)
+11 WRITE !,?35,"/es/ "_$PIECE(X,U)
+12 WRITE !,?40,$PIECE(X,U,3)
+13 QUIT
End DoDot:1
+14 WRITE !!
+15 QUIT
+16 ;
CRE5() ; ask for user's electronic signature
+1 NEW X,Y,X1,X2
+2 DO TEXT("T13",1,1,,0)
DO SIG^XUSESIG
+3 QUIT $LENGTH(X1)>0
+4 ;
CRE9 ;
+1 ; rebuild TEXT(2) and TEXT(3)
+2 ; GLN=$NA(^TIU(8925.1,TIUDA,"DFLT"))
+3 NEW I,J,LN
+4 IF '$ORDER(@GLN@(0))
IF '$ORDER(TEXT(4,0))
QUIT
+5 IF '$ORDER(@GLN@(0))
KILL @GLN
MERGE @GLN=TEXT(4)
+6 KILL TEXT(2),TEXT(3)
SET LN=0
MERGE TEXT(2)=@GLN
+7 FOR J=1,2
FOR I=1:1
if '$DATA(TEXT(J,I))
QUIT
SET LN=LN+1
SET TEXT(3,LN,0)=TEXT(J,I,0)
+8 IF LN>0
SET TEXT(3,0)=U_U_LN_U_LN_U_DT_U_U
+9 QUIT
+10 ;
+11 ;===============================================
+12 ; Search for Patients
+13 ;-----------------------------------------------
+14 ; programmer notes at end of TIUDTBP0 routine for these modules
+15 ;
TOTADD(P) SET $PIECE(TOTAL,U,P)=1+$PIECE(TOTAL,U,P)
QUIT
+1 ;
GETINP ;
+1 NEW Z,STOP,TIUDSP,TMP,TOTAL,TYP
+2 SET TYP=1
SET TOTAL=0
MERGE TIUDSP=HDR
+3 ; sort current inpatients by ward, then name
+4 SET TMP=$NAME(^DPT("ACA"))
+5 FOR
SET TMP=$QUERY(@TMP)
if $QSUBSCRIPT(TMP,1)'="ACA"
QUIT
Begin DoDot:1
+6 NEW X,Y,DFN,PNM,WARD
+7 SET DFN=$QSUBSCRIPT(TMP,3)
SET X=$$CK2(DFN)
if 'X
QUIT
SET PNM=$PIECE(X,U,2)
+8 SET WARD=$GET(^DPT(DFN,.1))
SET X=$$CK42(WARD)
if 'X
QUIT
SET WARD=$PIECE(X,U,2)
+9 SET @GLT@("SORT",TYP,WARD,PNM,DFN)=""
+10 QUIT
End DoDot:1
+11 SET TMP=$NAME(@GLT@("SORT",TYP))
SET STOP=$TRANSLATE(TMP,")",",")
+12 FOR
SET TMP=$QUERY(@TMP)
if TMP'[STOP
QUIT
Begin DoDot:1
+13 NEW DATE,DFN,PNM,WARD
+14 SET WARD=$QSUBSCRIPT(TMP,5)
SET PNM=$QSUBSCRIPT(TMP,6)
SET DFN=$QSUBSCRIPT(TMP,7)
+15 SET DATE=$EXTRACT($$NOW^XLFDT,1,12)
+16 DO INPCOM(DFN,DATE)
+17 QUIT
End DoDot:1
+18 DO DSP(,,,1)
+19 QUIT
+20 ;
GETINPD ;
+1 NEW X,Y,STOP,TIUDSP,TIUNOW,TMP,TOTAL,TYP
+2 SET TYP=2
SET TOTAL=0
MERGE TIUDSP=HDR
+3 SET X=TIUD("TIME")-.000001
+4 SET TMP=$NAME(^DGPM("AMV3",X,"~~~"))
+5 SET TIUNOW=$$NOW^XLFDT
+6 ; sort discharged patients by patient name
+7 SET STOP=0
FOR
SET TMP=$QUERY(@TMP)
Begin DoDot:1
+8 NEW X,Y,DFN,DATE,PNM
+9 IF $QSUBSCRIPT(TMP,1)'="AMV3"
SET STOP=1
QUIT
+10 SET DATE=$QSUBSCRIPT(TMP,2)
+11 SET DFN=$QSUBSCRIPT(TMP,3)
SET X=$$CK2(DFN)
if 'X
QUIT
SET PNM=$PIECE(X,U,2)
+12 SET @GLT@("SORT",TYP,PNM,DFN,DATE)=""
+13 QUIT
End DoDot:1
if STOP
QUIT
+14 SET TMP=$NAME(@GLT@("SORT",TYP))
SET STOP=$TRANSLATE(TMP,")",",")
+15 FOR
SET TMP=$QUERY(@TMP)
if TMP'[STOP
QUIT
Begin DoDot:1
+16 NEW DATE,DFN,PNM
+17 SET PNM=$QSUBSCRIPT(TMP,5)
SET DFN=$QSUBSCRIPT(TMP,6)
SET DATE=$QSUBSCRIPT(TMP,7)
+18 IF DATE>TIUNOW
SET STOP=1
QUIT
+19 DO INPCOM(DFN,DATE)
+20 QUIT
End DoDot:1
+21 DO DSP(,,,1)
+22 QUIT
+23 ;
INPCOM(DFN,DATE) ;
+1 NEW I,X,Y,Z,DIV,HL,PNM,STAT,STATX,VAERR,VAIP,WARD,WNM
+2 if $GET(DFN)<1
QUIT
if $GET(DATE)<1
QUIT
+3 SET X=$$CK2(DFN)
SET PNM=$PIECE(X,U,2)
+4 SET Y=TIUD("TIME")
IF +$GET(DATE)
IF DATE<TIUD("TIME")
SET Y=DATE
+5 SET VAIP("D")=Y
SET VAIP("M")=1
+6 DO IN5^VADPT
if +$GET(VAERR)
SET VAIP(1)=""
IF 'VAIP(1)
QUIT
+7 SET WARD=+VAIP(5)
SET WNM=$PIECE(VAIP(5),U,2)
+8 SET X=$$CK42(WARD)
SET DIV=$PIECE(X,U,3)
SET HL=$PIECE(X,U,4)
+9 ; no hospital loc
SET X=0
if +HL
SET X=$$CK44(HL)
IF 'HL!'X
DO TOTADD(2)
QUIT
+10 IF 'TIUD("DIV")
if 'DIV
QUIT
if '$DATA(TIUD("DIV",DIV))
QUIT
+11 ; create the patient's downtime note
SET STAT=$$NEWNOTE(HL)
+12 SET STATX=$$STATUS(STAT)
+13 DO TOTADD(1+(STATX<1))
+14 DO DSP(PNM,WNM,STATX)
+15 DO TIUTX(STATX,DFN,PNM,WNM)
+16 ;track inpatients with outpatient appts
SET ^TMP("TIUDTBPN",$JOB,"DUPECHK",DFN)=""
+17 QUIT
+18 ;
GETOUT ;
+1 NEW X,DFN,STOP,TIUDSP,TMP,TOTAL,TYP
+2 SET TYP=3
SET TOTAL=0
MERGE TIUDSP=HDR
+3 SET X=TIUD("CLSEL")
if 'X
QUIT
IF X=1
IF '$ORDER(TIUD("CLSEL",0))
QUIT
+4 SET TMP=$NAME(^TMP($JOB,"SDAMA301"))
KILL @TMP
SET STOP=$TRANSLATE(TMP,")",",")
+5 ;
+6 NEW I,Y,TIUIN
+7 SET TIUIN(1)=TIUD("TIMS")_";"_TIUD("TIME")
+8 IF $ORDER(TIUD("CLSEL",0))
SET TIUIN(2)="TIUD(""CLSEL"","
+9 SET TIUIN(3)="R;I;NT"
+10 SET TIUIN("SORT")="P"
+11 SET TIUIN("FLDS")="1;2;3;4"
+12 SET X=$$SDAPI^SDAMA301(.TIUIN)
+13 ;I $G(ERRON) W !!!,"SDAMA301 return value: "_X,!!!
+14 ;print zero count when applicable
IF X<1
DO DSP(,,,1)
KILL @TMP
QUIT
+15 ; just get the last appt
+16 SET DFN=0
FOR
SET DFN=$ORDER(@TMP@(DFN))
if 'DFN
QUIT
Begin DoDot:1
+17 NEW DATE,HL,HLN,PNM
+18 SET DATE=$ORDER(@TMP@(DFN," "),-1)
+19 SET X=@TMP@(DFN,DATE)
+20 SET Y=$PIECE(X,U,2)
SET HL=+Y
SET HLN=$PIECE(Y,";",2)
+21 SET Y=$PIECE(X,U,4)
SET DFN=+Y
SET PNM=$PIECE(Y,";",2)
+22 SET @GLT@("SORT",TYP,PNM,DFN,DATE)=HL_U_HLN
+23 QUIT
End DoDot:1
+24 SET TMP=$NAME(@GLT@("SORT",TYP))
SET STOP=$TRANSLATE(TMP,")",",")
+25 FOR
SET TMP=$QUERY(@TMP)
if TMP'[STOP
QUIT
SET X=@TMP
Begin DoDot:1
+26 NEW DATE,DFN,HL,HLN,PNM,STAT,STATX
+27 SET PNM=$QSUBSCRIPT(TMP,5)
SET DFN=$QSUBSCRIPT(TMP,6)
SET DATE=$QSUBSCRIPT(TMP,7)
+28 SET HL=$PIECE(X,U)
SET HLN=$PIECE(X,U,2)
+29 ; don't file outpatient note if patient already had an inpatient note
+30 SET STAT=-1
IF +HL
IF '$DATA(^TMP("TIUDTBPN",$JOB,"DUPECHK",DFN))
SET STAT=$$NEWNOTE(HL)
+31 SET STATX=$$STATUS(STAT)
+32 DO TOTADD(1+(STATX<1))
+33 DO DSP(PNM,HLN,STATX)
+34 DO TIUTX(STATX,DFN,PNM,HLN)
+35 QUIT
End DoDot:1
+36 DO DSP(,,,1)
+37 QUIT
+38 ;
+39 ;===============================================
+40 ; Miscellaneous
+41 ;-----------------------------------------------
CK2(DFN) ;
+1 ; return -1 or dfn^name
+2 NEW I,X,Y,NM
+3 SET DFN=$GET(DFN)
IF (DFN'=+DFN)!(DFN<1)
QUIT 0
+4 SET X=$GET(@GLT@("F",2,DFN))
IF $LENGTH(X)
QUIT X
+5 SET NM=$PIECE($GET(^DPT(DFN,0)),U)
IF NM=""
QUIT 0
+6 SET X=DFN_U_NM
+7 SET @GLT@("F",2,DFN)=X
+8 QUIT X
+9 ;
CK42(VAL) ;
+1 ; return -1 file_42_ien ^ 42_name ^ division_ien ^ hosp_loc_ien
+2 ; find1 call assures one and only one entry matching name
+3 NEW I,X,Y,DIV,HL,NM
+4 IF 0[VAL
QUIT 0
+5 SET X=$GET(@GLT@("F",42,VAL))
IF $LENGTH(X)
QUIT X
+6 IF VAL=+VAL
IF VAL<1
QUIT 0
+7 IF VAL'=+VAL
SET VAL=+$$FIND1(42,,,VAL)
if VAL<1
QUIT 0
+8 SET IEN=VAL_","
+9 SET NM=$$GET1(42,IEN,.01)
+10 SET DIV=$$GET1(42,IEN,.015,"I")
+11 SET HL=$$GET1(42,IEN,44,"I")
+12 SET X=VAL_U_NM_U_DIV_U_HL
+13 SET @GLT@("F",42,VAL)=X
+14 SET @GLT@("F",42,NM)=X
+15 QUIT X
+16 ;
CK44(IEN) ;
+1 ; return -1 or file_44_ien ^ 44_name ^ division
+2 NEW I,X,Y,DIV,IENS,NM
+3 IF (IEN'=+IEN)!(IEN<1)
QUIT 0
+4 SET X=$GET(@GLT@("F",44,IEN))
IF $LENGTH(X)
QUIT X
+5 SET IENS=IEN_","
+6 SET NM=$$GET1(44,IENS,.01)
IF NM=""
QUIT 0
+7 SET DIV=$$GET1(44,IENS,3.5,"I")
+8 SET X=IEN_U_NM_U_DIV
+9 SET @GLT@("F",44,IEN)=X
+10 QUIT X
+11 ;
DIC(CH) QUIT $$DIC^TIUDTBP0(CH)
+1 ;
DIR(CH) QUIT $$DIR^TIUDTBP0(CH)
+1 ;
DIVISION() QUIT $$DIVISION^TIUDTBP0
+1 ;
DSP(PNM,LNM,STATX,END) ; screen display
+1 ; update screen 20 lines at a time
+2 NEW I,L,X,Y
+3 SET PNM=$GET(PNM)
SET LNM=$GET(LNM)
SET STATX=$GET(STATX)
SET END=+$GET(END)
+4 IF END
Begin DoDot:1
+5 NEW FAIL
SET FAIL=+$PIECE(TOTAL,U,2)
+6 SET X="Notes created: "_(+TOTAL)
+7 if FAIL
SET X=X_" Notes failed to be created: "_FAIL
+8 SET I=1+$ORDER(TIUDSP("A"),-1)
SET TIUDSP(I)=""
SET TIUDSP(I+1)=X
+9 SET L=20
+10 QUIT
End DoDot:1
+11 IF 'END
Begin DoDot:1
+12 SET X=$$DSPFMT(PNM,LNM,STATX)
+13 SET L=1+$ORDER(TIUDSP("A"),-1)
SET TIUDSP(L)=X
+14 QUIT
End DoDot:1
+15 IF L>19
Begin DoDot:1
+16 SET L=+$ORDER(@GLT@("DSP",TYP,"A"),-1)
+17 FOR I=1:1
if '$DATA(TIUDSP(I))
QUIT
SET X=TIUDSP(I)
Begin DoDot:2
+18 if TRM
WRITE !,X
SET L=L+1
SET @GLT@("DSP",TYP,L)=X
+19 QUIT
End DoDot:2
+20 KILL TIUDSP
+21 QUIT
End DoDot:1
+22 QUIT
+23 ;
DSPFMT(PNM,LNM,STATX) ; format display line
+1 NEW X,SP,TIUDA
+2 SET $PIECE(SP," ",41)=""
+3 SET PNM=$GET(PNM)
if PNM=""
SET PNM="NoName"
+4 SET LNM=$GET(LNM)
if LNM=""
SET LNM="NoLocation"
+5 SET STATX=$GET(STATX)
+6 SET TIUDA=$PIECE(STATX,";",2)
+7 IF +STATX=1
SET X=" Yes | "
+8 IF +STATX=2
SET X="Unsign | "
+9 IF +STATX=0
SET X=" No | "
+10 IF +STATX=-1
SET X=" Error | "
+11 SET X=X_$EXTRACT(LNM_SP,1,25)_" | "_PNM
+12 IF +$GET(ERRON)
IF TIUDA>0
SET X=X_" ["_TIUDA_"]"
+13 QUIT X
+14 ;
ESIGCK() ;
+1 NEW X,Y
SET Y=$$GET1(200,DUZ,20.4,"I")
IF Y=""
DO TEXT("T12",1,12)
+2 QUIT Y'=""
+3 ;
FIND1(FILE,IEN,FLG,VAL,IDX,SCR) ;
+1 QUIT $$FIND1^TIUDTBP0(.FILE,.IEN,.FLG,.VAL,.IDX,.SCR)
+2 ;
GET1(FILE,IEN,FLD,FLG) ;
+1 QUIT $$GET1^TIUDTBP0(.FILE,.IEN,.FLD,.FLG)
+2 ;
MAIL() ;
+1 NEW I,X,Y,Z,CNT,GLE,GLX,LIN,NEWFORM,STOP,TIU,TMP
+2 NEW XMDUZ,XMSUB,XMTEXT,XMY
+3 SET NEWFORM=+$GET(EFORM)
+4 SET GLE=$NAME(^TMP("XMERR",$JOB))
KILL @GLE
+5 SET XMDUZ=DUZ
+6 SET XMSUB="Record of Progress Notes for VistA Downtime"
+7 SET GLX=$NAME(@GLT@("SEND"))
SET XMTEXT=$TRANSLATE(GLX,")",",")
+8 MERGE XMY=TIUD("MAIL")
+9 IF NEWFORM
Begin DoDot:1
+10 DO TEXT("T16",0,0,0,0,,.TIU)
+11 FOR I=1:1
if '$DATA(TIU(I))
QUIT
SET @GLX@(I,0)=TIU(I)
+12 SET L=I-1
+13 QUIT
End DoDot:1
+14 IF 'NEWFORM
Begin DoDot:1
+15 SET @GLX@(1,0)="PATIENT NAME^WARD LOCATION^STATUS OF NOTE INSERTION"
+16 SET @GLX@(2,0)=" "
+17 SET L=2
+18 QUIT
End DoDot:1
+19 SET CNT=0
+20 SET TMP=$NAME(@GLT@("MSG"))
SET STOP=$TRANSLATE(TMP,")",",")
+21 FOR
SET TMP=$QUERY(@TMP)
if TMP'[STOP
QUIT
Begin DoDot:1
+22 NEW X,DFN,HLN,PNM,STATX
+23 SET PNM=$QSUBSCRIPT(TMP,4)
SET DFN=$QSUBSCRIPT(TMP,5)
SET HLN=$QSUBSCRIPT(TMP,6)
+24 SET STATX=@TMP
+25 SET X=PNM_U_HLN_U_$PIECE(STATX,";",3)
+26 IF NEWFORM
SET X=$$DSPFMT(PNM,HLN,STATX)
+27 SET CNT=CNT+1
SET L=L+1
SET @GLX@(L,0)=X
+28 QUIT
End DoDot:1
+29 IF TRM
IF 'CNT
WRITE !!,"No patients found who had downtime note created.",!
+30 NEW TMAIL
SET TMAIL=$SELECT('CNT:0,1:-1)
+31 IF CNT
Begin DoDot:1
+32 NEW XMERR,XMMG,XMSTRIP,XMYBLOG,XMZ
+33 SET @GLX@(0)=U_U_CNT_U_CNT_U_DT_U_U
+34 DO ^XMD
IF TRM
Begin DoDot:2
+35 WRITE !
SET Y=$LENGTH($GET(XMMG))
+36 if 'Y
WRITE !,"Email notification sent in message number "_XMZ_"."
+37 if Y
WRITE !!,"ERROR: mail message not created",!?5,XMMG,!
+38 QUIT
End DoDot:2
+39 SET TMAIL=$GET(XMZ)_"^Error: "_$GET(XMMG)
+40 QUIT
End DoDot:1
+41 KILL @GLE
+42 QUIT TMAIL
+43 ;
NEWNOTE(LOC) ;
+1 ; Create New TIU Note
+2 ; loc = file 44 ien / expects DFN to be defined
+3 ; FINDPAT should have set up @GLT@() for all LOCs
+4 ; Extrinsic return value: -1 ; -1^-1 ; TIUDA ; TIUDA^-1
+5 ; Any place where STAT is referenced it will be this value
+6 NEW I,X,Y,GL,LOCNM,STAT,TIUADM
+7 NEW AUTH,ESBY,TITLE,TIUDT,TYPE
+8 MERGE X=TEXT
NEW TEXT
+9 SET GL=$NAME(^TMP("TIUP",$JOB))
KILL @GL
MERGE @GL=X
+10 FOR X="AUTH","ESBY","TITLE","TYPE"
SET @X=TIUD(X)
+11 SET TIUDT=TIUD("NOTEDT")
+12 IF +$GET(LOC)
Begin DoDot:1
+13 SET LOCNM=$PIECE($$CK44(LOC),U,2)
+14 SET I=1+$ORDER(@GL@("A"),-1)
SET @GL@(I,0)=" "
+15 SET X="Patient location at the conclusion of the downtime: "_LOCNM
+16 SET I=I+1
SET @GL@(I,0)=X
+17 SET $PIECE(@GL@(0),U,3,4)=I_U_I
+18 QUIT
End DoDot:1
+19 ; TIUPNAPI is expecting note to be in ^TMP("TIUP",$J,n,0)
+20 IF TYPE="E"
DO NEW^TIUPNAPI(.STAT,DFN,AUTH,TIUDT,TITLE,LOC,0,0,ESBY)
+21 IF TYPE="A"
DO NEW^TIUPNAPI(.STAT,DFN,AUTH,TIUDT,TITLE,LOC)
+22 SET X=STAT
SET $PIECE(X,U,3)=ESBY
+23 IF STAT>0
IF TYPE="A"
DO ADMNCLOS^TIUSRVPT(.TIUADM,+STAT,"M")
+24 KILL @GL
+25 QUIT STAT
+26 ;
QUEUE ;
+1 NEW X,Y,DESC,OTH,RTN,VAR,ZTSK
+2 SET RTN="EN^TIUDTBPN"
+3 SET DESC="TIU Contingency Downtime Bookmark Progress Notes"
+4 SET VAR="TIUD(;TEXT("
+5 if $DATA(EFORM)
SET VAR=VAR_";EFORM"
if $DATA(ERRON)
SET VAR=VAR_";ERRON"
+6 SET OTH("ZTDTH")=$HOROLOG
+7 SET ZTSK=$$NODEV^XUTMDEVQ(RTN,DESC,VAR,.OTH,1)
+8 QUIT
+9 ;
STATUS(TIUDA) ;
+1 ; TIUDA can be ien, -1, ien^-1, -1^-1
+2 ; Return: -1/0/1/2 ; note_ien or -1 ; format text
+3 NEW Y,TIUDA,TXT
+4 SET STAT=$GET(STAT)
SET TIUDA=+STAT
+5 IF STAT'["-1"
SET TXT="Successful"
SET Y=1
+6 IF '$DATA(TXT)
IF TIUDA=-1
SET TXT="Unsuccessful"
SET Y=0
+7 IF '$DATA(TXT)
IF TIUDA>0
IF STAT["-1"
SET TXT="Successful/unsigned"
SET Y=2
+8 IF '$DATA(TXT)
SET TXT="Error"
SET Y=-1
+9 if $GET(ERRON)
SET TXT=TXT_" ["_STAT_"]"
+10 QUIT Y_";"_TIUDA_";"_TXT
+11 ;
TEXT(TAG,WR,LF,CLR,PAD,CHR,TIUR) ; Generic Text Handler
+1 ; TAG - line label containing the text
+2 ; all groups of text should end with ' ;;---'
+3 ; WR - Boolean, write or do not write
+4 ; LF - 0:no extra line feeds; 1:leading line feed; 2:trailing feed
+5 ; CLR - Boolean, clear screen first
+6 ; PAD - number of spaces begin each line with
+7 ; If PAD="" then default to 3. If PAD=0 then no padding
+8 ; CHR - for center justify, character to pad line, default is space
+9 SET TAG=$GET(TAG)
SET WR=+$GET(WR)
SET LF=+$GET(LF)
SET CLR=+$GET(CLR)
+10 SET CHR=$GET(CHR)
if CHR=""
SET CHR=" "
+11 SET PAD=$GET(PAD)
IF PAD'?1.N
SET PAD=3
+12 DO TEXT^TIUDTBP0(TAG,WR,LF,CLR,PAD,CHR,.TIUR)
+13 QUIT
+14 ;
TIUTX(STATX,DFN,PNM,LNM) ; text for mail message
+1 ; statx = -1/0/1/2 ; note_ien or -1 ; format text
+2 NEW I,X
+3 if '$GET(DFN)
QUIT
if '$LENGTH($GET(PNM))
QUIT
if '$LENGTH($GET(LNM))
QUIT
+4 SET I=1+$ORDER(@GLT@("MSG",PNM,DFN,LNM,"A"),-1)
+5 SET @GLT@("MSG",PNM,DFN,LNM,I)=$GET(STATX)
+6 QUIT
