PSBOMM ;BIRMINGHAM/EFC-MISSED MEDS ;03/06/16 3:06pm
;;3.0;BAR CODE MED ADMIN;**26,32,56,52,58,70,76,83,109,106**;Mar 2004;Build 43
;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
;
; Reference/IA
; ^DPT/10035
; EN^PSJBCMA/2828
; EN^PSJBCMA2/2830
; EN^PSJBCMA1/2829
;
;*58 - insert Verified by Column with nurse initials else "***"
;*70 - add test for PSBCLINORD flag and filter accordingly
;*83 - new tag to find MRR type meds needing removal
;*106- add Hazardous Handle & Dispose flags
;
EN ;
N PSBSTRT,PSBSTOP,DFN,PSBODATE,PSBFLAG,PSBCNT,PSBEDIT,PSBFUTR,RMV,PSBSTART,PSBSTXP,PSBS,PSBSRT
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^R" ;PSB*3*56 Adds the On Call Status to the Missed Meds Report, PSB*3*76 adds Renewed Status
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
S PSBSRT=$P(PSBRPT(.1),U) ;init sort var here, needed for Removes
;call Removes to add meds needing removal *83
F DFN=0:0 S DFN=$O(^TMP("PSBO",$J,DFN)) Q:'DFN D EN1,REMOVES^PSBUTL(DFN,PSBSRT)
D PRINT
D CLEAN^PSBVT ;106
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)
;Filter in/out Clinic Orders *70
D:PSBCLINORD
. I $D(PSBRPT(2)) D FILTERCO^PSBO Q
. D INCLUDCO^PSBVDLU1
D:'PSBCLINORD REMOVECO^PSBVDLU1
;
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"
.;
.;process Continuous schedules
.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",PSBOSTS="R":"Renewed",1:"*Unknown*"))="" ;PSB*3*76 adds Renewed as status
..S PSBSTXP(PSBONX,DFN,$$DTFMT^PSBOMM2(PSBOSP))="" ;DFN added to PSBSTXP array in PSB*3*52
..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
...;If Report Begin Date is earlier than Order Start Date, set PSBDT2 with Order Start Date (PSB*3*109)
...I $P($G(^TMP("PSJ",$J,PSBX,1)),"^",4),PSBDT2<$P(^TMP("PSJ",$J,PSBX,1),"^",4) S PSBDT2=$P(^TMP("PSJ",$J,PSBX,1),"^",4)-.000001
...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)
..;
..;process Not ODD sched
..I 'PSBODD D
...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)
..;
..; process ODD sched
..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)
.;
.;process One time schedules
.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,DFN,$$DTFMT^PSBOMM2(PSBOSP)),PSBSTXT(PSBONX,DFN,$$DTFMT^PSBOMM2(PSBOST)))="" ;DFN added to PSBSTXP array in PSB*3*52
..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,DFN,Y)="",(X,Y)=0 ;DFN added to PSBG array in PSB*3*52
..I PSBG D PARTG1^PSBOMM2($O(PSBG(PSBONX,DFN,""))) ;DFN added to PSBG array in PSB*3*52
..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",PSBOSTS="R":"Renewed",1:" * ERROR * "))="" ;PSB*3*76 adds Renewed as status
..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,PSBVNI,PSBSORT,PSBSRCHL
K PSBNPG
S Y=$S($P(PSBRPT(.1),U,8)]"":$P(PSBRPT(.1),U,8),1:$P(PSBRPT(.1),U,6))
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"
;check Clinic or Nurs Unit search list *70
S PSBSRCHL=$$SRCHLIST^PSBOHDR()
D:PSBSRCHL]""
.S PSBHDR(5)=""
.S:$P(PSBRPT(4),U,2)="C" PSBHDR(6)="Clinic Search List: "
.S:$P(PSBRPT(4),U,2)="I" PSBHDR(6)="Ward Location: "
;
;* * * Print by Patient * * *
D:PSBSRT="P"
.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
....;if previously held/refused lines printed, need line feed *58
....;*83 except after a remove line
....I ($G(VAR1)]"")!($G(VAR2)]"")!($G(VAR3)]"") W:'$G(RMV) ! K RMV
....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))
....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")) ;RM exists
.....W !,$O(PSBS(DFN,PSBONX,"")),?15,PSBVNI,?21,$S(+PSBDT>0:$$DTFMT^PSBOMM2(PSBDT),1:PSBDT),?38,PSBOITX,?85,$O(PSBSTXP(PSBONX,DFN,"")),?103,PSBCLORD
.....W !,?41,"(Remove)" S RMV=1
.....;*106 adds the hazardous handle/dispose notices-bg
.....I (PSBHAZDS=1)!(PSBHAZHN=1) W !
.....I PSBHAZHN=1 W ?38,"<<HAZ HANDLE>> " ;*106 hazhn
.....I PSBHAZDS=1 W ?38,"<<HAZ DISPOSE>>" ;*106 hazds, is hazhn printed 1st, then this will print after it and not at 38, desired.
....I PSBDT["ONE-TIME" D Q
.....W !
.....W !,$O(PSBS(DFN,PSBONX,"")),?15,PSBVNI,?21,PSBDT,?38,PSBOITX,?103,PSBCLORD,! ;*70
.....I VAR1]"" W ?41,VAR1 S SP=1
.....I VAR2]"" W:$G(SP) ! W ?41,VAR2
.....I VAR3]"" W !,$$WRAP^PSBO(41,79,VAR3)
.....W !?3,"Start Date/Time: ",?22,$O(PSBSTXT(PSBONX,DFN,"")) ;DFN added to PSBSTXT array in PSB*3*52
.....W !?3,"Stop Date/Time: ",?22,$O(PSBSTXP(PSBONX,DFN,"")) ;DFN added to PSBSTXP array in PSB*3*52
....;
....;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,"")),?15,PSBVNI,?21,$S(+PSBDT>0:$$DTFMT^PSBOMM2(PSBDT),1:PSBDT),?38,PSBOITX,?85,$O(PSBSTXP(PSBONX,DFN,"")) ;DFN added to PSBSTXP array in PSB*3*52
.....W ?103,PSBCLORD ;*70 clinic name
.....;*106 adds the hazardous handle/dispose notices-bg
.....I (PSBHAZDS=1)!(PSBHAZHN=1) W !
.....I PSBHAZHN=1 W ?38,"<<HAZ HANDLE>> " ;*106 hazhn
.....I PSBHAZDS=1 W ?38,"<<HAZ DISPOSE>>" ;*106 hazds, is hazhn printed 1st, then this will print after it and not at 38, desired.
.....W !
....I VAR1]"" W ?41,VAR1 S SP=1
....I VAR2]"" W:$G(SP) ! W ?41,VAR2
....I VAR3]"" W !,$$WRAP^PSBO(41,79,VAR3)
.W $$PTFTR^PSBOHDR()
.Q
;
;* * * Print by Ward * * *
D:PSBSRT="W"
.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 !
....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 $$WRDHDR()
......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,"")),?15,PSBVNI,?22,$G(^DPT(DFN,.101),"**"),?42,$P(^DPT(DFN,0),U)," (",$E($P(^(0),U,9),6,9),")"
.......W ?74,$S(+PSBDT>0:$$DTFMT^PSBOMM2(PSBDT),1:PSBDT),?92,PSBOITX S SP=1
.......W !,?95,"(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,"")),?15,PSBVNI,?22,$G(^DPT(DFN,.101),"**"),?42,$P(^DPT(DFN,0),U)," (",$E($P(^(0),U,9),6,9),")"
.......W:PSBDT'["ONE-TIME" ?74,$S(+PSBDT>0:$$DTFMT^PSBOMM2(PSBDT),1:PSBDT),?92,PSBOITX S SP=1
......;*106 adds the hazardous handle/dispose notices-bg
......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
.......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 !
......I VAR1]"" W !,?57,VAR1 S SP=1
......I VAR2]"" W:$G(SP) ! W ?57,VAR2
......I VAR3]"" W !,$$WRAP^PSBO(57,82,VAR3)
;
;* * * Print by Clinic * * *
D:PSBSRT="C" CLINIC^PSBOMM2
;
WRDHDR() ;
D WARD^PSBOHDR(PSBWRD,.PSBHDR,,,PSBSRCHL)
W !,"Order Status",?15,"Ver",?22,"Room-Bed",?42,"Patient",?74,"Missed Date/Time",?92,"Medication"
D LN1^PSBOMM2
Q ""
;
PTHDR() ;
D PT^PSBOHDR(DFN,.PSBHDR,,,PSBSRCHL)
W !,"Order Status",?15,"Ver",?21,"Missed Date/Time",?38,"Medication",?85,"Order Stop Date"
W:PSBCLINORD ?103,"Location"
D LN1^PSBOMM2
Q ""
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSBOMM 13902 printed Nov 22, 2024@16:50:56 Page 2
PSBOMM ;BIRMINGHAM/EFC-MISSED MEDS ;03/06/16 3:06pm
+1 ;;3.0;BAR CODE MED ADMIN;**26,32,56,52,58,70,76,83,109,106**;Mar 2004;Build 43
+2 ;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
+3 ;
+4 ; Reference/IA
+5 ; ^DPT/10035
+6 ; EN^PSJBCMA/2828
+7 ; EN^PSJBCMA2/2830
+8 ; EN^PSJBCMA1/2829
+9 ;
+10 ;*58 - insert Verified by Column with nurse initials else "***"
+11 ;*70 - add test for PSBCLINORD flag and filter accordingly
+12 ;*83 - new tag to find MRR type meds needing removal
+13 ;*106- add Hazardous Handle & Dispose flags
+14 ;
EN ;
+1 NEW PSBSTRT,PSBSTOP,DFN,PSBODATE,PSBFLAG,PSBCNT,PSBEDIT,PSBFUTR,RMV,PSBSTART,PSBSTXP,PSBS,PSBSRT
+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, PSB*3*76 adds Renewed Status
SET PSBOCRIT="^A^H^O^R"
+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 ;init sort var here, needed for Removes
SET PSBSRT=$PIECE(PSBRPT(.1),U)
+13 ;call Removes to add meds needing removal *83
+14 FOR DFN=0:0
SET DFN=$ORDER(^TMP("PSBO",$JOB,DFN))
if 'DFN
QUIT
DO EN1
DO REMOVES^PSBUTL(DFN,PSBSRT)
+15 DO PRINT
+16 ;106
DO CLEAN^PSBVT
+17 KILL ^TMP("PSJ",$JOB),^TMP("PSB",$JOB),^TMP("PSBO",$JOB),PSBS
+18 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 ;Filter in/out Clinic Orders *70
+5 if PSBCLINORD
Begin DoDot:1
+6 IF $DATA(PSBRPT(2))
DO FILTERCO^PSBO
QUIT
+7 DO INCLUDCO^PSBVDLU1
End DoDot:1
+8 if 'PSBCLINORD
DO REMOVECO^PSBVDLU1
+9 ;
+10 if ^TMP("PSJ",$JOB,1,0)=-1
QUIT
+11 SET PSBX=""
+12 FOR
SET PSBX=$ORDER(^TMP("PSJ",$JOB,PSBX))
if PSBX=""
QUIT
Begin DoDot:1
+13 if ^TMP("PSJ",$JOB,PSBX,0)=-1
QUIT
+14 DO NOW^%DTC
+15 DO CLEAN^PSBVT
+16 DO PSJ^PSBVT(PSBX)
+17 if PSBIVT="A"
QUIT
+18 if PSBIVT="H"
QUIT
+19 IF PSBIVT["S"
IF PSBISYR'=1
QUIT
+20 IF PSBIVT["C"
IF PSBCHEMT'="P"
IF PSBISYR'=1
QUIT
+21 IF PSBIVT["C"
IF PSBCHEMT="A"
QUIT
+22 if PSBONX["P"
QUIT
+23 if PSBOSP<PSBSTART
QUIT
+24 IF %>PSBOSP
IF PSBOSTS'="D"
IF PSBOSTS'="DE"
IF PSBOSTS'="H"
SET PSBOSTS="E"
+25 ;
+26 ;process Continuous schedules
+27 IF PSBSCHT="C"
Begin DoDot:2
+28 SET (PSBYES,PSBODD)=0
+29 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
+30 IF PSBYES
IF PSBADST=""
QUIT
+31 FOR I=1:1
if $PIECE(PSBSCH,"-",I)=""
QUIT
IF $PIECE(PSBSCH,"-",I)?2N!($PIECE(PSBSCH,"-",I)?4N)
SET PSBYES=1
+32 SET PSBFREQ=$$GETFREQ^PSBVDLU1(DFN,PSBONX)
+33 IF PSBFREQ="O"
SET PSBYES=1
SET PSBFREQ=1440
+34 IF 'PSBYES
IF PSBADST=""
IF PSBFREQ<1
QUIT
+35 IF (PSBFREQ#1440'=0)
IF (1440#PSBFREQ'=0)
SET PSBODD=1
+36 IF PSBODD
IF PSBADST'=""
QUIT
+37 if PSBOCRIT'[PSBOSTS
QUIT
+38 if PSBNGF
QUIT
+39 if PSBOSTS="N"
QUIT
+40 if PSBSM
QUIT
+41 ;PSB*3*76 adds Renewed as status
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",PSBOSTS="R":"Renewed",1:"*Unknown*"))=""
+42 ;DFN added to PSBSTXP array in PSB*3*52
SET PSBSTXP(PSBONX,DFN,$$DTFMT^PSBOMM2(PSBOSP))=""
+43 SET PSBCADM=0
+44 IF PSBADST=""
Begin DoDot:3
+45 SET X=PSBOST
DO H^%DTC
SET X1=((%H*24)*60)+(%T/60)
+46 SET X=PSBSTRT
SET X3=0
DO H^%DTC
SET X2=((%H*24)*60)+(%T/60)
+47 IF X2'<X1
SET X3=X2-X1
SET PSBOST=$$FMADD^XLFDT(PSBSTRT,,,(-1*(X3#PSBFREQ)))
+48 KILL PSBADST
SET PSBOST2=PSBOST
SET PSBDT2=PSBSTRT
+49 ;If Report Begin Date is earlier than Order Start Date, set PSBDT2 with Order Start Date (PSB*3*109)
+50 IF $PIECE($GET(^TMP("PSJ",$JOB,PSBX,1)),"^",4)
IF PSBDT2<$PIECE(^TMP("PSJ",$JOB,PSBX,1),"^",4)
SET PSBDT2=$PIECE(^TMP("PSJ",$JOB,PSBX,1),"^",4)-.000001
+51 FOR XZ=0:1
SET PSBADST(XZ,PSBDT2)=$$GETADMIN^PSBVDLU1(DFN,PSBONX,PSBOST2,PSBFREQ,PSBDT2)
Begin DoDot:4
+52 IF ($LENGTH(PSBADST(XZ,PSBDT2),"-")>$LENGTH($GET(PSBADST),"-"))!($GET(PSBADST)="")
SET PSBADST=PSBADST(XZ,PSBDT2)
+53 SET Z=PSBDT2\1
SET J=$PIECE(PSBADST(XZ,PSBDT2),"-",($LENGTH(PSBADST(XZ,PSBDT2),"-")))
if J]""
SET PSBOST2=Z_"."_J
+54 SET PSBDT2=($$FMADD^XLFDT(Z,1))+.2400
+55 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
+56 SET Z=PSBADST
IF Z]""
KILL ^TMP("PSB",$JOB,"GETADMIN")
SET ^TMP("PSB",$JOB,"GETADMIN",0)=Z
+57 FOR Y=1:1:$LENGTH(Z,"-")
Begin DoDot:3
+58 if ($PIECE(Z,"-",Y)'?2N)&($PIECE(Z,"-",Y)'?4N)
QUIT
End DoDot:3
+59 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)
+60 ;
+61 ;process Not ODD sched
+62 IF 'PSBODD
Begin DoDot:3
+63 FOR XX=0:1
if '$DATA(^TMP("PSB",$JOB,"GETADMIN",XX))
QUIT
SET (PSBADST,Z)=$GET(^TMP("PSB",$JOB,"GETADMIN",XX))
Begin DoDot:4
+64 DO MISSED^PSBOMM2(Z,.PSBEDIT,PSBSTRT)
End DoDot:4
End DoDot:3
+65 ;
+66 ; process ODD sched
+67 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
+68 IF Z]""
DO MISSED^PSBOMM2(Z,.PSBEDIT,XXX)
End DoDot:3
End DoDot:2
QUIT
+69 ;
+70 ;process One time schedules
+71 KILL PSBHDDT,PSBUNHD,^TMP("PSB1",$JOB)
+72 IF PSBSCHT="O"
Begin DoDot:2
+73 if PSBOSTS="N"
QUIT
+74 if PSBNGF
QUIT
+75 if PSBSM
QUIT
+76 if (PSBOSP=PSBOST)&(PSBOCRIT'["E")
QUIT
+77 if PSBOST'<PSBSTOP
QUIT
+78 SET PSBDT="*** ONE-TIME ***"
+79 ;DFN added to PSBSTXP array in PSB*3*52
SET (PSBSTXP(PSBONX,DFN,$$DTFMT^PSBOMM2(PSBOSP)),PSBSTXT(PSBONX,DFN,$$DTFMT^PSBOMM2(PSBOST)))=""
+80 SET (PSBG,X,Y,PSBXSTS)=""
KILL PSBEXST
+81 FOR
SET X=$ORDER(^PSB(53.79,"AOIP",DFN,PSBOIT,X),-1)
if 'X
QUIT
Begin DoDot:3
+82 FOR
SET Y=$ORDER(^PSB(53.79,"AOIP",DFN,PSBOIT,X,Y),-1)
if 'Y
QUIT
Begin DoDot:4
+83 SET PSBXSTS=$PIECE(^PSB(53.79,Y,0),U,9)
+84 ;DFN added to PSBG array in PSB*3*52
IF $PIECE(^PSB(53.79,Y,.1),U)=PSBONX
IF PSBXSTS'="N"
IF PSBXSTS'="M"
SET PSBG=1
SET PSBG(PSBONX,DFN,Y)=""
SET (X,Y)=0
End DoDot:4
End DoDot:3
+85 ;DFN added to PSBG array in PSB*3*52
IF PSBG
DO PARTG1^PSBOMM2($ORDER(PSBG(PSBONX,DFN,"")))
+86 DO NOW^%DTC
+87 if (PSBOCRIT'[PSBOSTS)
QUIT
+88 ;PSB*3*76 adds Renewed as status
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",PSBOSTS="R":"Renewed",1:" * ERROR * "))=""
+89 if 'PSBG!(PSBACRIT[$GET(PSBXSTS,1))
Begin DoDot:3
+90 SET VAR=""
+91 KILL ^TMP("PSJ2",$JOB),^TMP("PSB1",$JOB),PSBOACTL
DO EN^PSJBCMA2(DFN,PSBONX,1)
IF ^TMP("PSJ2",$JOB,0)'=1
Begin DoDot:4
+92 MERGE PSBOACTL=^TMP("PSJ2",$JOB)
+93 DO UDONE^PSBOMM2
+94 IF PSBFLAG=1
SET VAR="(On Hold) "_$$DTFMT^PSBOMM2(PSBHDDT)
+95 IF PSBFLAG=2
SET VAR="(On Hold) "_$$DTFMT^PSBOMM2(PSBHDDT)_" (Off Hold) "_$$DTFMT^PSBOMM2(PSBUNHD)
End DoDot:4
+96 IF '$GET(PSBEXST,0)!(PSBXSTS="M")
SET $PIECE(^TMP("PSB",$JOB,DFN,"*** ONE-TIME ***",PSBOITX,PSBONX),U,1,4)=VAR
+97 IF $GET(PSBEXST,0)
Begin DoDot:4
+98 SET VAR1=$GET(^TMP("PSB",$JOB,DFN,"*** ONE-TIME ***","* "_PSBOITX,PSBONX))
IF VAR1]""
SET $PIECE(VAR1,U,1,4)=VAR_VAR1
End DoDot:4
+99 KILL PSBHDDT,PSBUNHD,^TMP("PSB1",$JOB),PSBCNT
End DoDot:3
End DoDot:2
QUIT
End DoDot:1
+100 KILL PSBOACTL
+101 QUIT
PRINT ;
+1 NEW PSBHDR,PSBDT,PSBOITX,PSBONX,DFN,PSBVNI,PSBSORT,PSBSRCHL
+2 KILL PSBNPG
+3 SET Y=$SELECT($PIECE(PSBRPT(.1),U,8)]"":$PIECE(PSBRPT(.1),U,8),1:$PIECE(PSBRPT(.1),U,6))
+4 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))
+5 SET PSBHDR(2)="Order Status(es): --"
+6 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),"-","")
+7 SET PSBHDR(3)="Admin Status(es): --"
+8 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),"-","")
+9 IF PSBINCC
SET PSBHDR(4)="Include Comments/Reasons"
+10 ;check Clinic or Nurs Unit search list *70
+11 SET PSBSRCHL=$$SRCHLIST^PSBOHDR()
+12 if PSBSRCHL]""
Begin DoDot:1
+13 SET PSBHDR(5)=""
+14 if $PIECE(PSBRPT(4),U,2)="C"
SET PSBHDR(6)="Clinic Search List: "
+15 if $PIECE(PSBRPT(4),U,2)="I"
SET PSBHDR(6)="Ward Location: "
End DoDot:1
+16 ;
+17 ;* * * Print by Patient * * *
+18 if PSBSRT="P"
Begin DoDot:1
+19 SET DFN=$PIECE(PSBRPT(.1),U,2)
+20 ;
+21 WRITE $$PTHDR()
+22 IF $GET(PSBEDIT)
WRITE !?7,"*Administration Times have been edited*"
+23 IF $ORDER(^TMP("PSB",$JOB,DFN,""))=""
WRITE !,"No Missed Medications Found",$$PTFTR^PSBOHDR()
QUIT
+24 SET PSBDT=""
+25 FOR
SET PSBDT=$ORDER(^TMP("PSB",$JOB,DFN,PSBDT))
if PSBDT=""
QUIT
Begin DoDot:2
+26 WRITE !
+27 SET PSBOITX=""
+28 FOR
SET PSBOITX=$ORDER(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX))
if PSBOITX=""
QUIT
Begin DoDot:3
+29 SET PSBONX=""
+30 FOR
SET PSBONX=$ORDER(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX))
if PSBONX=""
QUIT
Begin DoDot:4
+31 ;if previously held/refused lines printed, need line feed *58
+32 ;*83 except after a remove line
+33 IF ($GET(VAR1)]"")!($GET(VAR2)]"")!($GET(VAR3)]"")
if '$GET(RMV)
WRITE !
KILL RMV
+34 KILL VAR1,VAR2,VAR3,SP
IF $Y>(IOSL-9)
WRITE $$PTFTR^PSBOHDR(),$$PTHDR()
+35 SET VAR1=$GET(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX))
+36 SET VAR2=$GET(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX,"X"))
+37 SET VAR3=$GET(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX,.3))
+38 DO PSJ1^PSBVT(DFN,PSBONX)
SET PSBVNI=$SELECT(PSBVNI]"":PSBVNI,1:"***")
+39 ; print remove line 1st *83
+40 SET RMV=0
+41 ;RM exists
if $DATA(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX,"RM"))
Begin DoDot:5
+42 WRITE !,$ORDER(PSBS(DFN,PSBONX,"")),?15,PSBVNI,?21,$SELECT(+PSBDT>0:$$DTFMT^PSBOMM2(PSBDT),1:PSBDT),?38,PSBOITX,?85,$ORDER(PSBSTXP(PSBONX,DFN,"")),?103,PSBCLORD
+43 WRITE !,?41,"(Remove)"
SET RMV=1
+44 ;*106 adds the hazardous handle/dispose notices-bg
+45 IF (PSBHAZDS=1)!(PSBHAZHN=1)
WRITE !
+46 ;*106 hazhn
IF PSBHAZHN=1
WRITE ?38,"<<HAZ HANDLE>> "
+47 ;*106 hazds, is hazhn printed 1st, then this will print after it and not at 38, desired.
IF PSBHAZDS=1
WRITE ?38,"<<HAZ DISPOSE>>"
End DoDot:5
+48 IF PSBDT["ONE-TIME"
Begin DoDot:5
+49 WRITE !
+50 ;*70
WRITE !,$ORDER(PSBS(DFN,PSBONX,"")),?15,PSBVNI,?21,PSBDT,?38,PSBOITX,?103,PSBCLORD,!
+51 IF VAR1]""
WRITE ?41,VAR1
SET SP=1
+52 IF VAR2]""
if $GET(SP)
WRITE !
WRITE ?41,VAR2
+53 IF VAR3]""
WRITE !,$$WRAP^PSBO(41,79,VAR3)
+54 ;DFN added to PSBSTXT array in PSB*3*52
WRITE !?3,"Start Date/Time: ",?22,$ORDER(PSBSTXT(PSBONX,DFN,""))
+55 ;DFN added to PSBSTXP array in PSB*3*52
WRITE !?3,"Stop Date/Time: ",?22,$ORDER(PSBSTXP(PSBONX,DFN,""))
End DoDot:5
QUIT
+56 ;
+57 ;print Give if exists for a RM just printed, or no RM printed
+58 IF 'RMV!(RMV&$DATA(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX))=11)
Begin DoDot:5
+59 ;DFN added to PSBSTXP array in PSB*3*52
WRITE !,$ORDER(PSBS(DFN,PSBONX,"")),?15,PSBVNI,?21,$SELECT(+PSBDT>0:$$DTFMT^PSBOMM2(PSBDT),1:PSBDT),?38,PSBOITX,?85,$ORDER(PSBSTXP(PSBONX,DFN,""))
+60 ;*70 clinic name
WRITE ?103,PSBCLORD
+61 ;*106 adds the hazardous handle/dispose notices-bg
+62 IF (PSBHAZDS=1)!(PSBHAZHN=1)
WRITE !
+63 ;*106 hazhn
IF PSBHAZHN=1
WRITE ?38,"<<HAZ HANDLE>> "
+64 ;*106 hazds, is hazhn printed 1st, then this will print after it and not at 38, desired.
IF PSBHAZDS=1
WRITE ?38,"<<HAZ DISPOSE>>"
+65 WRITE !
End DoDot:5
+66 IF VAR1]""
WRITE ?41,VAR1
SET SP=1
+67 IF VAR2]""
if $GET(SP)
WRITE !
WRITE ?41,VAR2
+68 IF VAR3]""
WRITE !,$$WRAP^PSBO(41,79,VAR3)
End DoDot:4
End DoDot:3
End DoDot:2
+69 WRITE $$PTFTR^PSBOHDR()
+70 QUIT
End DoDot:1
+71 ;
+72 ;* * * Print by Ward * * *
+73 if PSBSRT="W"
Begin DoDot:1
+74 SET PSBWARD=$PIECE(PSBRPT(.1),U,3)
+75 WRITE $$WRDHDR()
+76 IF '$ORDER(^TMP("PSB",$JOB,0))
WRITE !,"No Missed Medications Found"
QUIT
+77 SET PSBSORT=$PIECE(PSBRPT(.1),U,5)
+78 FOR DFN=0:0
SET DFN=$ORDER(^TMP("PSB",$JOB,DFN))
if 'DFN
QUIT
Begin DoDot:2
+79 SET PSBDX=$SELECT(PSBSORT="P":$PIECE(^DPT(DFN,0),U),1:$GET(^DPT(DFN,.1))_" "_$GET(^(.101)))
+80 if PSBDX=""
SET PSBDX=$PIECE(^DPT(DFN,0),U)
+81 SET ^TMP("PSB",$JOB,"B",PSBDX,DFN)=""
End DoDot:2
+82 SET PSBDX=""
+83 FOR
SET PSBDX=$ORDER(^TMP("PSB",$JOB,"B",PSBDX))
if PSBDX=""
QUIT
Begin DoDot:2
+84 FOR DFN=0:0
SET DFN=$ORDER(^TMP("PSB",$JOB,"B",PSBDX,DFN))
if 'DFN
QUIT
Begin DoDot:3
+85 WRITE !
+86 SET PSBDT=""
+87 FOR
SET PSBDT=$ORDER(^TMP("PSB",$JOB,DFN,PSBDT))
if PSBDT=""
QUIT
Begin DoDot:4
+88 WRITE !
+89 ;reset held/refused to prevent line feed
KILL VAR1,VAR2,VAR3
+90 if PSBDT["ONE-TIME"
WRITE !
+91 SET PSBOITX=""
+92 FOR
SET PSBOITX=$ORDER(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX))
if PSBOITX=""
QUIT
Begin DoDot:5
+93 SET PSBONX=""
+94 FOR
SET PSBONX=$ORDER(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX))
if PSBONX=""
QUIT
Begin DoDot:6
+95 ;if previously held/refused lines printed, need line feed *58
+96 IF ($GET(VAR1)]"")!($GET(VAR2)]"")!($GET(VAR3)]"")
if '$GET(RMV)
WRITE !
KILL RMV
+97 KILL VAR1,VAR2,VAR3,SP
IF $Y>(IOSL-9)
WRITE $$WRDHDR()
+98 DO PSJ1^PSBVT(DFN,PSBONX)
+99 SET PSBVNI=$SELECT(PSBVNI]"":PSBVNI,1:"***")
+100 ; print remove line 1st *83
+101 SET RMV=0
+102 if $DATA(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX,"RM"))
Begin DoDot:7
+103 WRITE !,$ORDER(PSBS(DFN,PSBONX,"")),?15,PSBVNI,?22,$GET(^DPT(DFN,.101),"**"),?42,$PIECE(^DPT(DFN,0),U)," (",$EXTRACT($PIECE(^(0),U,9),6,9),")"
+104 WRITE ?74,$SELECT(+PSBDT>0:$$DTFMT^PSBOMM2(PSBDT),1:PSBDT),?92,PSBOITX
SET SP=1
+105 WRITE !,?95,"(Remove)"
SET RMV=1
End DoDot:7
+106 ;print Give if exists for a RM just printed, or no RM printed
+107 IF 'RMV!(RMV&$DATA(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX))=11)
Begin DoDot:7
+108 WRITE !,$ORDER(PSBS(DFN,PSBONX,"")),?15,PSBVNI,?22,$GET(^DPT(DFN,.101),"**"),?42,$PIECE(^DPT(DFN,0),U)," (",$EXTRACT($PIECE(^(0),U,9),6,9),")"
+109 if PSBDT'["ONE-TIME"
WRITE ?74,$SELECT(+PSBDT>0:$$DTFMT^PSBOMM2(PSBDT),1:PSBDT),?92,PSBOITX
SET SP=1
End DoDot:7
+110 ;*106 adds the hazardous handle/dispose notices-bg
+111 IF (PSBHAZDS=1)!(PSBHAZHN=1)
WRITE !
+112 ;*106 hazhn
IF PSBHAZHN=1
WRITE ?92,"<<HAZ HANDLE>> "
+113 ;*106 hazds, if hazhn printed 1st, then this will print after that and not at 92, desired.
IF PSBHAZDS=1
WRITE ?92,"<<HAZ DISPOSE>>"
+114 SET VAR1=$GET(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX))
+115 SET VAR2=$GET(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX,"X"))
+116 SET VAR3=$GET(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX,.3))
+117 IF PSBDT["ONE-TIME"
Begin DoDot:7
+118 WRITE !,PSBDT,?37,PSBOITX
SET SP=1
+119 IF VAR1]""
WRITE !,?37,$PIECE(VAR1,U,1)
SET SP=1
+120 IF VAR2]""
if $GET(SP)
WRITE !
WRITE ?37,VAR2
+121 IF VAR3]""
WRITE !,$$WRAP^PSBO(37,102,VAR3)
+122 ;DFN added to PSBSTXT array in PSB*3*52
WRITE !?3,"Start Date/Time: ",?21,$ORDER(PSBSTXT(PSBONX,DFN,""))
+123 ;DFN added to PSBSTXP array in PSB*3*52
WRITE !?3,"Stop Date/Time: ",?21,$ORDER(PSBSTXP(PSBONX,DFN,""))
+124 WRITE !
End DoDot:7
QUIT
+125 IF VAR1]""
WRITE !,?57,VAR1
SET SP=1
+126 IF VAR2]""
if $GET(SP)
WRITE !
WRITE ?57,VAR2
+127 IF VAR3]""
WRITE !,$$WRAP^PSBO(57,82,VAR3)
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+128 ;
+129 ;* * * Print by Clinic * * *
+130 if PSBSRT="C"
DO CLINIC^PSBOMM2
+131 ;
WRDHDR() ;
+1 DO WARD^PSBOHDR(PSBWRD,.PSBHDR,,,PSBSRCHL)
+2 WRITE !,"Order Status",?15,"Ver",?22,"Room-Bed",?42,"Patient",?74,"Missed Date/Time",?92,"Medication"
+3 DO LN1^PSBOMM2
+4 QUIT ""
+5 ;
PTHDR() ;
+1 DO PT^PSBOHDR(DFN,.PSBHDR,,,PSBSRCHL)
+2 WRITE !,"Order Status",?15,"Ver",?21,"Missed Date/Time",?38,"Medication",?85,"Order Stop Date"
+3 if PSBCLINORD
WRITE ?103,"Location"
+4 DO LN1^PSBOMM2
+5 QUIT ""
