PSBOMM ;BIRMINGHAM/EFC-MISSED MEDS ;07-Feb-2013 10:04;PLS
;;3.0;BAR CODE MED ADMIN;**1005,26,32,1010,56,1015**;Mar 2004;Build 62
;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
; Modified - IHS/MSC/PLS - 02/22/07 - Line PRINT+56
;
; Reference/IA
; ^DPT/10035
; EN^PSJBCMA/2828
; EN^PSJBCMA2/2830
EN ;
N PSBSTRT,PSBSTOP,DFN,PSBODATE,PSBFLAG,PSBCNT,PSBEDIT,PSBFUTR
S PSBSTART=$P(PSBRPT(.1),U,6)+$P(PSBRPT(.1),U,7),PSBSTOP=$P(PSBRPT(.1),U,8)+$P(PSBRPT(.1),U,9)
D DEFLT^PSBOMM2
K PSBOCRIT,PSBACRIT,PSBS
S PSBOCRIT="^A^H^O" ;PSB*3*56 Adds the On Call Status to the Missed Meds Report
S:$P(PSBFUTR,U,8) PSBOCRIT=PSBOCRIT_"^D^DE" S:$P(PSBFUTR,U,7) PSBOCRIT=PSBOCRIT_"^E"
S PSBACRIT="MG"
S:$P(PSBFUTR,U,17) PSBACRIT=PSBACRIT_"H" S:$P(PSBFUTR,U,18) PSBACRIT=PSBACRIT_"R"
S PSBINCC=0 S:$P(PSBRPT(.2),U,8) PSBINCC=1
K ^TMP("PSJ",$J),^TMP("PSB",$J),^TMP("PSB1",$J)
S PSBSTRT=$P(PSBRPT(.1),U,6)+$P(PSBRPT(.1),U,7)-.0000001
F DFN=0:0 S DFN=$O(^TMP("PSBO",$J,DFN)) Q:'DFN D EN1
D PRINT
K ^TMP("PSJ",$J),^TMP("PSB",$J),^TMP("PSBO",$J),PSBS
Q
EN1 ;
N PSBGBL,PSBHDR,PSBX,PSBDFN,PSBDT,PSBEVDT,PSBH
K ^TMP("PSJ",$J) S PSBEVDT=PSBSTRT
D EN^PSJBCMA(DFN,PSBSTRT)
Q:^TMP("PSJ",$J,1,0)=-1
S PSBX=""
F S PSBX=$O(^TMP("PSJ",$J,PSBX)) Q:PSBX="" D
.Q:^TMP("PSJ",$J,PSBX,0)=-1
.D NOW^%DTC
.D CLEAN^PSBVT
.D PSJ^PSBVT(PSBX)
.Q:PSBIVT="A"
.Q:PSBIVT="H"
.I PSBIVT["S",PSBISYR'=1 Q
.I PSBIVT["C",PSBCHEMT'="P",PSBISYR'=1 Q
.I PSBIVT["C",PSBCHEMT="A" Q
.Q:PSBONX["P"
.Q:PSBOSP<PSBSTART
.I %>PSBOSP,PSBOSTS'="D",PSBOSTS'="DE",PSBOSTS'="H" S PSBOSTS="E"
.I PSBSCHT="C" D Q
..S (PSBYES,PSBODD)=0
..S PSBDOW="SU^MO^TU^WE^TH^FR^SA" F I=1:1:7 I $P(PSBDOW,"^",I)=$E(PSBSCH,1,2) S PSBYES=1
..I PSBYES,PSBADST="" Q
..F I=1:1 Q:$P(PSBSCH,"-",I)="" I $P(PSBSCH,"-",I)?2N!($P(PSBSCH,"-",I)?4N) S PSBYES=1
..S PSBFREQ=$$GETFREQ^PSBVDLU1(DFN,PSBONX)
..I PSBFREQ="O" S PSBYES=1,PSBFREQ=1440
..I 'PSBYES,PSBADST="",PSBFREQ<1 Q
..I (PSBFREQ#1440'=0),(1440#PSBFREQ'=0) S PSBODD=1
..I PSBODD,PSBADST'="" Q
..Q:PSBOCRIT'[PSBOSTS
..Q:PSBNGF
..Q:PSBOSTS="N"
..Q:PSBSM
..S PSBS(DFN,PSBONX,$S(PSBOSTS="A":"Active",PSBOSTS="H":"On Hold",PSBOSTS="D":"DC'd",PSBOSTS="DE":"DC'd (Edit)",PSBOSTS="E":"Expired",PSBOSTS="O":"On Call",1:" *Unknown* "))=""
..S PSBSTXP(PSBONX,$$DTFMT^PSBOMM2(PSBOSP))=""
..S PSBCADM=0
..I PSBADST="" D Q:$G(PSBADST)="" S PSBCADM=1
...S X=PSBOST D H^%DTC S X1=((%H*24)*60)+(%T/60)
...S X=PSBSTRT,X3=0 D H^%DTC S X2=((%H*24)*60)+(%T/60)
...I X2'<X1 S X3=X2-X1 S PSBOST=$$FMADD^XLFDT(PSBSTRT,,,(-1*(X3#PSBFREQ)))
...K PSBADST S PSBOST2=PSBOST,PSBDT2=PSBSTRT
...F XZ=0:1 S PSBADST(XZ,PSBDT2)=$$GETADMIN^PSBVDLU1(DFN,PSBONX,PSBOST2,PSBFREQ,PSBDT2) D Q:PSBDT2>PSBSTOP
....I ($L(PSBADST(XZ,PSBDT2),"-")>$L($G(PSBADST),"-"))!($G(PSBADST)="") S PSBADST=PSBADST(XZ,PSBDT2)
....S Z=PSBDT2\1,J=$P(PSBADST(XZ,PSBDT2),"-",($L(PSBADST(XZ,PSBDT2),"-"))) S:J]"" PSBOST2=Z_"."_J
....S PSBDT2=($$FMADD^XLFDT(Z,1))+.2400
....S PSBDT2=$S($G(FLG):(PSBSTOP\1)+.2401,PSBDT2>PSBOSP:PSBOSP,1:PSBDT2) K FLG I PSBDT2=PSBOSP S FLG=1
..S Z=PSBADST I Z]"" K ^TMP("PSB",$J,"GETADMIN") S ^TMP("PSB",$J,"GETADMIN",0)=Z
..F Y=1:1:$L(Z,"-") D
...Q:($P(Z,"-",Y)'?2N)&($P(Z,"-",Y)'?4N)
..K PSBOACTL,^TMP("PSB1",$J) D EN^PSJBCMA2(DFN,PSBONX,1) I ^TMP("PSJ2",$J,0)'=1 M PSBOACTL=^TMP("PSJ2",$J) K ^TMP("PSJ2",$J)
..I 'PSBODD F XX=0:1 Q:'$D(^TMP("PSB",$J,"GETADMIN",XX)) S (PSBADST,Z)=$G(^TMP("PSB",$J,"GETADMIN",XX)) D
...D MISSED^PSBOMM2(Z,.PSBEDIT,PSBSTRT)
..I PSBODD F XX=0:1 Q:'$D(PSBADST(XX)) S XXX=$O(PSBADST(XX,"")) S (PSBADST,Z)=PSBADST(XX,XXX) D
...I Z]"" D MISSED^PSBOMM2(Z,.PSBEDIT,XXX)
.K PSBHDDT,PSBUNHD,^TMP("PSB1",$J)
.I PSBSCHT="O" D Q
..Q:PSBOSTS="N"
..Q:PSBNGF
..Q:PSBSM
..Q:(PSBOSP=PSBOST)&(PSBOCRIT'["E")
..Q:PSBOST'<PSBSTOP
..S PSBDT="*** ONE-TIME ***"
..S (PSBSTXP(PSBONX,$$DTFMT^PSBOMM2(PSBOSP)),PSBSTXT(PSBONX,$$DTFMT^PSBOMM2(PSBOST)))=""
..S (PSBG,X,Y,PSBXSTS)="" K PSBEXST
..F S X=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,X),-1) Q:'X D
...F S Y=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,X,Y),-1) Q:'Y D
....S PSBXSTS=$P(^PSB(53.79,Y,0),U,9)
....I $P(^PSB(53.79,Y,.1),U)=PSBONX,PSBXSTS'="N",PSBXSTS'="M" S PSBG=1,PSBG(PSBONX,Y)="",(X,Y)=0
..I PSBG D PARTG1^PSBOMM2($O(PSBG(PSBONX,"")))
..D NOW^%DTC
..Q:(PSBOCRIT'[PSBOSTS)
..S PSBS(DFN,PSBONX,$S(PSBOSTS="A":"Active",PSBOSTS="H":"On Hold",PSBOSTS="D":"DC'd",PSBOSTS="DE":"DC'd (Edit)",PSBOSTS="E":"Expired",PSBOSTS="O":"On Call",1:" * ERROR * "))=""
..D:'PSBG!(PSBACRIT[$G(PSBXSTS,1))
...S VAR=""
...K ^TMP("PSJ2",$J),^TMP("PSB1",$J),PSBOACTL D EN^PSJBCMA2(DFN,PSBONX,1) I ^TMP("PSJ2",$J,0)'=1 D
....M PSBOACTL=^TMP("PSJ2",$J)
....D UDONE^PSBOMM2
....I PSBFLAG=1 S VAR="(On Hold) "_$$DTFMT^PSBOMM2(PSBHDDT)
....I PSBFLAG=2 S VAR="(On Hold) "_$$DTFMT^PSBOMM2(PSBHDDT)_" (Off Hold) "_$$DTFMT^PSBOMM2(PSBUNHD)
...I '$G(PSBEXST,0)!(PSBXSTS="M") S $P(^TMP("PSB",$J,DFN,"*** ONE-TIME ***",PSBOITX,PSBONX),U,1,4)=VAR
...I $G(PSBEXST,0) D
....S VAR1=$G(^TMP("PSB",$J,DFN,"*** ONE-TIME ***","* "_PSBOITX,PSBONX)) I VAR1]"" S $P(VAR1,U,1,4)=VAR_VAR1
...K PSBHDDT,PSBUNHD,^TMP("PSB1",$J),PSBCNT
K PSBOACTL
Q
PRINT ;
N PSBHDR,PSBDT,PSBOITX,PSBONX,DFN
K PSBNPG
S Y=$S($P(PSBRPT(.1),U,8)]"":$P(PSBRPT(.1),U,8),1:$P(PSBRPT(.1),U,6))
D:$P(PSBRPT(.1),U,1)="P"
.S PSBHDR(1)="MISSED MEDICATIONS REPORT for "_$$FMTE^XLFDT($P(PSBRPT(.1),U,6)+$P(PSBRPT(.1),U,7))_" to "_$$FMTE^XLFDT(Y+$P(PSBRPT(.1),U,9))
.S PSBHDR(2)="Order Status(es): --"
.F Y=5,8,7 I $P(PSBFUTR,U,Y) S $P(PSBHDR(2),": ",2)=$P(PSBHDR(2),": ",2)_$S(PSBHDR(2)["--":"",1:"/ ")_$P("^^^^Active^^Expired^DC'd^^^^^^^^^^",U,Y)_" " S PSBHDR(2)=$TR(PSBHDR(2),"-","")
.S PSBHDR(3)="Admin Status(es): --"
.F Y=16,17,18 I $P(PSBFUTR,U,Y) S $P(PSBHDR(3),": ",2)=$P(PSBHDR(3),": ",2)_$S(PSBHDR(3)["--":"",1:"/ ")_$P("^^^^^^^^^^^^^^^Missing Dose^Held^Refused",U,Y)_" " S PSBHDR(3)=$TR(PSBHDR(3),"-","")
.I PSBINCC S PSBHDR(4)="Include Comments/Reasons"
.S DFN=$P(PSBRPT(.1),U,2)
.W $$PTHDR()
.I $G(PSBEDIT) W !?7,"*Administration Times have been edited*"
.I $O(^TMP("PSB",$J,DFN,""))="" W !,"No Missed Medications Found",$$PTFTR^PSBOHDR() Q
.S PSBDT=""
.F S PSBDT=$O(^TMP("PSB",$J,DFN,PSBDT)) Q:PSBDT="" D
..W !
..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
....K VAR1,VAR2,VAR3,SP I $Y>(IOSL-9) W $$PTFTR^PSBOHDR(),$$PTHDR()
....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 !
.....W !,$O(PSBS(DFN,PSBONX,"")),?15,PSBDT,?43,PSBOITX,!
.....I VAR1]"" W ?43,VAR1 S SP=1
.....I VAR2]"" W:$G(SP) ! W ?43,VAR2
.....I VAR3]"" W !,$$WRAP^PSBO(43,80,VAR3)
.....W !,"Start Date/Time: ",?18,$O(PSBSTXT(PSBONX,""))
.....W !,"Stop Date/Time: ",?18,$O(PSBSTXP(PSBONX,""))
....W !,$O(PSBS(DFN,PSBONX,"")),?15,$S(+PSBDT>0:$$DTFMT^PSBOMM2(PSBDT),1:PSBDT),?43,PSBOITX,?95,$O(PSBSTXP(PSBONX,"")),!
....I VAR1]"" W ?43,VAR1 S SP=1
....I VAR2]"" W:$G(SP) ! W ?43,VAR2
....I VAR3]"" W !,$$WRAP^PSBO(43,80,VAR3)
.W $$PTFTR^PSBOHDR()
.Q
D:$P(PSBRPT(.1),U,1)="W"
.S PSBHDR(1)="MISSED MEDICATIONS REPORT for "_$$FMTE^XLFDT($P(PSBRPT(.1),U,6)+$P(PSBRPT(.1),U,7))_" to "_$$FMTE^XLFDT(Y+$P(PSBRPT(.1),U,9))
.S PSBHDR(2)="Order Status(es): --"
.F Y=5,7,8 I $P(PSBFUTR,U,Y) S $P(PSBHDR(2),": ",2)=$P(PSBHDR(2),": ",2)_$S(PSBHDR(2)["--":"",1:"/ ")_$P("^^^^Active^^Expired^DC'd^^^^^^^^^^",U,Y)_" " S PSBHDR(2)=$TR(PSBHDR(2),"-","")
.S PSBHDR(3)="Admin Status(es): --"
.F Y=16,17,18 I $P(PSBFUTR,U,Y) S $P(PSBHDR(3),": ",2)=$P(PSBHDR(3),": ",2)_$S(PSBHDR(3)["--":"",1:"/ ")_$P("^^^^^^^^^^^^^^^Missing Dose^Held^Refused",U,Y)_" " S PSBHDR(3)=$TR(PSBHDR(3),"-","")
.I PSBINCC S PSBHDR(4)="Include Comments/Reasons"
.S PSBWARD=$P(PSBRPT(.1),U,3)
.W $$WRDHDR()
.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 !
....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
......K VAR1,VAR2,VAR3,SP I $Y>(IOSL-9) W $$WRDHDR()
......W !,$O(PSBS(DFN,PSBONX,"")),?15,$G(^DPT(DFN,.101),"**") ;,?35,$P(^DPT(DFN,0),U)," (",$E($P(^(0),U,9),6,9),")"
......; IHS/MSC/PLS - 02/22/07
......W ?35,$P(^DPT(DFN,0),U)," (",$$PTID^PSBOML(DFN,1),")"
......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,?30,PSBOITX S SP=1
.......I VAR1]"" W !,?30,$P(VAR1,U,1) S SP=1
.......I VAR2]"" W:$G(SP) ! W ?30,VAR2
.......I VAR3]"" W !,$$WRAP^PSBO(30,95,VAR3)
.......W !,"Start Date/Time: ",?18,$O(PSBSTXT(PSBONX,""))
.......W !,"Stop Date/Time: ",?18,$O(PSBSTXP(PSBONX,""))
.......W !
......W ?67,$S(+PSBDT>0:$$DTFMT^PSBOMM2(PSBDT),1:PSBDT),?85,PSBOITX S SP=1
......I VAR1]"" W !,?50,VAR1 S SP=1
......I VAR2]"" W:$G(SP) ! W ?50,VAR2
......I VAR3]"" W !,$$WRAP^PSBO(50,75,VAR3)
Q
WRDHDR() ;
D WARD^PSBOHDR(PSBWRD,.PSBHDR)
W !,"Order Status",?15,"Room-Bed",?35,"Patient",?67,"Admin Date/Time",?85,"Medication"
D LN1^PSBOMM2
Q ""
PTHDR() ;
D PT^PSBOHDR(DFN,.PSBHDR)
W !,"Order Status",?15,"Administration Date/Time",?43,"Medication",?95,"Order Stop Date"
D LN1^PSBOMM2
Q ""
PSBOMM ;BIRMINGHAM/EFC-MISSED MEDS ;07-Feb-2013 10:04;PLS
+1 ;;3.0;BAR CODE MED ADMIN;**1005,26,32,1010,56,1015**;Mar 2004;Build 62
+2 ;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
+3 ; Modified - IHS/MSC/PLS - 02/22/07 - Line PRINT+56
+4 ;
+5 ; Reference/IA
+6 ; ^DPT/10035
+7 ; EN^PSJBCMA/2828
+8 ; EN^PSJBCMA2/2830
EN ;
+1 NEW PSBSTRT,PSBSTOP,DFN,PSBODATE,PSBFLAG,PSBCNT,PSBEDIT,PSBFUTR
+2 SET PSBSTART=$PIECE(PSBRPT(.1),U,6)+$PIECE(PSBRPT(.1),U,7)
SET PSBSTOP=$PIECE(PSBRPT(.1),U,8)+$PIECE(PSBRPT(.1),U,9)
+3 DO DEFLT^PSBOMM2
+4 KILL PSBOCRIT,PSBACRIT,PSBS
+5 ;PSB*3*56 Adds the On Call Status to the Missed Meds Report
SET PSBOCRIT="^A^H^O"
+6 IF $PIECE(PSBFUTR,U,8)
SET PSBOCRIT=PSBOCRIT_"^D^DE"
IF $PIECE(PSBFUTR,U,7)
SET PSBOCRIT=PSBOCRIT_"^E"
+7 SET PSBACRIT="MG"
+8 IF $PIECE(PSBFUTR,U,17)
SET PSBACRIT=PSBACRIT_"H"
IF $PIECE(PSBFUTR,U,18)
SET PSBACRIT=PSBACRIT_"R"
+9 SET PSBINCC=0
IF $PIECE(PSBRPT(.2),U,8)
SET PSBINCC=1
+10 KILL ^TMP("PSJ",$JOB),^TMP("PSB",$JOB),^TMP("PSB1",$JOB)
+11 SET PSBSTRT=$PIECE(PSBRPT(.1),U,6)+$PIECE(PSBRPT(.1),U,7)-.0000001
+12 FOR DFN=0:0
SET DFN=$ORDER(^TMP("PSBO",$JOB,DFN))
IF 'DFN
QUIT
DO EN1
+13 DO PRINT
+14 KILL ^TMP("PSJ",$JOB),^TMP("PSB",$JOB),^TMP("PSBO",$JOB),PSBS
+15 QUIT
EN1 ;
+1 NEW PSBGBL,PSBHDR,PSBX,PSBDFN,PSBDT,PSBEVDT,PSBH
+2 KILL ^TMP("PSJ",$JOB)
SET PSBEVDT=PSBSTRT
+3 DO EN^PSJBCMA(DFN,PSBSTRT)
+4 IF ^TMP("PSJ",$JOB,1,0)=-1
QUIT
+5 SET PSBX=""
+6 FOR
SET PSBX=$ORDER(^TMP("PSJ",$JOB,PSBX))
IF PSBX=""
QUIT
Begin DoDot:1
+7 IF ^TMP("PSJ",$JOB,PSBX,0)=-1
QUIT
+8 DO NOW^%DTC
+9 DO CLEAN^PSBVT
+10 DO PSJ^PSBVT(PSBX)
+11 IF PSBIVT="A"
QUIT
+12 IF PSBIVT="H"
QUIT
+13 IF PSBIVT["S"
IF PSBISYR'=1
QUIT
+14 IF PSBIVT["C"
IF PSBCHEMT'="P"
IF PSBISYR'=1
QUIT
+15 IF PSBIVT["C"
IF PSBCHEMT="A"
QUIT
+16 IF PSBONX["P"
QUIT
+17 IF PSBOSP<PSBSTART
QUIT
+18 IF %>PSBOSP
IF PSBOSTS'="D"
IF PSBOSTS'="DE"
IF PSBOSTS'="H"
SET PSBOSTS="E"
+19 IF PSBSCHT="C"
Begin DoDot:2
+20 SET (PSBYES,PSBODD)=0
+21 SET PSBDOW="SU^MO^TU^WE^TH^FR^SA"
FOR I=1:1:7
IF $PIECE(PSBDOW,"^",I)=$EXTRACT(PSBSCH,1,2)
SET PSBYES=1
+22 IF PSBYES
IF PSBADST=""
QUIT
+23 FOR I=1:1
IF $PIECE(PSBSCH,"-",I)=""
QUIT
IF $PIECE(PSBSCH,"-",I)?2N!($PIECE(PSBSCH,"-",I)?4N)
SET PSBYES=1
+24 SET PSBFREQ=$$GETFREQ^PSBVDLU1(DFN,PSBONX)
+25 IF PSBFREQ="O"
SET PSBYES=1
SET PSBFREQ=1440
+26 IF 'PSBYES
IF PSBADST=""
IF PSBFREQ<1
QUIT
+27 IF (PSBFREQ#1440'=0)
IF (1440#PSBFREQ'=0)
SET PSBODD=1
+28 IF PSBODD
IF PSBADST'=""
QUIT
+29 IF PSBOCRIT'[PSBOSTS
QUIT
+30 IF PSBNGF
QUIT
+31 IF PSBOSTS="N"
QUIT
+32 IF PSBSM
QUIT
+33 SET PSBS(DFN,PSBONX,$SELECT(PSBOSTS="A":"Active",PSBOSTS="H":"On Hold",PSBOSTS="D":"DC'd",PSBOSTS="DE":"DC'd (Edit)",PSBOSTS="E":"Expired",PSBOSTS="O":"On Call",1:" *Unknown* "))=""
+34 SET PSBSTXP(PSBONX,$$DTFMT^PSBOMM2(PSBOSP))=""
+35 SET PSBCADM=0
+36 IF PSBADST=""
Begin DoDot:3
+37 SET X=PSBOST
DO H^%DTC
SET X1=((%H*24)*60)+(%T/60)
+38 SET X=PSBSTRT
SET X3=0
DO H^%DTC
SET X2=((%H*24)*60)+(%T/60)
+39 IF X2'<X1
SET X3=X2-X1
SET PSBOST=$$FMADD^XLFDT(PSBSTRT,,,(-1*(X3#PSBFREQ)))
+40 KILL PSBADST
SET PSBOST2=PSBOST
SET PSBDT2=PSBSTRT
+41 FOR XZ=0:1
SET PSBADST(XZ,PSBDT2)=$$GETADMIN^PSBVDLU1(DFN,PSBONX,PSBOST2,PSBFREQ,PSBDT2)
Begin DoDot:4
+42 IF ($LENGTH(PSBADST(XZ,PSBDT2),"-")>$LENGTH($GET(PSBADST),"-"))!($GET(PSBADST)="")
SET PSBADST=PSBADST(XZ,PSBDT2)
+43 SET Z=PSBDT2\1
SET J=$PIECE(PSBADST(XZ,PSBDT2),"-",($LENGTH(PSBADST(XZ,PSBDT2),"-")))
IF J]""
SET PSBOST2=Z_"."_J
+44 SET PSBDT2=($$FMADD^XLFDT(Z,1))+.2400
+45 SET PSBDT2=$SELECT($GET(FLG):(PSBSTOP\1)+.2401,PSBDT2>PSBOSP:PSBOSP,1:PSBDT2)
KILL FLG
IF PSBDT2=PSBOSP
SET FLG=1
End DoDot:4
IF PSBDT2>PSBSTOP
QUIT
End DoDot:3
IF $GET(PSBADST)=""
QUIT
SET PSBCADM=1
+46 SET Z=PSBADST
IF Z]""
KILL ^TMP("PSB",$JOB,"GETADMIN")
SET ^TMP("PSB",$JOB,"GETADMIN",0)=Z
+47 FOR Y=1:1:$LENGTH(Z,"-")
Begin DoDot:3
+48 IF ($PIECE(Z,"-",Y)'?2N)&($PIECE(Z,"-",Y)'?4N)
QUIT
End DoDot:3
+49 KILL PSBOACTL,^TMP("PSB1",$JOB)
DO EN^PSJBCMA2(DFN,PSBONX,1)
IF ^TMP("PSJ2",$JOB,0)'=1
MERGE PSBOACTL=^TMP("PSJ2",$JOB)
KILL ^TMP("PSJ2",$JOB)
+50 IF 'PSBODD
FOR XX=0:1
IF '$DATA(^TMP("PSB",$JOB,"GETADMIN",XX))
QUIT
SET (PSBADST,Z)=$GET(^TMP("PSB",$JOB,"GETADMIN",XX))
Begin DoDot:3
+51 DO MISSED^PSBOMM2(Z,.PSBEDIT,PSBSTRT)
End DoDot:3
+52 IF PSBODD
FOR XX=0:1
IF '$DATA(PSBADST(XX))
QUIT
SET XXX=$ORDER(PSBADST(XX,""))
SET (PSBADST,Z)=PSBADST(XX,XXX)
Begin DoDot:3
+53 IF Z]""
DO MISSED^PSBOMM2(Z,.PSBEDIT,XXX)
End DoDot:3
End DoDot:2
QUIT
+54 KILL PSBHDDT,PSBUNHD,^TMP("PSB1",$JOB)
+55 IF PSBSCHT="O"
Begin DoDot:2
+56 IF PSBOSTS="N"
QUIT
+57 IF PSBNGF
QUIT
+58 IF PSBSM
QUIT
+59 IF (PSBOSP=PSBOST)&(PSBOCRIT'["E")
QUIT
+60 IF PSBOST'<PSBSTOP
QUIT
+61 SET PSBDT="*** ONE-TIME ***"
+62 SET (PSBSTXP(PSBONX,$$DTFMT^PSBOMM2(PSBOSP)),PSBSTXT(PSBONX,$$DTFMT^PSBOMM2(PSBOST)))=""
+63 SET (PSBG,X,Y,PSBXSTS)=""
KILL PSBEXST
+64 FOR
SET X=$ORDER(^PSB(53.79,"AOIP",DFN,PSBOIT,X),-1)
IF 'X
QUIT
Begin DoDot:3
+65 FOR
SET Y=$ORDER(^PSB(53.79,"AOIP",DFN,PSBOIT,X,Y),-1)
IF 'Y
QUIT
Begin DoDot:4
+66 SET PSBXSTS=$PIECE(^PSB(53.79,Y,0),U,9)
+67 IF $PIECE(^PSB(53.79,Y,.1),U)=PSBONX
IF PSBXSTS'="N"
IF PSBXSTS'="M"
SET PSBG=1
SET PSBG(PSBONX,Y)=""
SET (X,Y)=0
End DoDot:4
End DoDot:3
+68 IF PSBG
DO PARTG1^PSBOMM2($ORDER(PSBG(PSBONX,"")))
+69 DO NOW^%DTC
+70 IF (PSBOCRIT'[PSBOSTS)
QUIT
+71 SET PSBS(DFN,PSBONX,$SELECT(PSBOSTS="A":"Active",PSBOSTS="H":"On Hold",PSBOSTS="D":"DC'd",PSBOSTS="DE":"DC'd (Edit)",PSBOSTS="E":"Expired",PSBOSTS="O":"On Call",1:" * ERROR * "))=""
+72 IF 'PSBG!(PSBACRIT[$GET(PSBXSTS,1))
Begin DoDot:3
+73 SET VAR=""
+74 KILL ^TMP("PSJ2",$JOB),^TMP("PSB1",$JOB),PSBOACTL
DO EN^PSJBCMA2(DFN,PSBONX,1)
IF ^TMP("PSJ2",$JOB,0)'=1
Begin DoDot:4
+75 MERGE PSBOACTL=^TMP("PSJ2",$JOB)
+76 DO UDONE^PSBOMM2
+77 IF PSBFLAG=1
SET VAR="(On Hold) "_$$DTFMT^PSBOMM2(PSBHDDT)
+78 IF PSBFLAG=2
SET VAR="(On Hold) "_$$DTFMT^PSBOMM2(PSBHDDT)_" (Off Hold) "_$$DTFMT^PSBOMM2(PSBUNHD)
End DoDot:4
+79 IF '$GET(PSBEXST,0)!(PSBXSTS="M")
SET $PIECE(^TMP("PSB",$JOB,DFN,"*** ONE-TIME ***",PSBOITX,PSBONX),U,1,4)=VAR
+80 IF $GET(PSBEXST,0)
Begin DoDot:4
+81 SET VAR1=$GET(^TMP("PSB",$JOB,DFN,"*** ONE-TIME ***","* "_PSBOITX,PSBONX))
IF VAR1]""
SET $PIECE(VAR1,U,1,4)=VAR_VAR1
End DoDot:4
+82 KILL PSBHDDT,PSBUNHD,^TMP("PSB1",$JOB),PSBCNT
End DoDot:3
End DoDot:2
QUIT
End DoDot:1
+83 KILL PSBOACTL
+84 QUIT
PRINT ;
+1 NEW PSBHDR,PSBDT,PSBOITX,PSBONX,DFN
+2 KILL PSBNPG
+3 SET Y=$SELECT($PIECE(PSBRPT(.1),U,8)]"":$PIECE(PSBRPT(.1),U,8),1:$PIECE(PSBRPT(.1),U,6))
+4 IF $PIECE(PSBRPT(.1),U,1)="P"
Begin DoDot:1
+5 SET PSBHDR(1)="MISSED MEDICATIONS REPORT for "_$$FMTE^XLFDT($PIECE(PSBRPT(.1),U,6)+$PIECE(PSBRPT(.1),U,7))_" to "_$$FMTE^XLFDT(Y+$PIECE(PSBRPT(.1),U,9))
+6 SET PSBHDR(2)="Order Status(es): --"
+7 FOR Y=5,8,7
IF $PIECE(PSBFUTR,U,Y)
SET $PIECE(PSBHDR(2),": ",2)=$PIECE(PSBHDR(2),": ",2)_$SELECT(PSBHDR(2)["--":"",1:"/ ")_$PIECE("^^^^Active^^Expired^DC'd^^^^^^^^^^",U,Y)_" "
SET PSBHDR(2)=$TRANSLATE(PSBHDR(2),"-","")
+8 SET PSBHDR(3)="Admin Status(es): --"
+9 FOR Y=16,17,18
IF $PIECE(PSBFUTR,U,Y)
SET $PIECE(PSBHDR(3),": ",2)=$PIECE(PSBHDR(3),": ",2)_$SELECT(PSBHDR(3)["--":"",1:"/ ")_$PIECE("^^^^^^^^^^^^^^^Missing Dose^Held^Refused",U,Y)_" "
SET PSBHDR(3)=$TRANSLATE(PSBHDR(3),"-","")
+10 IF PSBINCC
SET PSBHDR(4)="Include Comments/Reasons"
+11 SET DFN=$PIECE(PSBRPT(.1),U,2)
+12 WRITE $$PTHDR()
+13 IF $GET(PSBEDIT)
WRITE !?7,"*Administration Times have been edited*"
+14 IF $ORDER(^TMP("PSB",$JOB,DFN,""))=""
WRITE !,"No Missed Medications Found",$$PTFTR^PSBOHDR()
QUIT
+15 SET PSBDT=""
+16 FOR
SET PSBDT=$ORDER(^TMP("PSB",$JOB,DFN,PSBDT))
IF PSBDT=""
QUIT
Begin DoDot:2
+17 WRITE !
+18 SET PSBOITX=""
+19 FOR
SET PSBOITX=$ORDER(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX))
IF PSBOITX=""
QUIT
Begin DoDot:3
+20 SET PSBONX=""
+21 FOR
SET PSBONX=$ORDER(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX))
IF PSBONX=""
QUIT
Begin DoDot:4
+22 KILL VAR1,VAR2,VAR3,SP
IF $Y>(IOSL-9)
WRITE $$PTFTR^PSBOHDR(),$$PTHDR()
+23 SET VAR1=$GET(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX))
+24 SET VAR2=$GET(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX,"X"))
+25 SET VAR3=$GET(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX,.3))
+26 IF PSBDT["ONE-TIME"
Begin DoDot:5
+27 WRITE !
+28 WRITE !,$ORDER(PSBS(DFN,PSBONX,"")),?15,PSBDT,?43,PSBOITX,!
+29 IF VAR1]""
WRITE ?43,VAR1
SET SP=1
+30 IF VAR2]""
IF $GET(SP)
WRITE !
WRITE ?43,VAR2
+31 IF VAR3]""
WRITE !,$$WRAP^PSBO(43,80,VAR3)
+32 WRITE !,"Start Date/Time: ",?18,$ORDER(PSBSTXT(PSBONX,""))
+33 WRITE !,"Stop Date/Time: ",?18,$ORDER(PSBSTXP(PSBONX,""))
End DoDot:5
QUIT
+34 WRITE !,$ORDER(PSBS(DFN,PSBONX,"")),?15,$SELECT(+PSBDT>0:$$DTFMT^PSBOMM2(PSBDT),1:PSBDT),?43,PSBOITX,?95,$ORDER(PSBSTXP(PSBONX,"")),!
+35 IF VAR1]""
WRITE ?43,VAR1
SET SP=1
+36 IF VAR2]""
IF $GET(SP)
WRITE !
WRITE ?43,VAR2
+37 IF VAR3]""
WRITE !,$$WRAP^PSBO(43,80,VAR3)
End DoDot:4
End DoDot:3
End DoDot:2
+38 WRITE $$PTFTR^PSBOHDR()
+39 QUIT
End DoDot:1
+40 IF $PIECE(PSBRPT(.1),U,1)="W"
Begin DoDot:1
+41 SET PSBHDR(1)="MISSED MEDICATIONS REPORT for "_$$FMTE^XLFDT($PIECE(PSBRPT(.1),U,6)+$PIECE(PSBRPT(.1),U,7))_" to "_$$FMTE^XLFDT(Y+$PIECE(PSBRPT(.1),U,9))
+42 SET PSBHDR(2)="Order Status(es): --"
+43 FOR Y=5,7,8
IF $PIECE(PSBFUTR,U,Y)
SET $PIECE(PSBHDR(2),": ",2)=$PIECE(PSBHDR(2),": ",2)_$SELECT(PSBHDR(2)["--":"",1:"/ ")_$PIECE("^^^^Active^^Expired^DC'd^^^^^^^^^^",U,Y)_" "
SET PSBHDR(2)=$TRANSLATE(PSBHDR(2),"-","")
+44 SET PSBHDR(3)="Admin Status(es): --"
+45 FOR Y=16,17,18
IF $PIECE(PSBFUTR,U,Y)
SET $PIECE(PSBHDR(3),": ",2)=$PIECE(PSBHDR(3),": ",2)_$SELECT(PSBHDR(3)["--":"",1:"/ ")_$PIECE("^^^^^^^^^^^^^^^Missing Dose^Held^Refused",U,Y)_" "
SET PSBHDR(3)=$TRANSLATE(PSBHDR(3),"-","")
+46 IF PSBINCC
SET PSBHDR(4)="Include Comments/Reasons"
+47 SET PSBWARD=$PIECE(PSBRPT(.1),U,3)
+48 WRITE $$WRDHDR()
+49 IF '$ORDER(^TMP("PSB",$JOB,0))
WRITE !,"No Missed Medications Found"
QUIT
+50 SET PSBSORT=$PIECE(PSBRPT(.1),U,5)
+51 FOR DFN=0:0
SET DFN=$ORDER(^TMP("PSB",$JOB,DFN))
IF 'DFN
QUIT
Begin DoDot:2
+52 SET PSBDX=$SELECT(PSBSORT="P":$PIECE(^DPT(DFN,0),U),1:$GET(^DPT(DFN,.1))_" "_$GET(^(.101)))
+53 IF PSBDX=""
SET PSBDX=$PIECE(^DPT(DFN,0),U)
+54 SET ^TMP("PSB",$JOB,"B",PSBDX,DFN)=""
End DoDot:2
+55 SET PSBDX=""
+56 FOR
SET PSBDX=$ORDER(^TMP("PSB",$JOB,"B",PSBDX))
IF PSBDX=""
QUIT
Begin DoDot:2
+57 FOR DFN=0:0
SET DFN=$ORDER(^TMP("PSB",$JOB,"B",PSBDX,DFN))
IF 'DFN
QUIT
Begin DoDot:3
+58 WRITE !
+59 SET PSBDT=""
+60 FOR
SET PSBDT=$ORDER(^TMP("PSB",$JOB,DFN,PSBDT))
IF PSBDT=""
QUIT
Begin DoDot:4
+61 WRITE !
+62 IF PSBDT["ONE-TIME"
WRITE !
+63 SET PSBOITX=""
+64 FOR
SET PSBOITX=$ORDER(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX))
IF PSBOITX=""
QUIT
Begin DoDot:5
+65 SET PSBONX=""
+66 FOR
SET PSBONX=$ORDER(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX))
IF PSBONX=""
QUIT
Begin DoDot:6
+67 KILL VAR1,VAR2,VAR3,SP
IF $Y>(IOSL-9)
WRITE $$WRDHDR()
+68 ;,?35,$P(^DPT(DFN,0),U)," (",$E($P(^(0),U,9),6,9),")"
WRITE !,$ORDER(PSBS(DFN,PSBONX,"")),?15,$GET(^DPT(DFN,.101),"**")
+69 ; IHS/MSC/PLS - 02/22/07
+70 WRITE ?35,$PIECE(^DPT(DFN,0),U)," (",$$PTID^PSBOML(DFN,1),")"
+71 SET VAR1=$GET(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX))
+72 SET VAR2=$GET(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX,"X"))
+73 SET VAR3=$GET(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX,.3))
+74 IF PSBDT["ONE-TIME"
Begin DoDot:7
+75 WRITE !,PSBDT,?30,PSBOITX
SET SP=1
+76 IF VAR1]""
WRITE !,?30,$PIECE(VAR1,U,1)
SET SP=1
+77 IF VAR2]""
IF $GET(SP)
WRITE !
WRITE ?30,VAR2
+78 IF VAR3]""
WRITE !,$$WRAP^PSBO(30,95,VAR3)
+79 WRITE !,"Start Date/Time: ",?18,$ORDER(PSBSTXT(PSBONX,""))
+80 WRITE !,"Stop Date/Time: ",?18,$ORDER(PSBSTXP(PSBONX,""))
+81 WRITE !
End DoDot:7
QUIT
+82 WRITE ?67,$SELECT(+PSBDT>0:$$DTFMT^PSBOMM2(PSBDT),1:PSBDT),?85,PSBOITX
SET SP=1
+83 IF VAR1]""
WRITE !,?50,VAR1
SET SP=1
+84 IF VAR2]""
IF $GET(SP)
WRITE !
WRITE ?50,VAR2
+85 IF VAR3]""
WRITE !,$$WRAP^PSBO(50,75,VAR3)
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+86 QUIT
WRDHDR() ;
+1 DO WARD^PSBOHDR(PSBWRD,.PSBHDR)
+2 WRITE !,"Order Status",?15,"Room-Bed",?35,"Patient",?67,"Admin Date/Time",?85,"Medication"
+3 DO LN1^PSBOMM2
+4 QUIT ""
PTHDR() ;
+1 DO PT^PSBOHDR(DFN,.PSBHDR)
+2 WRITE !,"Order Status",?15,"Administration Date/Time",?43,"Medication",?95,"Order Stop Date"
+3 DO LN1^PSBOMM2
+4 QUIT ""
