PSBOMM2 ;BIRMINGHAM/EFC-MISSED MEDS ;2/6/21 17:43
;;3.0;BAR CODE MED ADMIN;**26,32,51,62,74,88,106**;Mar 2004;Build 43
;Per VA Directive 6402, this routine should not be modified.
;
;*106 move Clinic report code from psbomm to here due to routine size was exceeded in psbomm
;
MISSED(PSBADMN,PSBEDIT,PSBXDT) ;
N PSBMISD,PSBAUDT,PSBSTRT2
S PSBSTRT2=(PSBXDT\1) F D Q:PSBODD S PSBSTRT2=$$FMADD^XLFDT(PSBSTRT2,1) Q:PSBSTRT2>PSBSTOP
.F Y=1:1:$L(PSBADMN,"-") S PSBDT=+("."_$P(PSBADMN,"-",Y))+(PSBSTRT2) D
..S PSBMISD=$$CHECK(PSBDT)
..;Check Audited Admin Times for Missed Med
..I PSBMISD F I=1:1:$P(PSBOACTL(0),U,4) I $P($G(PSBOACTL(I,1)),U,3)["ADMIN TIMES" D Q:'PSBMISD
...Q:$P(PSBOACTL(I,1),U)<PSBSTRT2
...;Q:$P(PSBOACTL(I,1),U)>((PSBSTOP\1)+.2400) - remove ending date check, all audits should affect report, PSB*3*88
...Q:$P(PSBOACTL(I,1),U)<PSBDT
...S PSBAUDT=+("."_$P(PSBOACTL(I,2),"-",Y))+(PSBSTRT2\1)
...S PSBMISD=$$CHECK(PSBAUDT),PSBEDIT=1
..I PSBMISD D
...Q:'$$OKAY^PSBVDLU1(PSBOST,PSBSTRT2,PSBSCH,PSBONX,$P(^TMP("PSJ",$J,PSBX,3),U,2),PSBFREQ,PSBOSTS)
...S:'$D(^TMP("PSB",$J,DFN,PSBDT,"* "_PSBOITX,PSBONX)) ^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX)=""
...D UDCONT
Q
CHECK(PSBDT) ;
I PSBDT<PSBOST Q 0 ; Order Start Date
I PSBDT'<PSBOSP Q 0 ; Order Stop Date
I PSBDT<PSBSTRT Q 0 ; Report Window
I PSBDT>PSBSTOP Q 0 ; Report Window
I $D(^PSB(53.79,"AORD",DFN,PSBONX,PSBDT)) D Q:PSBSTUS'="N" $G(PART,0)
.K PART S PSBIX=$O(^PSB(53.79,"AORD",DFN,PSBONX,PSBDT,"")),PSBSTUS=$P(^PSB(53.79,PSBIX,0),U,9)
.I PSBOCRIT[PSBOSTS D:(PSBACRIT[PSBSTUS) Q
..I (PSBSTUS="G")&$D(^PSB(53.79,PSBIX,.5)) D
...S X=0 F S X=$O(^PSB(53.79,PSBIX,.5,X)) Q:+X=0 D
....I $P(^PSB(53.79,PSBIX,.5,X,0),U,2)>$P(^PSB(53.79,PSBIX,.5,X,0),U,3) D S PSBOITX=$E(PSBOITX,3,999)
.....S PSBOITX="* "_PSBOITX S ^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX,"X")="Units Ordered: "_$P(^PSB(53.79,PSBIX,.5,X,0),U,2)_" Units Given: "_$P(^PSB(53.79,PSBIX,.5,X,0),U,3)_" Admin. Status: * Partial (Given)"
.....S PART=1
.....D:PSBINCC GCMNTS(PSBIX)
..I PSBSTUS'="G" I PSBACRIT[PSBSTUS S PART=1 S ^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX,"X")="Admin. Status: ("_$S(PSBSTUS="":" *UNKNOWN* ",PSBSTUS="M":"Missing Dose",PSBSTUS="H":"Held",PSBSTUS="R":"Refused")_")" D:PSBINCC GCMNTS(PSBIX)
Q 1
UDCONT ;
S PSBFLAG=0,J=1
K ^TMP("PSB1",$J)
F I=1:1:$P(PSBOACTL(0),U,4) D
. I $P($G(PSBOACTL(I,1)),U,4)["ON HOLD"!($P($G(PSBOACTL(I,1)),U,4)="HOLD") S ^TMP("PSB1",$J,DFN,J)="HOLD"_U_$E($P($G(PSBOACTL(I,1)),U,1),1,12)
. I $P($G(PSBOACTL(I,1)),U,4)["TAKEN OFF HOLD"!($P($G(PSBOACTL(I,1)),U,4)["UNHOLD") S $P(^TMP("PSB1",$J,DFN,J),U,3)="OFF HOLD"_U_$E($P($G(PSBOACTL(I,1)),U,1),1,12),J=J+1
D:$D(^TMP("PSB1",$J,DFN))&($P(PSBOACTL(0),U,4)'=1)
.S J=0 F S J=$O(^TMP("PSB1",$J,DFN,J)) Q:'J Q:PSBFLAG D
..S PSBHDDT=$P(^TMP("PSB1",$J,DFN,J),U,2)
..S PSBHDST=$P(^TMP("PSB1",$J,DFN,J),U)
..S PSBOFDT=$P(^TMP("PSB1",$J,DFN,J),U,4)
..S PSBOFST=$P(^TMP("PSB1",$J,DFN,J),U,3)
..I PSBDT>PSBHDDT,PSBHDST="HOLD",PSBOFST'="" I PSBDT<PSBOFDT,PSBOFST="OFF HOLD" S PSBFLAG=2,PSBUNHD=PSBOFDT
..I PSBDT>PSBHDDT,PSBHDST="HOLD",PSBOFST="" S PSBFLAG=1
K PSBCNT,TMP("PSB1",$J)
S PSBOITX2=PSBOITX
I $D(^TMP("PSB",$J,DFN,PSBDT,"* "_PSBOITX,PSBONX)) S PSBOITX="* "_PSBOITX
I PSBFLAG=1 S ^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX)="(On Hold) "_$$DTFMT(PSBHDDT)
I PSBFLAG=2 S ^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX)="(On Hold) "_$$DTFMT(PSBHDDT)_" "_"(Off Hold) "_$$DTFMT(PSBUNHD)
S PSBOITX=PSBOITX2
Q
;
UDONE ;
S PSBFLAG=0,J=1
F I=1:1:$P(PSBOACTL(0),U,4) D
.I $P($G(PSBOACTL(I,1)),U,4)["ON HOLD"!($P($G(PSBOACTL(I,1)),U,4)="HOLD") S ^TMP("PSB1",$J,DFN,J)="HOLD"_U_$E($P($G(PSBOACTL(I,1)),U,1),1,12)
.I $P($G(PSBOACTL(I,1)),U,4)["TAKEN OFF HOLD"!($P($G(PSBOACTL(I,1)),U,4)["UNHOLD") S $P(^TMP("PSB1",$J,DFN,J),U,3)="OFF HOLD"_U_$E($P($G(PSBOACTL(I,1)),U,1),1,12),J=J+1
D:$D(^TMP("PSB1",$J,DFN))&($P(PSBOACTL(0),U,4)'=1)
.S J="" F S J=$O(^TMP("PSB1",$J,DFN,J)) Q:'J Q:PSBFLAG D
..S PSBHDDT=$P(^TMP("PSB1",$J,DFN,J),U,2)
..S PSBHDST=$P(^TMP("PSB1",$J,DFN,J),U)
..S PSBOFDT=$P(^TMP("PSB1",$J,DFN,J),U,4)
..S PSBOFST=$P(^TMP("PSB1",$J,DFN,J),U,3)
..I PSBOSTS="A",PSBHDST="HOLD",PSBOFST'="",'$D(^TMP("PSB1",$J,DFN,J+1)) I PSBSTOP>PSBOFDT,PSBOFST="OFF HOLD" S PSBFLAG=2,PSBUNHD=PSBOFDT
..I PSBOSTS="A",PSBHDST="HOLD",PSBOFST'="",PSBOFDT'<PSBSTOP S PSBFLAG=1
..I PSBOSTS="H",PSBHDST="HOLD",'$D(^TMP("PSB1",$J,DFN,J+1)) S PSBFLAG=1
K PSBCNT,^TMP("PSB1",$J)
S PSBOITX2=PSBOITX
I $D(^TMP("PSB",$J,DFN,PSBDT,"* "_PSBOITX,PSBONX)) S PSBOITX="* "_PSBOITX
I PSBFLAG=1 S ^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX)="(On Hold) "_$$DTFMT(PSBHDDT)
I PSBFLAG=2 S ^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX)="(On Hold) "_$$DTFMT(PSBHDDT)_" "_"(Off Hold) "_$$DTFMT(PSBUNHD)
S PSBOITX=PSBOITX2
Q
GCMNTS(XIEN) ;
Q:'$D(^PSB(53.79,XIEN,.3,1))
N X
S X=$O(^PSB(53.79,XIEN,.3,""),-1) Q:+X=0 S ^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX,.3)="Comment: "_$P(^PSB(53.79,XIEN,.3,X,0),U)
Q
PARTG1(XIEN) ;
I $D(^PSB(53.79,XIEN)) D
.S PSBSTUS=$P(^PSB(53.79,XIEN,0),U,9)
.I PSBOCRIT[PSBOSTS I PSBACRIT[PSBSTUS D S PSBEXST=1 Q
..I (PSBSTUS="G")&$D(^PSB(53.79,XIEN,.5)) D
...S X=0 F S X=$O(^PSB(53.79,XIEN,.5,X)) Q:+X=0 D
....I $P(^PSB(53.79,XIEN,.5,X,0),U,2)>$P(^PSB(53.79,XIEN,.5,X,0),U,3) D S PSBOITX=$E(PSBOITX,3,999),PSBGVN=0
.....S PSBOITX="* "_PSBOITX S ^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX,"X")="Units Ordered: "_$P(^PSB(53.79,XIEN,.5,X,0),U,2)_" Units Given: "_$P(^PSB(53.79,XIEN,.5,X,0),U,3)_" Admin. Status: * Partial (Given)"
.....I PSBINCC D GCMNTS(XIEN)
..I PSBSTUS'="G" D S PSBGVN=0
...I PSBACRIT[PSBSTUS S ^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX,"X")="Admin. Status: ("_$S(PSBSTUS="":" *UNKNOWN* ",PSBSTUS="M":"Missing Dose",PSBSTUS="H":"Held",PSBSTUS="R":"Refused")_")"
...I PSBINCC D GCMNTS(XIEN)
Q
LN1 ;
W !,$TR($J("",IOM)," ","-")
Q
DEFLT ;
S PSBFUTR=$TR(PSBRPT(1),"~","^")
Q:PSBRPT(1)]""
S PSBFUTR="^^^^1^^1^1^^^^^^^^1^1^1" ;default MM Report settings Per GUI MM report...
S X01=""
D RPC^PSBPAR(.X01,"GETPAR","ALL","PSB RPT INCL COMMENTS")
S $P(PSBRPT(.2),U,8)=+X01(0)
K PSBSTOP S PSBSTOP=$P(PSBRPT(.1),U,6)+$P(PSBRPT(.1),U,9)
Q
DTFMT(DT) ;
N Y,X
I +DT'>0 S DTFMT=DT Q DTFMT
S Y=DT,X=$E($P(Y,".",2)_"0000",1,4)
S DTFMT=$TR($J(+$E(Y,4,5),2)_"/"_$J(+$E(Y,6,7),2)_"/"_($E(Y,1,3)+1700)," ","0")_"@"_X
Q DTFMT
;
CLINIC ;Clinic report *106
W $$CLNHDR()
I '$O(^TMP("PSB",$J,0)) W !,"No Missed Medications Found" Q
S PSBSORT=$P(PSBRPT(.1),U,5)
F DFN=0:0 S DFN=$O(^TMP("PSB",$J,DFN)) Q:'DFN D
.S PSBDX=$S(PSBSORT="P":$P(^DPT(DFN,0),U),1:$G(^DPT(DFN,.1))_" "_$G(^(.101)))
.S:PSBDX="" PSBDX=$P(^DPT(DFN,0),U)
.S ^TMP("PSB",$J,"B",PSBDX,DFN)=""
S PSBDX=""
F S PSBDX=$O(^TMP("PSB",$J,"B",PSBDX)) Q:PSBDX="" D
.F DFN=0:0 S DFN=$O(^TMP("PSB",$J,"B",PSBDX,DFN)) Q:'DFN D
..W !
..S PSBDT=""
..F S PSBDT=$O(^TMP("PSB",$J,DFN,PSBDT)) Q:PSBDT="" D
...W !
...K VAR1,VAR2,VAR3 ;reset held/refused to prevent line feed
...W:PSBDT["ONE-TIME" !
...S PSBOITX=""
...F S PSBOITX=$O(^TMP("PSB",$J,DFN,PSBDT,PSBOITX)) Q:PSBOITX="" D
....S PSBONX=""
....F S PSBONX=$O(^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX)) Q:PSBONX="" D
.....;if previously held/refused lines printed, need line feed *58
.....I ($G(VAR1)]"")!($G(VAR2)]"")!($G(VAR3)]"") W:'$G(RMV) ! K RMV
.....K VAR1,VAR2,VAR3,SP I $Y>(IOSL-9) W $$CLNHDR()
.....D PSJ1^PSBVT(DFN,PSBONX)
.....S PSBVNI=$S(PSBVNI]"":PSBVNI,1:"***")
.....; print remove line 1st *83
.....S RMV=0
.....D:$D(^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX,"RM"))
......W !,$O(PSBS(DFN,PSBONX,"")),?11,PSBVNI,?17,$P(^DPT(DFN,0),U)
......W ?49,$S(+PSBDT>0:$$DTFMT^PSBOMM2(PSBDT),1:PSBDT),?66,PSBOITX
......W ?103,PSBCLORD
......W !,?69,"(Remove)" S RMV=1
.....;print Give if exists for a RM just printed, or no RM printed
.....I 'RMV!(RMV&$D(^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX))=11) D
......W !,$O(PSBS(DFN,PSBONX,"")),?11,PSBVNI,?17,$P(^DPT(DFN,0),U)
......W:PSBDT'["ONE-TIME" ?49,$S(+PSBDT>0:$$DTFMT^PSBOMM2(PSBDT),1:PSBDT),?66,PSBOITX
......W:PSBDT'["ONE-TIME" ?103,PSBCLORD
.....;*106 adds the hazardous handle/dispose notices
.....I (PSBHAZDS=1)!(PSBHAZHN=1) W !
.....I PSBHAZHN=1 W ?92,"<<HAZ HANDLE>> " ;*106 hazhn
.....I PSBHAZDS=1 W ?92,"<<HAZ DISPOSE>>" ;*106 hazds, if hazhn printed 1st, then this will print after that and not at 92, desired.
.....S VAR1=$G(^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX))
.....S VAR2=$G(^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX,"X"))
.....S VAR3=$G(^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX,.3))
.....I PSBDT["ONE-TIME" D Q
......W !,PSBDT,?37,PSBOITX S SP=1 W:PSBCLINORD ?103,PSBCLORD
......I VAR1]"" W !,?37,$P(VAR1,U,1) S SP=1
......I VAR2]"" W:$G(SP) ! W ?37,VAR2
......I VAR3]"" W !,$$WRAP^PSBO(37,102,VAR3)
......W !?3,"Start Date/Time: ",?21,$O(PSBSTXT(PSBONX,DFN,"")) ;DFN added to PSBSTXT array in PSB*3*52
......W !?3,"Stop Date/Time: ",?21,$O(PSBSTXP(PSBONX,DFN,"")) ;DFN added to PSBSTXP array in PSB*3*52
......W !
.....;detail line additional info
.....S SP=1
.....I VAR1]"" W !,?57,VAR1 S SP=1
.....I VAR2]"" W:$G(SP) ! W ?57,VAR2
.....I VAR3]"" W !,$$WRAP^PSBO(57,82,VAR3)
Q
;
CLNHDR() ; *106
D CLINIC^PSBOHDR(.PSBRPT,.PSBHDR,,,PSBSRCHL)
W !,"Order Sts",?11,"Ver",?17,"Patient",?49,"Missed Date/Time",?66,"Medication",?103,"Location"
D LN1^PSBOMM2
Q ""
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSBOMM2 9567 printed Nov 22, 2024@16:50:57 Page 2
PSBOMM2 ;BIRMINGHAM/EFC-MISSED MEDS ;2/6/21 17:43
+1 ;;3.0;BAR CODE MED ADMIN;**26,32,51,62,74,88,106**;Mar 2004;Build 43
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;*106 move Clinic report code from psbomm to here due to routine size was exceeded in psbomm
+5 ;
MISSED(PSBADMN,PSBEDIT,PSBXDT) ;
+1 NEW PSBMISD,PSBAUDT,PSBSTRT2
+2 SET PSBSTRT2=(PSBXDT\1)
FOR
Begin DoDot:1
+3 FOR Y=1:1:$LENGTH(PSBADMN,"-")
SET PSBDT=+("."_$PIECE(PSBADMN,"-",Y))+(PSBSTRT2)
Begin DoDot:2
+4 SET PSBMISD=$$CHECK(PSBDT)
+5 ;Check Audited Admin Times for Missed Med
+6 IF PSBMISD
FOR I=1:1:$PIECE(PSBOACTL(0),U,4)
IF $PIECE($GET(PSBOACTL(I,1)),U,3)["ADMIN TIMES"
Begin DoDot:3
+7 if $PIECE(PSBOACTL(I,1),U)<PSBSTRT2
QUIT
+8 ;Q:$P(PSBOACTL(I,1),U)>((PSBSTOP\1)+.2400) - remove ending date check, all audits should affect report, PSB*3*88
+9 if $PIECE(PSBOACTL(I,1),U)<PSBDT
QUIT
+10 SET PSBAUDT=+("."_$PIECE(PSBOACTL(I,2),"-",Y))+(PSBSTRT2\1)
+11 SET PSBMISD=$$CHECK(PSBAUDT)
SET PSBEDIT=1
End DoDot:3
if 'PSBMISD
QUIT
+12 IF PSBMISD
Begin DoDot:3
+13 if '$$OKAY^PSBVDLU1(PSBOST,PSBSTRT2,PSBSCH,PSBONX,$PIECE(^TMP("PSJ",$JOB,PSBX,3),U,2),PSBFREQ,PSBOSTS)
QUIT
+14 if '$DATA(^TMP("PSB",$JOB,DFN,PSBDT,"* "_PSBOITX,PSBONX))
SET ^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX)=""
+15 DO UDCONT
End DoDot:3
End DoDot:2
End DoDot:1
if PSBODD
QUIT
SET PSBSTRT2=$$FMADD^XLFDT(PSBSTRT2,1)
if PSBSTRT2>PSBSTOP
QUIT
+16 QUIT
CHECK(PSBDT) ;
+1 ; Order Start Date
IF PSBDT<PSBOST
QUIT 0
+2 ; Order Stop Date
IF PSBDT'<PSBOSP
QUIT 0
+3 ; Report Window
IF PSBDT<PSBSTRT
QUIT 0
+4 ; Report Window
IF PSBDT>PSBSTOP
QUIT 0
+5 IF $DATA(^PSB(53.79,"AORD",DFN,PSBONX,PSBDT))
Begin DoDot:1
+6 KILL PART
SET PSBIX=$ORDER(^PSB(53.79,"AORD",DFN,PSBONX,PSBDT,""))
SET PSBSTUS=$PIECE(^PSB(53.79,PSBIX,0),U,9)
+7 IF PSBOCRIT[PSBOSTS
if (PSBACRIT[PSBSTUS)
Begin DoDot:2
+8 IF (PSBSTUS="G")&$DATA(^PSB(53.79,PSBIX,.5))
Begin DoDot:3
+9 SET X=0
FOR
SET X=$ORDER(^PSB(53.79,PSBIX,.5,X))
if +X=0
QUIT
Begin DoDot:4
+10 IF $PIECE(^PSB(53.79,PSBIX,.5,X,0),U,2)>$PIECE(^PSB(53.79,PSBIX,.5,X,0),U,3)
Begin DoDot:5
+11 SET PSBOITX="* "_PSBOITX
SET ^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX,"X")="Units Ordered: "_$PIECE(^PSB(53.79,PSBIX,.5,X,0),U,2)_" Units Given: "_$PIECE(^PSB(53.79,PSBIX,.5,X,0),U,3)_" Admin. Status: * Partial (Given)"
+12 SET PART=1
+13 if PSBINCC
DO GCMNTS(PSBIX)
End DoDot:5
SET PSBOITX=$EXTRACT(PSBOITX,3,999)
End DoDot:4
End DoDot:3
+14 IF PSBSTUS'="G"
IF PSBACRIT[PSBSTUS
SET PART=1
SET ^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX,"X")="Admin. Status: ("_$SELECT(PSBSTUS="":" *UNKNOWN* ",PSBSTUS="M":"Missing Dose",PSBSTUS="H":"Held",PSBSTUS="R":"Refused")_")"
if PSBINCC
DO GCMNTS(PSBIX)
End DoDot:2
QUIT
End DoDot:1
if PSBSTUS'="N"
QUIT $GET(PART,0)
+15 QUIT 1
UDCONT ;
+1 SET PSBFLAG=0
SET J=1
+2 KILL ^TMP("PSB1",$JOB)
+3 FOR I=1:1:$PIECE(PSBOACTL(0),U,4)
Begin DoDot:1
+4 IF $PIECE($GET(PSBOACTL(I,1)),U,4)["ON HOLD"!($PIECE($GET(PSBOACTL(I,1)),U,4)="HOLD")
SET ^TMP("PSB1",$JOB,DFN,J)="HOLD"_U_$EXTRACT($PIECE($GET(PSBOACTL(I,1)),U,1),1,12)
+5 IF $PIECE($GET(PSBOACTL(I,1)),U,4)["TAKEN OFF HOLD"!($PIECE($GET(PSBOACTL(I,1)),U,4)["UNHOLD")
SET $PIECE(^TMP("PSB1",$JOB,DFN,J),U,3)="OFF HOLD"_U_$EXTRACT($PIECE($GET(PSBOACTL(I,1)),U,1),1,12)
SET J=J+1
End DoDot:1
+6 if $DATA(^TMP("PSB1",$JOB,DFN))&($PIECE(PSBOACTL(0),U,4)'=1)
Begin DoDot:1
+7 SET J=0
FOR
SET J=$ORDER(^TMP("PSB1",$JOB,DFN,J))
if 'J
QUIT
if PSBFLAG
QUIT
Begin DoDot:2
+8 SET PSBHDDT=$PIECE(^TMP("PSB1",$JOB,DFN,J),U,2)
+9 SET PSBHDST=$PIECE(^TMP("PSB1",$JOB,DFN,J),U)
+10 SET PSBOFDT=$PIECE(^TMP("PSB1",$JOB,DFN,J),U,4)
+11 SET PSBOFST=$PIECE(^TMP("PSB1",$JOB,DFN,J),U,3)
+12 IF PSBDT>PSBHDDT
IF PSBHDST="HOLD"
IF PSBOFST'=""
IF PSBDT<PSBOFDT
IF PSBOFST="OFF HOLD"
SET PSBFLAG=2
SET PSBUNHD=PSBOFDT
+13 IF PSBDT>PSBHDDT
IF PSBHDST="HOLD"
IF PSBOFST=""
SET PSBFLAG=1
End DoDot:2
End DoDot:1
+14 KILL PSBCNT,TMP("PSB1",$JOB)
+15 SET PSBOITX2=PSBOITX
+16 IF $DATA(^TMP("PSB",$JOB,DFN,PSBDT,"* "_PSBOITX,PSBONX))
SET PSBOITX="* "_PSBOITX
+17 IF PSBFLAG=1
SET ^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX)="(On Hold) "_$$DTFMT(PSBHDDT)
+18 IF PSBFLAG=2
SET ^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX)="(On Hold) "_$$DTFMT(PSBHDDT)_" "_"(Off Hold) "_$$DTFMT(PSBUNHD)
+19 SET PSBOITX=PSBOITX2
+20 QUIT
+21 ;
UDONE ;
+1 SET PSBFLAG=0
SET J=1
+2 FOR I=1:1:$PIECE(PSBOACTL(0),U,4)
Begin DoDot:1
+3 IF $PIECE($GET(PSBOACTL(I,1)),U,4)["ON HOLD"!($PIECE($GET(PSBOACTL(I,1)),U,4)="HOLD")
SET ^TMP("PSB1",$JOB,DFN,J)="HOLD"_U_$EXTRACT($PIECE($GET(PSBOACTL(I,1)),U,1),1,12)
+4 IF $PIECE($GET(PSBOACTL(I,1)),U,4)["TAKEN OFF HOLD"!($PIECE($GET(PSBOACTL(I,1)),U,4)["UNHOLD")
SET $PIECE(^TMP("PSB1",$JOB,DFN,J),U,3)="OFF HOLD"_U_$EXTRACT($PIECE($GET(PSBOACTL(I,1)),U,1),1,12)
SET J=J+1
End DoDot:1
+5 if $DATA(^TMP("PSB1",$JOB,DFN))&($PIECE(PSBOACTL(0),U,4)'=1)
Begin DoDot:1
+6 SET J=""
FOR
SET J=$ORDER(^TMP("PSB1",$JOB,DFN,J))
if 'J
QUIT
if PSBFLAG
QUIT
Begin DoDot:2
+7 SET PSBHDDT=$PIECE(^TMP("PSB1",$JOB,DFN,J),U,2)
+8 SET PSBHDST=$PIECE(^TMP("PSB1",$JOB,DFN,J),U)
+9 SET PSBOFDT=$PIECE(^TMP("PSB1",$JOB,DFN,J),U,4)
+10 SET PSBOFST=$PIECE(^TMP("PSB1",$JOB,DFN,J),U,3)
+11 IF PSBOSTS="A"
IF PSBHDST="HOLD"
IF PSBOFST'=""
IF '$DATA(^TMP("PSB1",$JOB,DFN,J+1))
IF PSBSTOP>PSBOFDT
IF PSBOFST="OFF HOLD"
SET PSBFLAG=2
SET PSBUNHD=PSBOFDT
+12 IF PSBOSTS="A"
IF PSBHDST="HOLD"
IF PSBOFST'=""
IF PSBOFDT'<PSBSTOP
SET PSBFLAG=1
+13 IF PSBOSTS="H"
IF PSBHDST="HOLD"
IF '$DATA(^TMP("PSB1",$JOB,DFN,J+1))
SET PSBFLAG=1
End DoDot:2
End DoDot:1
+14 KILL PSBCNT,^TMP("PSB1",$JOB)
+15 SET PSBOITX2=PSBOITX
+16 IF $DATA(^TMP("PSB",$JOB,DFN,PSBDT,"* "_PSBOITX,PSBONX))
SET PSBOITX="* "_PSBOITX
+17 IF PSBFLAG=1
SET ^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX)="(On Hold) "_$$DTFMT(PSBHDDT)
+18 IF PSBFLAG=2
SET ^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX)="(On Hold) "_$$DTFMT(PSBHDDT)_" "_"(Off Hold) "_$$DTFMT(PSBUNHD)
+19 SET PSBOITX=PSBOITX2
+20 QUIT
GCMNTS(XIEN) ;
+1 if '$DATA(^PSB(53.79,XIEN,.3,1))
QUIT
+2 NEW X
+3 SET X=$ORDER(^PSB(53.79,XIEN,.3,""),-1)
if +X=0
QUIT
SET ^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX,.3)="Comment: "_$PIECE(^PSB(53.79,XIEN,.3,X,0),U)
+4 QUIT
PARTG1(XIEN) ;
+1 IF $DATA(^PSB(53.79,XIEN))
Begin DoDot:1
+2 SET PSBSTUS=$PIECE(^PSB(53.79,XIEN,0),U,9)
+3 IF PSBOCRIT[PSBOSTS
IF PSBACRIT[PSBSTUS
Begin DoDot:2
+4 IF (PSBSTUS="G")&$DATA(^PSB(53.79,XIEN,.5))
Begin DoDot:3
+5 SET X=0
FOR
SET X=$ORDER(^PSB(53.79,XIEN,.5,X))
if +X=0
QUIT
Begin DoDot:4
+6 IF $PIECE(^PSB(53.79,XIEN,.5,X,0),U,2)>$PIECE(^PSB(53.79,XIEN,.5,X,0),U,3)
Begin DoDot:5
+7 SET PSBOITX="* "_PSBOITX
SET ^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX,"X")="Units Ordered: "_$PIECE(^PSB(53.79,XIEN,.5,X,0),U,2)_" Units Given: "_$PIECE(^PSB(53.79,XIEN,.5,X,0),U,3)_" Admin. Status: * Partial (Given)"
+8 IF PSBINCC
DO GCMNTS(XIEN)
End DoDot:5
SET PSBOITX=$EXTRACT(PSBOITX,3,999)
SET PSBGVN=0
End DoDot:4
End DoDot:3
+9 IF PSBSTUS'="G"
Begin DoDot:3
+10 IF PSBACRIT[PSBSTUS
SET ^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX,"X")="Admin. Status: ("_$SELECT(PSBSTUS="":" *UNKNOWN* ",PSBSTUS="M":"Missing Dose",PSBSTUS="H":"Held",PSBSTUS="R":"Refused")_")"
+11 IF PSBINCC
DO GCMNTS(XIEN)
End DoDot:3
SET PSBGVN=0
End DoDot:2
SET PSBEXST=1
QUIT
End DoDot:1
+12 QUIT
LN1 ;
+1 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","-")
+2 QUIT
DEFLT ;
+1 SET PSBFUTR=$TRANSLATE(PSBRPT(1),"~","^")
+2 if PSBRPT(1)]""
QUIT
+3 ;default MM Report settings Per GUI MM report...
SET PSBFUTR="^^^^1^^1^1^^^^^^^^1^1^1"
+4 SET X01=""
+5 DO RPC^PSBPAR(.X01,"GETPAR","ALL","PSB RPT INCL COMMENTS")
+6 SET $PIECE(PSBRPT(.2),U,8)=+X01(0)
+7 KILL PSBSTOP
SET PSBSTOP=$PIECE(PSBRPT(.1),U,6)+$PIECE(PSBRPT(.1),U,9)
+8 QUIT
DTFMT(DT) ;
+1 NEW Y,X
+2 IF +DT'>0
SET DTFMT=DT
QUIT DTFMT
+3 SET Y=DT
SET X=$EXTRACT($PIECE(Y,".",2)_"0000",1,4)
+4 SET DTFMT=$TRANSLATE($JUSTIFY(+$EXTRACT(Y,4,5),2)_"/"_$JUSTIFY(+$EXTRACT(Y,6,7),2)_"/"_($EXTRACT(Y,1,3)+1700)," ","0")_"@"_X
+5 QUIT DTFMT
+6 ;
CLINIC ;Clinic report *106
+1 WRITE $$CLNHDR()
+2 IF '$ORDER(^TMP("PSB",$JOB,0))
WRITE !,"No Missed Medications Found"
QUIT
+3 SET PSBSORT=$PIECE(PSBRPT(.1),U,5)
+4 FOR DFN=0:0
SET DFN=$ORDER(^TMP("PSB",$JOB,DFN))
if 'DFN
QUIT
Begin DoDot:1
+5 SET PSBDX=$SELECT(PSBSORT="P":$PIECE(^DPT(DFN,0),U),1:$GET(^DPT(DFN,.1))_" "_$GET(^(.101)))
+6 if PSBDX=""
SET PSBDX=$PIECE(^DPT(DFN,0),U)
+7 SET ^TMP("PSB",$JOB,"B",PSBDX,DFN)=""
End DoDot:1
+8 SET PSBDX=""
+9 FOR
SET PSBDX=$ORDER(^TMP("PSB",$JOB,"B",PSBDX))
if PSBDX=""
QUIT
Begin DoDot:1
+10 FOR DFN=0:0
SET DFN=$ORDER(^TMP("PSB",$JOB,"B",PSBDX,DFN))
if 'DFN
QUIT
Begin DoDot:2
+11 WRITE !
+12 SET PSBDT=""
+13 FOR
SET PSBDT=$ORDER(^TMP("PSB",$JOB,DFN,PSBDT))
if PSBDT=""
QUIT
Begin DoDot:3
+14 WRITE !
+15 ;reset held/refused to prevent line feed
KILL VAR1,VAR2,VAR3
+16 if PSBDT["ONE-TIME"
WRITE !
+17 SET PSBOITX=""
+18 FOR
SET PSBOITX=$ORDER(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX))
if PSBOITX=""
QUIT
Begin DoDot:4
+19 SET PSBONX=""
+20 FOR
SET PSBONX=$ORDER(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX))
if PSBONX=""
QUIT
Begin DoDot:5
+21 ;if previously held/refused lines printed, need line feed *58
+22 IF ($GET(VAR1)]"")!($GET(VAR2)]"")!($GET(VAR3)]"")
if '$GET(RMV)
WRITE !
KILL RMV
+23 KILL VAR1,VAR2,VAR3,SP
IF $Y>(IOSL-9)
WRITE $$CLNHDR()
+24 DO PSJ1^PSBVT(DFN,PSBONX)
+25 SET PSBVNI=$SELECT(PSBVNI]"":PSBVNI,1:"***")
+26 ; print remove line 1st *83
+27 SET RMV=0
+28 if $DATA(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX,"RM"))
Begin DoDot:6
+29 WRITE !,$ORDER(PSBS(DFN,PSBONX,"")),?11,PSBVNI,?17,$PIECE(^DPT(DFN,0),U)
+30 WRITE ?49,$SELECT(+PSBDT>0:$$DTFMT^PSBOMM2(PSBDT),1:PSBDT),?66,PSBOITX
+31 WRITE ?103,PSBCLORD
+32 WRITE !,?69,"(Remove)"
SET RMV=1
End DoDot:6
+33 ;print Give if exists for a RM just printed, or no RM printed
+34 IF 'RMV!(RMV&$DATA(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX))=11)
Begin DoDot:6
+35 WRITE !,$ORDER(PSBS(DFN,PSBONX,"")),?11,PSBVNI,?17,$PIECE(^DPT(DFN,0),U)
+36 if PSBDT'["ONE-TIME"
WRITE ?49,$SELECT(+PSBDT>0:$$DTFMT^PSBOMM2(PSBDT),1:PSBDT),?66,PSBOITX
+37 if PSBDT'["ONE-TIME"
WRITE ?103,PSBCLORD
End DoDot:6
+38 ;*106 adds the hazardous handle/dispose notices
+39 IF (PSBHAZDS=1)!(PSBHAZHN=1)
WRITE !
+40 ;*106 hazhn
IF PSBHAZHN=1
WRITE ?92,"<<HAZ HANDLE>> "
+41 ;*106 hazds, if hazhn printed 1st, then this will print after that and not at 92, desired.
IF PSBHAZDS=1
WRITE ?92,"<<HAZ DISPOSE>>"
+42 SET VAR1=$GET(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX))
+43 SET VAR2=$GET(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX,"X"))
+44 SET VAR3=$GET(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX,.3))
+45 IF PSBDT["ONE-TIME"
Begin DoDot:6
+46 WRITE !,PSBDT,?37,PSBOITX
SET SP=1
if PSBCLINORD
WRITE ?103,PSBCLORD
+47 IF VAR1]""
WRITE !,?37,$PIECE(VAR1,U,1)
SET SP=1
+48 IF VAR2]""
if $GET(SP)
WRITE !
WRITE ?37,VAR2
+49 IF VAR3]""
WRITE !,$$WRAP^PSBO(37,102,VAR3)
+50 ;DFN added to PSBSTXT array in PSB*3*52
WRITE !?3,"Start Date/Time: ",?21,$ORDER(PSBSTXT(PSBONX,DFN,""))
+51 ;DFN added to PSBSTXP array in PSB*3*52
WRITE !?3,"Stop Date/Time: ",?21,$ORDER(PSBSTXP(PSBONX,DFN,""))
+52 WRITE !
End DoDot:6
QUIT
+53 ;detail line additional info
+54 SET SP=1
+55 IF VAR1]""
WRITE !,?57,VAR1
SET SP=1
+56 IF VAR2]""
if $GET(SP)
WRITE !
WRITE ?57,VAR2
+57 IF VAR3]""
WRITE !,$$WRAP^PSBO(57,82,VAR3)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+58 QUIT
+59 ;
CLNHDR() ; *106
+1 DO CLINIC^PSBOHDR(.PSBRPT,.PSBHDR,,,PSBSRCHL)
+2 WRITE !,"Order Sts",?11,"Ver",?17,"Patient",?49,"Missed Date/Time",?66,"Medication",?103,"Location"
+3 DO LN1^PSBOMM2
+4 QUIT ""
