PSBORT ;AITC/CR - REPORT FOR RESPIRATORY THERAPY MEDS ;11/29/18 5:54am
;;3.0;BAR CODE MED ADMIN;**103**;Mar 2004;Build 21
;Per VA Directive 6402, this routine should not be modified.
;
;SLC/KB Modified PSBOMM for Resp Therapy Meds report
;
; Reference/IA
; EN^PSJBCMA/2828 (private)
; EN^PSJBCMA2/2830 (private)
; ^DPT/10035 (supported)
;
;=========================================================
EN ; called from DQ^PSBO
N PSBSTRT,PSBSTOP,DFN,PSBODATE,PSBFLAG,PSBCNT
K ^TMP("PSJ",$J),^TMP("PSB",$J),^TMP("PSB1",$J)
S PSBSTRT=$P(PSBRPT(.1),U,6)+$P(PSBRPT(.1),U,7)-.0000001
S PSBSTOP=$P(PSBRPT(.1),U,6)+$P(PSBRPT(.1),U,9)
S PSBODATE=$P(PSBRPT(.1),U,6)
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)
Q
;
EN1 ; expects DFN,PSBSTRT,PSBSTOP from EN
N PSBGBL,PSBHDR,PSBX,PSBDFN,PSBDT,PSBEVDT,PSBHOUR
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 ; no Orders
.D CLEAN^PSBVT
.D PSJ^PSBVT(PSBX)
.; check for a respiratory therapy drug
.Q:$$GET1^DIQ(50.7,PSBOIT,15,"I")'="Y" ; PSBOIT set in ^PSBVT above
.Q:PSBIVT="A" ; No Admix or Hyp.
.Q:PSBIVT="H"
.I PSBIVT["S",PSBISYR'=1 Q ; allow intermittent syringe only
.I PSBIVT["C",PSBCHEMT'="P",PSBISYR'=1 Q
.I PSBIVT["C",PSBCHEMT="A" Q ; allow Chemo with intermittent syringe or Piggyback type only
.Q:PSBONX["P" ;no pending orders
.I PSBSCHT="C" D Q ; Only Continuous
..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
..I 'PSBYES,PSBADST="",PSBFREQ<1 Q
..I (PSBFREQ#1440'=0),(1440#PSBFREQ'=0) S PSBODD=1
..I PSBODD,PSBADST'="" Q
..Q:PSBOSTS["D" ;discontinued
..Q:PSBNGF ; marked DO NOT GIVE
..Q:PSBOSTS="N"
..Q:PSBSM ;Self med
..S PSBCADM=0
..I PSBADST="" S PSBADST=$$GETADMIN^PSBVDLU1(DFN,PSBONX,PSBOST,PSBFREQ,PSBEVDT) Q:PSBADST="" S PSBCADM=1
..E K ^TMP("PSB",$J,"GETADMIN") S ^TMP("PSB",$J,"GETADMIN",0)=PSBADST
..; invalid admin times
..F Y=1:1:$L(PSBADST,"-") D
...Q:($P(PSBADST,"-",Y)'?2N)&($P(PSBADST,"-",Y)'?4N)
..; below is (Order Start Date, Report Date, Schedule)
..Q:'$$OKAY^PSBVDLU1(PSBOST,PSBODATE,PSBSCH,PSBONX,$P(^TMP("PSJ",$J,PSBX,3),U,2),PSBFREQ,PSBOSTS) ; Screens QOD type stuff
..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)
..F PSBXX=0:1 Q:'$D(^TMP("PSB",$J,"GETADMIN",PSBXX)) S PSBADST=$G(^TMP("PSB",$J,"GETADMIN",PSBXX)) D
...F Y=1:1:$L(PSBADST,"-") D
....S PSBDT=+("."_$P(PSBADST,"-",Y))+(PSBSTRT\1)
....Q:PSBDT<PSBOST ; order Start Date
....Q:PSBDT'<PSBOSP ; order Stop Date
....Q:PSBDT<PSBSTRT ; report Window
....Q:PSBDT>PSBSTOP ; report Window
....I $D(^PSB(53.79,"AORD",DFN,PSBONX,PSBDT)) D I PSBSTUS'="N",PSBSTUS'="M" Q ; if it is on the log quit, continue if status is "NOT GIVEN" or "MISSING"
.....S PSBINDX=$O(^PSB(53.79,"AORD",DFN,PSBONX,PSBDT,"")),PSBSTUS=$P(^PSB(53.79,PSBINDX,0),U,9)
....S ^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX)=""
....D UDCONT
....I PSBFLAG=1 S ^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX)="(On Hold) "_$$FMTE^XLFDT(PSBHDDT)
....I PSBFLAG=2 S ^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX)="(On Hold) "_$$FMTE^XLFDT(PSBHDDT)_" "_"(Off Hold) "_$$FMTE^XLFDT(PSBUNHD) Q
.K PSBHDDT,PSBUNHD,^TMP("PSB1",$J)
.I PSBSCHT="O" D Q
..Q:PSBOSTS["D"!(PSBOSTS="N") ; discontinued
..Q:PSBNGF ; Marked DO NOT GIVE
..Q:PSBSM ;self med
..; is the One Time Given?
..Q:PSBOSP=PSBOST ;expired one-time
..Q:PSBOST'<PSBSTOP
..Q:PSBOSP<PSBSTRT
..S (PSBGVN,X,Y)=""
..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
....I $P(^PSB(53.79,Y,.1),U)=PSBONX,$P(^PSB(53.79,Y,0),U,9)'="N",$P(^PSB(53.79,Y,0),U,9)'="M" S PSBGVN=1,(X,Y)=0
..; how long does One Time remain on the this report ??
..D NOW^%DTC
..S PSBRMN=1
..I PSBSCHT="O",PSBOSP'=PSBOST&(%>PSBOSP) S PSBRMN=0
..D:('PSBGVN)&(PSBRMN)
...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
....I PSBFLAG=1 S VAR="(On Hold) "_$$FMTE^XLFDT(PSBHDDT)
....I PSBFLAG=2 S VAR="(On Hold) "_$$FMTE^XLFDT(PSBHDDT)_" (Off Hold) "_$$FMTE^XLFDT(PSBUNHD)
...S VAR=VAR_U_$TR($$FMTE^XLFDT(PSBOST,2),"@"," ")
...S VAR=VAR_U_$TR($$FMTE^XLFDT(PSBOSP,2),"@"," ")
...S $P(^TMP("PSB",$J,DFN,"*** ONE-TIME ***",PSBOITX,PSBONX),U,1,4)=VAR
...K PSBHDDT,PSBUNHD,^TMP("PSB1",$J),PSBCNT
K PSBOACTL
Q
;
PRINT ; print meds stored in ^TMP("PSB",$J,DFN,....
N DFN,PSBHDR,PSBDT,PSBOITX,PSBONX,WARDIEN
; print by Ward
D:$P(PSBRPT(.1),U,1)="W"
.S PSBHDR(1)="RESPIRATORY THERAPY MEDICATIONS from "_$$FMTE^XLFDT($P(PSBRPT(.1),U,6)+$P(PSBRPT(.1),U,7))_" thru "_$$FMTE^XLFDT($P(PSBRPT(.1),U,6)+$P(PSBRPT(.1),U,9))
.S WARDIEN=$P(PSBRPT(.1),U,3) ; WARD ien from #211.4
.I $G(FLAGPRT(WARDIEN))=1 Q ; don't print duplicate wards
.W $$WRDHDR()
.I '$O(^TMP("PSB",$J,0)) W !,"No 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 PSBINDX=$S(PSBSORT="P":$P(^DPT(DFN,0),U),1:$G(^DPT(DFN,.1))_" "_$G(^(.101)))
..S:PSBINDX="" PSBINDX=$P(^DPT(DFN,0),U)
..S ^TMP("PSB",$J,"B",PSBINDX,DFN)=""
.S PSBINDX=""
.F S PSBINDX=$O(^TMP("PSB",$J,"B",PSBINDX)) Q:PSBINDX="" D
..F DFN=0:0 S DFN=$O(^TMP("PSB",$J,"B",PSBINDX,DFN)) Q:'DFN D
...W ! ; line break between patients
...S PSBDT=""
...F S PSBDT=$O(^TMP("PSB",$J,DFN,PSBDT)) Q:PSBDT="" D
....;W ! ; line break between admin times, double-spacing of output
....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
......;I $Y>(IOSL-5) W $$WRDHDR()
......W !,+PSBONX,$S(PSBONX["U":"UD",PSBONX["V":"IV",1:"")
......W ?10,$G(^DPT(DFN,.101),"**")
......W ?30,$P(^DPT(DFN,0),U)," (",$E($P(^(0),U,9),6,9),")"
......I PSBDT["ONE-TIME" D Q
.......W !,PSBDT,?30,PSBOITX," ",$P(^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX),U,1)
.......W !,"Start Date/Time: ",?30,$P(^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX),U,2)
.......W !,"Stop Date/Time: ",?30,$P(^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX),U,3)
.......;W ! ; stop double space
......W ?74,$S(PSBDT:$$FMTE^XLFDT(PSBDT,2),1:PSBDT),?90,PSBOITX
......S FLAGPRT(WARDIEN)=1 ; track wards that have been printed
......I $E(IOST,1,2)="C-" S $Y=2 ;keep screen display for wards evenly spaced, no effect on a printer
Q
;
WRDHDR() ; ward header
D WARD^PSBOHDR1(PSBWRD,.PSBHDR)
W !,"Ord Num",?10,"Room-Bed",?30,"Patient",?74,"Admin Date/Time",?90,"Medication"
W !,$TR($J("",IOM)," ","-")
Q ""
;
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)
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)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSBORT 8995 printed Sep 23, 2025@19:16:52 Page 2
PSBORT ;AITC/CR - REPORT FOR RESPIRATORY THERAPY MEDS ;11/29/18 5:54am
+1 ;;3.0;BAR CODE MED ADMIN;**103**;Mar 2004;Build 21
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;SLC/KB Modified PSBOMM for Resp Therapy Meds report
+5 ;
+6 ; Reference/IA
+7 ; EN^PSJBCMA/2828 (private)
+8 ; EN^PSJBCMA2/2830 (private)
+9 ; ^DPT/10035 (supported)
+10 ;
+11 ;=========================================================
EN ; called from DQ^PSBO
+1 NEW PSBSTRT,PSBSTOP,DFN,PSBODATE,PSBFLAG,PSBCNT
+2 KILL ^TMP("PSJ",$JOB),^TMP("PSB",$JOB),^TMP("PSB1",$JOB)
+3 SET PSBSTRT=$PIECE(PSBRPT(.1),U,6)+$PIECE(PSBRPT(.1),U,7)-.0000001
+4 SET PSBSTOP=$PIECE(PSBRPT(.1),U,6)+$PIECE(PSBRPT(.1),U,9)
+5 SET PSBODATE=$PIECE(PSBRPT(.1),U,6)
+6 FOR DFN=0:0
SET DFN=$ORDER(^TMP("PSBO",$JOB,DFN))
if 'DFN
QUIT
DO EN1
+7 DO PRINT
+8 KILL ^TMP("PSJ",$JOB),^TMP("PSB",$JOB),^TMP("PSBO",$JOB)
+9 QUIT
+10 ;
EN1 ; expects DFN,PSBSTRT,PSBSTOP from EN
+1 NEW PSBGBL,PSBHDR,PSBX,PSBDFN,PSBDT,PSBEVDT,PSBHOUR
+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 ; no Orders
if ^TMP("PSJ",$JOB,PSBX,0)=-1
QUIT
+8 DO CLEAN^PSBVT
+9 DO PSJ^PSBVT(PSBX)
+10 ; check for a respiratory therapy drug
+11 ; PSBOIT set in ^PSBVT above
if $$GET1^DIQ(50.7,PSBOIT,15,"I")'="Y"
QUIT
+12 ; No Admix or Hyp.
if PSBIVT="A"
QUIT
+13 if PSBIVT="H"
QUIT
+14 ; allow intermittent syringe only
IF PSBIVT["S"
IF PSBISYR'=1
QUIT
+15 IF PSBIVT["C"
IF PSBCHEMT'="P"
IF PSBISYR'=1
QUIT
+16 ; allow Chemo with intermittent syringe or Piggyback type only
IF PSBIVT["C"
IF PSBCHEMT="A"
QUIT
+17 ;no pending orders
if PSBONX["P"
QUIT
+18 ; Only Continuous
IF PSBSCHT="C"
Begin DoDot:2
+19 SET (PSBYES,PSBODD)=0
+20 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
+21 IF PSBYES
IF PSBADST=""
QUIT
+22 FOR I=1:1
if $PIECE(PSBSCH,"-",I)=""
QUIT
IF $PIECE(PSBSCH,"-",I)?2N!($PIECE(PSBSCH,"-",I)?4N)
SET PSBYES=1
+23 SET PSBFREQ=$$GETFREQ^PSBVDLU1(DFN,PSBONX)
+24 IF PSBFREQ="O"
SET PSBYES=1
+25 IF 'PSBYES
IF PSBADST=""
IF PSBFREQ<1
QUIT
+26 IF (PSBFREQ#1440'=0)
IF (1440#PSBFREQ'=0)
SET PSBODD=1
+27 IF PSBODD
IF PSBADST'=""
QUIT
+28 ;discontinued
if PSBOSTS["D"
QUIT
+29 ; marked DO NOT GIVE
if PSBNGF
QUIT
+30 if PSBOSTS="N"
QUIT
+31 ;Self med
if PSBSM
QUIT
+32 SET PSBCADM=0
+33 IF PSBADST=""
SET PSBADST=$$GETADMIN^PSBVDLU1(DFN,PSBONX,PSBOST,PSBFREQ,PSBEVDT)
if PSBADST=""
QUIT
SET PSBCADM=1
+34 IF '$TEST
KILL ^TMP("PSB",$JOB,"GETADMIN")
SET ^TMP("PSB",$JOB,"GETADMIN",0)=PSBADST
+35 ; invalid admin times
+36 FOR Y=1:1:$LENGTH(PSBADST,"-")
Begin DoDot:3
+37 if ($PIECE(PSBADST,"-",Y)'?2N)&($PIECE(PSBADST,"-",Y)'?4N)
QUIT
End DoDot:3
+38 ; below is (Order Start Date, Report Date, Schedule)
+39 ; Screens QOD type stuff
if '$$OKAY^PSBVDLU1(PSBOST,PSBODATE,PSBSCH,PSBONX,$PIECE(^TMP("PSJ",$JOB,PSBX,3),U,2),PSBFREQ,PSBOSTS)
QUIT
+40 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)
+41 FOR PSBXX=0:1
if '$DATA(^TMP("PSB",$JOB,"GETADMIN",PSBXX))
QUIT
SET PSBADST=$GET(^TMP("PSB",$JOB,"GETADMIN",PSBXX))
Begin DoDot:3
+42 FOR Y=1:1:$LENGTH(PSBADST,"-")
Begin DoDot:4
+43 SET PSBDT=+("."_$PIECE(PSBADST,"-",Y))+(PSBSTRT\1)
+44 ; order Start Date
if PSBDT<PSBOST
QUIT
+45 ; order Stop Date
if PSBDT'<PSBOSP
QUIT
+46 ; report Window
if PSBDT<PSBSTRT
QUIT
+47 ; report Window
if PSBDT>PSBSTOP
QUIT
+48 ; if it is on the log quit, continue if status is "NOT GIVEN" or "MISSING"
IF $DATA(^PSB(53.79,"AORD",DFN,PSBONX,PSBDT))
Begin DoDot:5
+49 SET PSBINDX=$ORDER(^PSB(53.79,"AORD",DFN,PSBONX,PSBDT,""))
SET PSBSTUS=$PIECE(^PSB(53.79,PSBINDX,0),U,9)
End DoDot:5
IF PSBSTUS'="N"
IF PSBSTUS'="M"
QUIT
+50 SET ^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX)=""
+51 DO UDCONT
+52 IF PSBFLAG=1
SET ^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX)="(On Hold) "_$$FMTE^XLFDT(PSBHDDT)
+53 IF PSBFLAG=2
SET ^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX)="(On Hold) "_$$FMTE^XLFDT(PSBHDDT)_" "_"(Off Hold) "_$$FMTE^XLFDT(PSBUNHD)
QUIT
End DoDot:4
End DoDot:3
End DoDot:2
QUIT
+54 KILL PSBHDDT,PSBUNHD,^TMP("PSB1",$JOB)
+55 IF PSBSCHT="O"
Begin DoDot:2
+56 ; discontinued
if PSBOSTS["D"!(PSBOSTS="N")
QUIT
+57 ; Marked DO NOT GIVE
if PSBNGF
QUIT
+58 ;self med
if PSBSM
QUIT
+59 ; is the One Time Given?
+60 ;expired one-time
if PSBOSP=PSBOST
QUIT
+61 if PSBOST'<PSBSTOP
QUIT
+62 if PSBOSP<PSBSTRT
QUIT
+63 SET (PSBGVN,X,Y)=""
+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 IF $PIECE(^PSB(53.79,Y,.1),U)=PSBONX
IF $PIECE(^PSB(53.79,Y,0),U,9)'="N"
IF $PIECE(^PSB(53.79,Y,0),U,9)'="M"
SET PSBGVN=1
SET (X,Y)=0
End DoDot:4
End DoDot:3
+67 ; how long does One Time remain on the this report ??
+68 DO NOW^%DTC
+69 SET PSBRMN=1
+70 IF PSBSCHT="O"
IF PSBOSP'=PSBOST&(%>PSBOSP)
SET PSBRMN=0
+71 if ('PSBGVN)&(PSBRMN)
Begin DoDot:3
+72 SET VAR=""
+73 KILL ^TMP("PSJ2",$JOB),^TMP("PSB1",$JOB),PSBOACTL
DO EN^PSJBCMA2(DFN,PSBONX,1)
IF ^TMP("PSJ2",$JOB,0)'=1
Begin DoDot:4
+74 MERGE PSBOACTL=^TMP("PSJ2",$JOB)
+75 DO UDONE
+76 IF PSBFLAG=1
SET VAR="(On Hold) "_$$FMTE^XLFDT(PSBHDDT)
+77 IF PSBFLAG=2
SET VAR="(On Hold) "_$$FMTE^XLFDT(PSBHDDT)_" (Off Hold) "_$$FMTE^XLFDT(PSBUNHD)
End DoDot:4
+78 SET VAR=VAR_U_$TRANSLATE($$FMTE^XLFDT(PSBOST,2),"@"," ")
+79 SET VAR=VAR_U_$TRANSLATE($$FMTE^XLFDT(PSBOSP,2),"@"," ")
+80 SET $PIECE(^TMP("PSB",$JOB,DFN,"*** ONE-TIME ***",PSBOITX,PSBONX),U,1,4)=VAR
+81 KILL PSBHDDT,PSBUNHD,^TMP("PSB1",$JOB),PSBCNT
End DoDot:3
End DoDot:2
QUIT
End DoDot:1
+82 KILL PSBOACTL
+83 QUIT
+84 ;
PRINT ; print meds stored in ^TMP("PSB",$J,DFN,....
+1 NEW DFN,PSBHDR,PSBDT,PSBOITX,PSBONX,WARDIEN
+2 ; print by Ward
+3 if $PIECE(PSBRPT(.1),U,1)="W"
Begin DoDot:1
+4 SET PSBHDR(1)="RESPIRATORY THERAPY MEDICATIONS from "_$$FMTE^XLFDT($PIECE(PSBRPT(.1),U,6)+$PIECE(PSBRPT(.1),U,7))_" thru "_$$FMTE^XLFDT($PIECE(PSBRPT(.1),U,6)+$PIECE(PSBRPT(.1),U,9))
+5 ; WARD ien from #211.4
SET WARDIEN=$PIECE(PSBRPT(.1),U,3)
+6 ; don't print duplicate wards
IF $GET(FLAGPRT(WARDIEN))=1
QUIT
+7 WRITE $$WRDHDR()
+8 IF '$ORDER(^TMP("PSB",$JOB,0))
WRITE !,"No Medications Found"
QUIT
+9 SET PSBSORT=$PIECE(PSBRPT(.1),U,5)
+10 FOR DFN=0:0
SET DFN=$ORDER(^TMP("PSB",$JOB,DFN))
if 'DFN
QUIT
Begin DoDot:2
+11 SET PSBINDX=$SELECT(PSBSORT="P":$PIECE(^DPT(DFN,0),U),1:$GET(^DPT(DFN,.1))_" "_$GET(^(.101)))
+12 if PSBINDX=""
SET PSBINDX=$PIECE(^DPT(DFN,0),U)
+13 SET ^TMP("PSB",$JOB,"B",PSBINDX,DFN)=""
End DoDot:2
+14 SET PSBINDX=""
+15 FOR
SET PSBINDX=$ORDER(^TMP("PSB",$JOB,"B",PSBINDX))
if PSBINDX=""
QUIT
Begin DoDot:2
+16 FOR DFN=0:0
SET DFN=$ORDER(^TMP("PSB",$JOB,"B",PSBINDX,DFN))
if 'DFN
QUIT
Begin DoDot:3
+17 ; line break between patients
WRITE !
+18 SET PSBDT=""
+19 FOR
SET PSBDT=$ORDER(^TMP("PSB",$JOB,DFN,PSBDT))
if PSBDT=""
QUIT
Begin DoDot:4
+20 ;W ! ; line break between admin times, double-spacing of output
+21 SET PSBOITX=""
+22 FOR
SET PSBOITX=$ORDER(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX))
if PSBOITX=""
QUIT
Begin DoDot:5
+23 SET PSBONX=""
+24 FOR
SET PSBONX=$ORDER(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX))
if PSBONX=""
QUIT
Begin DoDot:6
+25 ;I $Y>(IOSL-5) W $$WRDHDR()
+26 WRITE !,+PSBONX,$SELECT(PSBONX["U":"UD",PSBONX["V":"IV",1:"")
+27 WRITE ?10,$GET(^DPT(DFN,.101),"**")
+28 WRITE ?30,$PIECE(^DPT(DFN,0),U)," (",$EXTRACT($PIECE(^(0),U,9),6,9),")"
+29 IF PSBDT["ONE-TIME"
Begin DoDot:7
+30 WRITE !,PSBDT,?30,PSBOITX," ",$PIECE(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX),U,1)
+31 WRITE !,"Start Date/Time: ",?30,$PIECE(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX),U,2)
+32 WRITE !,"Stop Date/Time: ",?30,$PIECE(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX),U,3)
+33 ;W ! ; stop double space
End DoDot:7
QUIT
+34 WRITE ?74,$SELECT(PSBDT:$$FMTE^XLFDT(PSBDT,2),1:PSBDT),?90,PSBOITX
+35 ; track wards that have been printed
SET FLAGPRT(WARDIEN)=1
+36 ;keep screen display for wards evenly spaced, no effect on a printer
IF $EXTRACT(IOST,1,2)="C-"
SET $Y=2
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+37 QUIT
+38 ;
WRDHDR() ; ward header
+1 DO WARD^PSBOHDR1(PSBWRD,.PSBHDR)
+2 WRITE !,"Ord Num",?10,"Room-Bed",?30,"Patient",?74,"Admin Date/Time",?90,"Medication"
+3 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","-")
+4 QUIT ""
+5 ;
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 QUIT
+16 ;
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 QUIT
