PSBOWA ;BIRMINGHAM/EFC-WARD ADMINISTRATION TIMES ;2/6/21 18:03
;;3.0;BAR CODE MED ADMIN;**9,32,56,70,80,83,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
;
;*70 - add Clinic filter and clinic name into array
; 1480: Add clinic to header and breakdown by clinic in detail.
;*83 - add ability to print Scheduled Removals on Patient report
; - count Removes in the Ward & Clinic reports.
;*106- add Hazardous Handle & Dispose flags
;
EN ;
N PSBHDR,PSBGTOT,PSBTOT,PSBINDX,DFN,PSBX,PSBY,PSBSM,PSBADST,PSBZ
N PSBSRCHL,PSBSORT,PSBCL ;*70
N RMDT,PSBIEN
S PSBSORT=$P(PSBRPT(.1),U,1) ;init PSBSORT ;*70
S (Y,PSBEVDT)=$P(PSBRPT(.1),U,6) D D^DIQ
S PSBHDR(2)="ADMINISTRATION DATE: "_Y
;check Clinic or Nurs Unit search list ;*70
S PSBSRCHL=$$SRCHLIST^PSBOHDR()
D:$G(PSBSRCHL)]""
.S PSBHDR(3)=""
.S:$P(PSBRPT(4),U,2)="C" PSBHDR(4)="Clinic Search List: "
.S:$P(PSBRPT(4),U,2)="I" PSBHDR(4)="Ward Location: "
;
S (Y,PSBEVDT2)=$S($P(PSBRPT(.1),U,8)']"":PSBEVDT,1:$P(PSBRPT(.1),U,8)) D D^DIQ
S PSBHDR(2)=PSBHDR(2)_" to "_Y
;
I PSBSORT="P" D PATIENT
I PSBSORT="W" D WARD
I PSBSORT="C" D CLINIC
D QUIT
Q
;
PATIENT ;* * * Print By Patient * * *
F PSBIX=0:1 S PSBRPDT=$$FMADD^XLFDT(PSBEVDT,PSBIX) Q:PSBRPDT>PSBEVDT2!(PSBRPDT="-1") D
.; * * * Print By Patient * * *
.D:PSBSORT="P"
..S DFN=PSBDFN
..K ^TMP("PSJ",$J)
..D EN^PSJBCMA(PSBDFN,PSBRPDT,"")
..D:PSBCLINORD ;*70 filer clinics
... I $D(PSBRPT(2)) D FILTERCO^PSBO Q
... D INCLUDCO^PSBVDLU1
..I 'PSBCLINORD D REMOVECO^PSBVDLU1 ;*70
..F PSBX=0:0 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)
...Q:PSBSCHT'="C" ; Not a Continuous
...Q:PSBOSTS'="A"&(PSBOSTS'="R")&(PSBOSTS'="O") ; Active? - PSB*3*56 adds on call as an active status
...S (PSBCADM,PSBYES,PSBODD)=0
...S PSBFREQ=$$GETFREQ^PSBVDLU1(DFN,PSBONX)
...S:$$PSBDCHK1^PSBVT1(PSBSCH) PSBYES=1
...F I=1:1 Q:$P(PSBSCH,"-",I)="" I ($P(PSBSCH,"-",I)?2N)!($P(PSBSCH,"-",I)?4N) S PSBYES=1
...I PSBYES,PSBADST="",PSBSCHT'="O",PSBSCHT'="OC",PSBSCHT'="P" D Q
....D ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Admin times required",PSBSCH)
...I "PCS"'[PSBIVT,PSBONX'["U" Q
...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
...I PSBFREQ="D" S PSBFREQ=""
...I 'PSBYES,PSBFREQ<1 D Q
....D ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Invalid frequency received from order",PSBSCH)
...I +PSBFREQ>0 D
....I (PSBFREQ#1440'=0),(1440#PSBFREQ'=0) S PSBODD=1
...I PSBODD,PSBADST'="" D Q
....D ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Administration Times on ODD SCHEDULE",PSBSCH)
...K ^TMP("PSB",$J,"GETADMIN")
...I PSBADST="",+$G(PSBFREQ)>0,$G(PSBFREQ)<30 S PSBADST="MESSAGE",$P(PSBTOT(PSBADST,PSBOITX,PSBONX),2)="Due every "_PSBFREQ_" Mins" Q
...I PSBADST="",+$G(PSBFREQ)'<30 S PSBADST=$$GETADMIN^PSBVDLU1(DFN,PSBONX,PSBOST,PSBFREQ,PSBRPDT) S:PSBADST'="" PSBCADM=1
...E S ^TMP("PSB",$J,"GETADMIN",0)=PSBADST
...Q:PSBADST=""
...I PSBONX'["V" D Q:'$$OKAY^PSBVDLU1(PSBOST,PSBRPDT,PSBSCH,PSBONX,PSBOIT,PSBFREQ)
...I PSBONX["V",PSBSCH'="" Q:'$$OKAY^PSBVDLU1(PSBOST,PSBRPDT,PSBSCH,PSBONX,PSBOIT,PSBFREQ)
...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,"-") S Z=+("."_$P(PSBADST,"-",Y)) D
.....Q:(PSBRPDT+Z)<$E(PSBOST,1,12) ; Start Date
.....Q:(PSBRPDT+Z)'<$E(PSBOSP,1,12) ; Stop Date
.....;For Invalid admin times
.....D:($P(PSBADST,"-",Y)'?2N)&($P(PSBADST,"-",Y)'?4N)
......D ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Invalid Admin times",PSBSCH)
.....S PSBSM=$S(PSBHSM=1:"HSM",PSBSM=1:"SM",1:"")
.....;*** Local array to include order no
.....S PSBTOT(PSBRPDT+Z,PSBOITX_"[sort2]",PSBONX)=PSBSM_U_"Dosage: "_PSBDOSE_" Route: "_PSBMR_" "_PSBIFR_U_PSBCLORD_U_U_PSBHAZHN_U_PSBHAZDS ;add clinic name *70 ;sort Gives 2nd *83 ;*106 adds haz handle/dispose notice 5 & 6 piece
;
;process removes for MRR meds and add to print array if applies
K ^TMP("PSB",$J,"RM")
D GETREMOV^PSBO1(DFN)
;
D:$D(^TMP("PSB",$J,"RM"))
.F PSBIEN=0:0 S PSBIEN=$O(^TMP("PSB",$J,"RM",PSBIEN)) Q:'PSBIEN D
..S RMDT=$P(^TMP("PSB",$J,"RM",PSBIEN),U,1)
..Q:($P(RMDT,".")<PSBEVDT)!($P(RMDT,".")>PSBEVDT2)
..S PSBCLORD=$P(^TMP("PSB",$J,"RM",PSBIEN),U,6) ;CLOR
..Q:(PSBCLINORD)&(PSBCLORD="")
..Q:('PSBCLINORD)&(PSBCLORD]"")
..S PSBONX=$P(^TMP("PSB",$J,"RM",PSBIEN),U,2) ;ONX
..S PSBOITX=$P(^TMP("PSB",$J,"RM",PSBIEN),U,3) ;OITX
..S PSBOSTS=$P(^TMP("PSB",$J,"RM",PSBIEN),U,4) ;OSTS
..S PSBOSP=$P(^TMP("PSB",$J,"RM",PSBIEN),U,5) ;OSP
..S PSBDOSE=$P(^TMP("PSB",$J,"RM",PSBIEN),U,7) ;DOSE
..S PSBMR=$P(^TMP("PSB",$J,"RM",PSBIEN),U,8) ;MR
..S PSBSM=$P(^TMP("PSB",$J,"RM",PSBIEN),U,9) ;SM
..S PSBSM=$S($G(PSBHSM)=1:"HSM",PSBSM=1:"SM",1:"")
..S PSBIFR="" ;infuse rt n/a for MRR meds
..S PSBHAZHN=$P(^TMP("PSB",$J,"RM",PSBIEN),U,10) ;HAZHAN
..S PSBHAZDS=$P(^TMP("PSB",$J,"RM",PSBIEN),U,11) ;HAZDIS
..S PSBTOT(RMDT,PSBOITX_"[sort1]",PSBONX)=PSBSM_U_"Dosage: "_PSBDOSE_" Route: "_PSBMR_" "_PSBIFR_U_PSBCLORD_U_"(RM)"_U_PSBHAZHN_U_PSBHAZDS ;sort RMs 1st *83 '*106 adds haz handle/dispose notice
;
;print the patient report
N PREVRPDT ;*83
S PSBHDR(1)="WARD ADMINISTRATION TIMES"
S Y=$P(PSBRPT(.1),U,6) D D^DIQ S PSBHDR(2)="ADMINISTRATION DATE: "_Y
S Y=PSBEVDT2 D D^DIQ S PSBHDR(2)=PSBHDR(2)_" to "_Y
S PREVRPDT=""
W:'$D(PSBTOT) $$PTHDR() ;insure a header when no records found
S PSBX="" F S PSBX=$O(PSBTOT(PSBX)) Q:PSBX="" D
.S PSBRPDT=$P(PSBX,".")
.;write hdr for each date found
.I PREVRPDT'=PSBRPDT W $$PTHDR() S PREVRPDT=PSBRPDT
.W !
.S PSBY="" F S PSBY=$O(PSBTOT(PSBX,PSBY)) Q:PSBY="" D
..S PSBZ="" F S PSBZ=$O(PSBTOT(PSBX,PSBY,PSBZ)) Q:PSBZ="" D
...W:$Y>(IOSL-6) $$PTFTR^PSBOHDR(),$$PTHDR()
...I PSBX="MESSAGE" W !,$P(PSBTOT(PSBX,PSBY,PSBZ),U,1),?20,PSBY Q
...W:PSBCLINORD !,$P(PSBTOT(PSBX,PSBY,PSBZ),U,3)
...W !,$$TIMEOUT^PSBUTL(PSBX)," ",$P(PSBTOT(PSBX,PSBY,PSBZ),U,4),?13 ;remove code piece 4 if exists *83
...W $P(PSBTOT(PSBX,PSBY,PSBZ),U,1),?20,$P(PSBY,"[sort"),?55,$P(PSBTOT(PSBX,PSBY,PSBZ),U,2) ;*83
...;*106 adds haz handle/dispose notice
...I ($P(PSBTOT(PSBX,PSBY,PSBZ),U,5)=1)!($P(PSBTOT(PSBX,PSBY,PSBZ),U,6)=1) W !
...W:$P(PSBTOT(PSBX,PSBY,PSBZ),U,5)=1 ?20,"<<HAZ HANDLE>> "
...W:$P(PSBTOT(PSBX,PSBY,PSBZ),U,6)=1 ?20,"<<HAZ DISPOSE>>"
W $$PTFTR^PSBOHDR() ;write end of rpt footer
Q
;
WARD ;* * * * Print By Ward * * *
F PSBIX=0:1 S PSBRPDT=$$FMADD^XLFDT(PSBEVDT,PSBIX) Q:PSBRPDT>PSBEVDT2!(PSBRPDT="-1") D
.F X=0,.01:.01:.24 S PSBGTOT(X)=""
.W $$WRDHDR()
.S PSBINDX=""
.F S PSBINDX=$O(^TMP("PSBO",$J,"B",PSBINDX)) Q:PSBINDX="" D
..F DFN=0:0 S DFN=$O(^TMP("PSBO",$J,"B",PSBINDX,DFN)) Q:'DFN D
...W:$Y>(IOSL-10) $$WRDHDR()
...W !,$P(^DPT(DFN,0),U,1),!,"SSN: ",$P(^(0),U,9)
...W !,"Ward: ",$E($G(^DPT(DFN,.1)),1,25),!,"Room-Bed: ",$E($G(^(.101)),1,21)
...W ?32
...F X=0,.01:.01:.24 S PSBTOT(X)=""
...K ^TMP("PSJ",$J)
...D EN^PSJBCMA(DFN,$P(PSBRPT(.1),U,6))
...D REMOVECO^PSBVDLU1 ;*70 always remove CO orders from ward
...F PSBX=0:0 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)
....Q:PSBSCHT'="C" ; Not a Continuous
....Q:PSBOSTS'="A"&(PSBOSTS'="R")&(PSBOSTS'="O") ; Active? - PSB*3*56 adds on call as an active status
....Q:PSBSM=1 ;Self med?
....S (PSBCADM,PSBYES,PSBODD)=0
....S PSBFREQ=$$GETFREQ^PSBVDLU1(DFN,PSBONX)
....S:$$PSBDCHK1^PSBVT1(PSBSCH) PSBYES=1
....F I=1:1 Q:$P(PSBSCH,"-",I)="" I ($P(PSBSCH,"-",I)?2N)!($P(PSBSCH,"-",I)?4N) S PSBYES=1
....I PSBYES,PSBADST="",PSBSCHT'="O",PSBSCHT'="OC",PSBSCHT'="P" D Q
.....D ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Admin times required",PSBSCH)
....I "PCS"'[PSBIVT,PSBONX'["U" Q
....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
....I PSBFREQ="D" S PSBFREQ=""
....I 'PSBYES,PSBFREQ<1 D Q
.....D ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Invalid frequency received from order",PSBSCH)
....I +PSBFREQ>0 D
.....I (PSBFREQ#1440'=0),(1440#PSBFREQ'=0) S PSBODD=1
....I PSBODD,PSBADST'="" D Q
.....D ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Administration Times on ODD SCHEDULE",PSBSCH)
....K ^TMP("PSB",$J,"GETADMIN")
....I PSBADST="" S PSBADST=$$GETADMIN^PSBVDLU1(DFN,PSBONX,PSBOST,PSBFREQ,PSBRPDT) S:PSBADST'="" PSBCADM=1
....E S ^TMP("PSB",$J,"GETADMIN",0)=PSBADST
....Q:PSBADST=""
....I PSBONX'["V" D Q:'$$OKAY^PSBVDLU1(PSBOST,PSBRPDT,PSBSCH,PSBONX,PSBOIT,PSBFREQ) ;*70
....I PSBONX["V",PSBSCH'="" Q:'$$OKAY^PSBVDLU1(PSBOST,PSBRPDT,PSBSCH,PSBONX,PSBOIT,PSBFREQ) ;*70
....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,"-") S Z=+("."_$E($P(PSBADST,"-",Y),1,2)) D
......Q:((PSBRPDT+Z)<$E(PSBOST,1,12))&($G(Z)'=0) ;Start Date
......Q:(PSBRPDT+Z)'<$E(PSBOSP,1,12) ;Stop Date
......;For invalid admin times
......D:($P(PSBADST,"-",Y)'?2N)&($P(PSBADST,"-",Y)'?4N)
.......D ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Invalid Admin times",PSBSCH)
......S PSBTOT(Z)=PSBTOT(Z)+1
......S PSBGTOT(Z)=PSBGTOT(Z)+1
......D:PSBMRRFL ;mrr meds admins have a Remove, count it *83
.......S PSBTOT(Z)=PSBTOT(Z)+1
.......S PSBGTOT(Z)=PSBGTOT(Z)+1
...;print ward stats rpt from array
...S PSBX="" F S PSBX=$O(PSBTOT(PSBX)) Q:$G(PSBX)="" W $J(PSBTOT(PSBX),4)
...W !,$TR($J("",IOM)," ","-")
.W !!,$TR($J("",IOM)," ","=")
.W !?32 F X=0,.01:.01:.24 W $J($E(X_"00",2,3),4)
.W !,"Hourly Totals:",?32
.S PSBGTOT=0
.S PSBX="" F S PSBX=$O(PSBGTOT(PSBX)) Q:$G(PSBX)="" D
..W $J(PSBGTOT(PSBX),4)
..S PSBGTOT=PSBGTOT+PSBGTOT(PSBX)
.W !!,"Ward Total:",?32,$J(PSBGTOT,4)
.W !!,$TR($J("",IOM)," ","-")
Q
;
CLINIC ;* * * Print By Clinic * * * ;*70-1480
F PSBIX=0:1 S PSBRPDT=$$FMADD^XLFDT(PSBEVDT,PSBIX) Q:PSBRPDT>PSBEVDT2!(PSBRPDT="-1") D
.F X=0,.01:.01:.24 S PSBGTOT(PSBRPDT,X)=""
.S PSBINDX=""
.F S PSBINDX=$O(^TMP("PSBO",$J,"B",PSBINDX)) Q:PSBINDX="" D
..F DFN=0:0 S DFN=$O(^TMP("PSBO",$J,"B",PSBINDX,DFN)) Q:'DFN D
...K ^TMP("PSJ",$J)
...D EN^PSJBCMA(DFN,$P(PSBRPT(.1),U,6))
...;Filter in/out Clinic Orders *70
...D:PSBCLINORD
....I $D(PSBRPT(2)) D FILTERCO^PSBO Q
....D INCLUDCO^PSBVDLU1
...F PSBX=0:0 S PSBX=$O(^TMP("PSJ",$J,PSBX)) Q:'PSBX D
....S PSBCL=$P($G(^TMP("PSJ",$J,PSBX,0)),U,11)
....I PSBCL]"" F X=0,.01:.01:.24 S PSBTOT(PSBRPDT,DFN,PSBCL,X)=""
...F PSBX=0:0 S PSBX=$O(^TMP("PSJ",$J,PSBX)) Q:'PSBX D
....S PSBCL=$P($G(^TMP("PSJ",$J,PSBX,0)),U,11)
....Q:^TMP("PSJ",$J,PSBX,0)=-1 ; No Orders
....D CLEAN^PSBVT
....D PSJ^PSBVT(PSBX)
....Q:PSBSCHT'="C" ; Not a Continuous
....Q:PSBOSTS'="A"&(PSBOSTS'="R")&(PSBOSTS'="O") ; Active? - PSB*3*56 adds on call as an active status
....Q:PSBSM=1 ;Self med?
....S (PSBCADM,PSBYES,PSBODD)=0
....S PSBFREQ=$$GETFREQ^PSBVDLU1(DFN,PSBONX)
....S:$$PSBDCHK1^PSBVT1(PSBSCH) PSBYES=1
....F I=1:1 Q:$P(PSBSCH,"-",I)="" I ($P(PSBSCH,"-",I)?2N)!($P(PSBSCH,"-",I)?4N) S PSBYES=1
....I PSBYES,PSBADST="",PSBSCHT'="O",PSBSCHT'="OC",PSBSCHT'="P" D Q
.....D ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Admin times required",PSBSCH)
....I "PCS"'[PSBIVT,PSBONX'["U" Q
....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
....I PSBFREQ="D" S PSBFREQ=""
....I 'PSBYES,PSBFREQ<1 D Q
.....D ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Invalid frequency received from order",PSBSCH)
....I +PSBFREQ>0 D
.....I (PSBFREQ#1440'=0),(1440#PSBFREQ'=0) S PSBODD=1
....I PSBODD,PSBADST'="" D Q
.....D ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Administration Times on ODD SCHEDULE",PSBSCH)
....K ^TMP("PSB",$J,"GETADMIN")
....I PSBADST="" S PSBADST=$$GETADMIN^PSBVDLU1(DFN,PSBONX,PSBOST,PSBFREQ,PSBRPDT) S:PSBADST'="" PSBCADM=1
....E S ^TMP("PSB",$J,"GETADMIN",0)=PSBADST
....Q:PSBADST=""
....I PSBONX'["V" D Q:'$$OKAY^PSBVDLU1(PSBOST,PSBRPDT,PSBSCH,PSBONX,PSBOIT,PSBFREQ)
....I PSBONX["V",PSBSCH'="" Q:'$$OKAY^PSBVDLU1(PSBOST,PSBRPDT,PSBSCH,PSBONX,PSBOIT,PSBFREQ)
....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,"-") S Z=+("."_$E($P(PSBADST,"-",Y),1,2)) D
......Q:((PSBRPDT)<$E(PSBOST,1,12))&($G(Z)'=0) ;Start Date
......Q:(PSBRPDT)'<$E(PSBOSP,1,12) ;Stop Date
......;For invalid admin times
......D:($P(PSBADST,"-",Y)'?2N)&($P(PSBADST,"-",Y)'?4N)
.......D ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Invalid Admin times",PSBSCH)
......S PSBTOT(PSBRPDT,DFN,PSBCL,Z)=PSBTOT(PSBRPDT,DFN,PSBCL,Z)+1
......S PSBGTOT(PSBRPDT,Z)=PSBGTOT(PSBRPDT,Z)+1
......D:PSBMRRFL ;mrr meds admins have a Remove, count it *83
.......S PSBTOT(PSBRPDT,DFN,PSBCL,Z)=PSBTOT(PSBRPDT,DFN,PSBCL,Z)+1
.......S PSBGTOT(PSBRPDT,Z)=PSBGTOT(PSBRPDT,Z)+1
.;
.;print clinic stats rpt from array
.S PSBRPDT="" F S PSBRPDT=$O(PSBTOT(PSBRPDT)) Q:PSBRPDT="" D
..W $$CLNHDR()
..S DFN="" F S DFN=$O(PSBTOT(PSBRPDT,DFN)) Q:DFN="" D
...W:$Y>(IOSL-10) $$CLNHDR()
...W !,$P(^DPT(DFN,0),U),!,$P(^(0),U,9)
...S PSBCL="" F S PSBCL=$O(PSBTOT(PSBRPDT,DFN,PSBCL)) Q:PSBCL="" D
....W:$Y>(IOSL-10) $$CLNHDR()
....W !,PSBCL,?32
....S PSBX="" F S PSBX=$O(PSBTOT(PSBRPDT,DFN,PSBCL,PSBX)) Q:PSBX="" D
.....W:$Y>(IOSL-10) $$CLNHDR()
.....W $J(PSBTOT(PSBRPDT,DFN,PSBCL,PSBX),4)
...W !,$TR($J("",IOM)," ","-")
..W !!,$TR($J("",IOM)," ","=")
..W !?32 F X=0,.01:.01:.24 W $J($E(X_"00",2,3),4)
..W !,"Hourly Totals:",?32
..S PSBGTOT=0
..S PSBX="" F S PSBX=$O(PSBGTOT(PSBRPDT,PSBX)) Q:$G(PSBX)="" D
...W $J(PSBGTOT(PSBRPDT,PSBX),4)
...S PSBGTOT=PSBGTOT+PSBGTOT(PSBRPDT,PSBX)
..W !!,"Report Date Total:",?32,$J(PSBGTOT,4)
..W !!,$TR($J("",IOM)," ","-")
Q
;
QUIT D CLEAN^PSBVT
K I,^TMP("PSJ",$J),^TMP("PSB",$J)
Q
;
;
WRDHDR() ;
S PSBHDR(1)="WARD ADMINISTRATION TIMES"
D WARD^PSBOHDR(PSBWRD,.PSBHDR,,,PSBSRCHL)
S Y=PSBRPDT D D^DIQ
W !,"Patient Name",?64,Y_" Administration Times"
W !,"Room-Bed",?32
F X=0,.01:.01:.24 W $J($E(X_"00",2,3),4)
W !,$TR($J("",IOM)," ","-")
Q ""
;
CLNHDR() ;
S PSBHDR(1)="CLINIC ADMINISTRATION TIMES"
D CLINIC^PSBOHDR(.PSBRPT,.PSBHDR,,,PSBSRCHL)
;
S Y=PSBRPDT D D^DIQ
W !,"Patient Name",?64,Y_" Administration Times"
W !,"SSN",!,"Location",?32 ;*70
F X=0,.01:.01:.24 W $J($E(X_"00",2,3),4)
W !,$TR($J("",IOM)," ","-")
Q ""
;
PTHDR() ;
S PSBHDR(1)="PATIENT ADMINISTRATION TIMES"
D PT^PSBOHDR(PSBDFN,.PSBHDR,,,PSBSRCHL)
W:PSBCLINORD !,"Location"
W !,"Date/Time",?10,"Self Med",?20,"Medication",?55,"Dose/Route"
W !,$TR($J("",IOM)," ","-")
S Y=PSBRPDT D D^DIQ
W !!,Y,!
Q ""
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSBOWA 15609 printed Dec 13, 2024@01:40:57 Page 2
PSBOWA ;BIRMINGHAM/EFC-WARD ADMINISTRATION TIMES ;2/6/21 18:03
+1 ;;3.0;BAR CODE MED ADMIN;**9,32,56,70,80,83,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 ;
+8 ;*70 - add Clinic filter and clinic name into array
+9 ; 1480: Add clinic to header and breakdown by clinic in detail.
+10 ;*83 - add ability to print Scheduled Removals on Patient report
+11 ; - count Removes in the Ward & Clinic reports.
+12 ;*106- add Hazardous Handle & Dispose flags
+13 ;
EN ;
+1 NEW PSBHDR,PSBGTOT,PSBTOT,PSBINDX,DFN,PSBX,PSBY,PSBSM,PSBADST,PSBZ
+2 ;*70
NEW PSBSRCHL,PSBSORT,PSBCL
+3 NEW RMDT,PSBIEN
+4 ;init PSBSORT ;*70
SET PSBSORT=$PIECE(PSBRPT(.1),U,1)
+5 SET (Y,PSBEVDT)=$PIECE(PSBRPT(.1),U,6)
DO D^DIQ
+6 SET PSBHDR(2)="ADMINISTRATION DATE: "_Y
+7 ;check Clinic or Nurs Unit search list ;*70
+8 SET PSBSRCHL=$$SRCHLIST^PSBOHDR()
+9 if $GET(PSBSRCHL)]""
Begin DoDot:1
+10 SET PSBHDR(3)=""
+11 if $PIECE(PSBRPT(4),U,2)="C"
SET PSBHDR(4)="Clinic Search List: "
+12 if $PIECE(PSBRPT(4),U,2)="I"
SET PSBHDR(4)="Ward Location: "
End DoDot:1
+13 ;
+14 SET (Y,PSBEVDT2)=$SELECT($PIECE(PSBRPT(.1),U,8)']"":PSBEVDT,1:$PIECE(PSBRPT(.1),U,8))
DO D^DIQ
+15 SET PSBHDR(2)=PSBHDR(2)_" to "_Y
+16 ;
+17 IF PSBSORT="P"
DO PATIENT
+18 IF PSBSORT="W"
DO WARD
+19 IF PSBSORT="C"
DO CLINIC
+20 DO QUIT
+21 QUIT
+22 ;
PATIENT ;* * * Print By Patient * * *
+1 FOR PSBIX=0:1
SET PSBRPDT=$$FMADD^XLFDT(PSBEVDT,PSBIX)
if PSBRPDT>PSBEVDT2!(PSBRPDT="-1")
QUIT
Begin DoDot:1
+2 ; * * * Print By Patient * * *
+3 if PSBSORT="P"
Begin DoDot:2
+4 SET DFN=PSBDFN
+5 KILL ^TMP("PSJ",$JOB)
+6 DO EN^PSJBCMA(PSBDFN,PSBRPDT,"")
+7 ;*70 filer clinics
if PSBCLINORD
Begin DoDot:3
+8 IF $DATA(PSBRPT(2))
DO FILTERCO^PSBO
QUIT
+9 DO INCLUDCO^PSBVDLU1
End DoDot:3
+10 ;*70
IF 'PSBCLINORD
DO REMOVECO^PSBVDLU1
+11 FOR PSBX=0:0
SET PSBX=$ORDER(^TMP("PSJ",$JOB,PSBX))
if 'PSBX
QUIT
Begin DoDot:3
+12 ; No Orders
if ^TMP("PSJ",$JOB,PSBX,0)=-1
QUIT
+13 DO CLEAN^PSBVT
+14 DO PSJ^PSBVT(PSBX)
+15 ; Not a Continuous
if PSBSCHT'="C"
QUIT
+16 ; Active? - PSB*3*56 adds on call as an active status
if PSBOSTS'="A"&(PSBOSTS'="R")&(PSBOSTS'="O")
QUIT
+17 SET (PSBCADM,PSBYES,PSBODD)=0
+18 SET PSBFREQ=$$GETFREQ^PSBVDLU1(DFN,PSBONX)
+19 if $$PSBDCHK1^PSBVT1(PSBSCH)
SET PSBYES=1
+20 FOR I=1:1
if $PIECE(PSBSCH,"-",I)=""
QUIT
IF ($PIECE(PSBSCH,"-",I)?2N)!($PIECE(PSBSCH,"-",I)?4N)
SET PSBYES=1
+21 IF PSBYES
IF PSBADST=""
IF PSBSCHT'="O"
IF PSBSCHT'="OC"
IF PSBSCHT'="P"
Begin DoDot:4
+22 DO ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Admin times required",PSBSCH)
End DoDot:4
QUIT
+23 IF "PCS"'[PSBIVT
IF PSBONX'["U"
QUIT
+24 ; allow intermittent syringe only
IF PSBIVT["S"
IF PSBISYR'=1
QUIT
+25 IF PSBIVT["C"
IF PSBCHEMT'="P"
IF PSBISYR'=1
QUIT
+26 ; allow Chemo with intermittent syringe or Piggyback type only
IF PSBIVT["C"
IF PSBCHEMT="A"
QUIT
+27 IF PSBFREQ="D"
SET PSBFREQ=""
+28 IF 'PSBYES
IF PSBFREQ<1
Begin DoDot:4
+29 DO ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Invalid frequency received from order",PSBSCH)
End DoDot:4
QUIT
+30 IF +PSBFREQ>0
Begin DoDot:4
+31 IF (PSBFREQ#1440'=0)
IF (1440#PSBFREQ'=0)
SET PSBODD=1
End DoDot:4
+32 IF PSBODD
IF PSBADST'=""
Begin DoDot:4
+33 DO ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Administration Times on ODD SCHEDULE",PSBSCH)
End DoDot:4
QUIT
+34 KILL ^TMP("PSB",$JOB,"GETADMIN")
+35 IF PSBADST=""
IF +$GET(PSBFREQ)>0
IF $GET(PSBFREQ)<30
SET PSBADST="MESSAGE"
SET $PIECE(PSBTOT(PSBADST,PSBOITX,PSBONX),2)="Due every "_PSBFREQ_" Mins"
QUIT
+36 IF PSBADST=""
IF +$GET(PSBFREQ)'<30
SET PSBADST=$$GETADMIN^PSBVDLU1(DFN,PSBONX,PSBOST,PSBFREQ,PSBRPDT)
if PSBADST'=""
SET PSBCADM=1
+37 IF '$TEST
SET ^TMP("PSB",$JOB,"GETADMIN",0)=PSBADST
+38 if PSBADST=""
QUIT
+39 IF PSBONX'["V"
Begin DoDot:4
End DoDot:4
if '$$OKAY^PSBVDLU1(PSBOST,PSBRPDT,PSBSCH,PSBONX,PSBOIT,PSBFREQ)
QUIT
+40 IF PSBONX["V"
IF PSBSCH'=""
if '$$OKAY^PSBVDLU1(PSBOST,PSBRPDT,PSBSCH,PSBONX,PSBOIT,PSBFREQ)
QUIT
+41 FOR PSBXX=0:1
if '$DATA(^TMP("PSB",$JOB,"GETADMIN",PSBXX))
QUIT
SET PSBADST=$GET(^TMP("PSB",$JOB,"GETADMIN",PSBXX))
Begin DoDot:4
+42 FOR Y=1:1:$LENGTH(PSBADST,"-")
SET Z=+("."_$PIECE(PSBADST,"-",Y))
Begin DoDot:5
+43 ; Start Date
if (PSBRPDT+Z)<$EXTRACT(PSBOST,1,12)
QUIT
+44 ; Stop Date
if (PSBRPDT+Z)'<$EXTRACT(PSBOSP,1,12)
QUIT
+45 ;For Invalid admin times
+46 if ($PIECE(PSBADST,"-",Y)'?2N)&($PIECE(PSBADST,"-",Y)'?4N)
Begin DoDot:6
+47 DO ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Invalid Admin times",PSBSCH)
End DoDot:6
+48 SET PSBSM=$SELECT(PSBHSM=1:"HSM",PSBSM=1:"SM",1:"")
+49 ;*** Local array to include order no
+50 ;add clinic name *70 ;sort Gives 2nd *83 ;*106 adds haz handle/dispose notice 5 & 6 piece
SET PSBTOT(PSBRPDT+Z,PSBOITX_"[sort2]",PSBONX)=PSBSM_U_"Dosage: "_PSBDOSE_" Route: "_PSBMR_" "_PSBIFR_U_PSBCLORD_U_U_PSBHAZHN_U_PSBHAZDS
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+51 ;
+52 ;process removes for MRR meds and add to print array if applies
+53 KILL ^TMP("PSB",$JOB,"RM")
+54 DO GETREMOV^PSBO1(DFN)
+55 ;
+56 if $DATA(^TMP("PSB",$JOB,"RM"))
Begin DoDot:1
+57 FOR PSBIEN=0:0
SET PSBIEN=$ORDER(^TMP("PSB",$JOB,"RM",PSBIEN))
if 'PSBIEN
QUIT
Begin DoDot:2
+58 SET RMDT=$PIECE(^TMP("PSB",$JOB,"RM",PSBIEN),U,1)
+59 if ($PIECE(RMDT,".")<PSBEVDT)!($PIECE(RMDT,".")>PSBEVDT2)
QUIT
+60 ;CLOR
SET PSBCLORD=$PIECE(^TMP("PSB",$JOB,"RM",PSBIEN),U,6)
+61 if (PSBCLINORD)&(PSBCLORD="")
QUIT
+62 if ('PSBCLINORD)&(PSBCLORD]"")
QUIT
+63 ;ONX
SET PSBONX=$PIECE(^TMP("PSB",$JOB,"RM",PSBIEN),U,2)
+64 ;OITX
SET PSBOITX=$PIECE(^TMP("PSB",$JOB,"RM",PSBIEN),U,3)
+65 ;OSTS
SET PSBOSTS=$PIECE(^TMP("PSB",$JOB,"RM",PSBIEN),U,4)
+66 ;OSP
SET PSBOSP=$PIECE(^TMP("PSB",$JOB,"RM",PSBIEN),U,5)
+67 ;DOSE
SET PSBDOSE=$PIECE(^TMP("PSB",$JOB,"RM",PSBIEN),U,7)
+68 ;MR
SET PSBMR=$PIECE(^TMP("PSB",$JOB,"RM",PSBIEN),U,8)
+69 ;SM
SET PSBSM=$PIECE(^TMP("PSB",$JOB,"RM",PSBIEN),U,9)
+70 SET PSBSM=$SELECT($GET(PSBHSM)=1:"HSM",PSBSM=1:"SM",1:"")
+71 ;infuse rt n/a for MRR meds
SET PSBIFR=""
+72 ;HAZHAN
SET PSBHAZHN=$PIECE(^TMP("PSB",$JOB,"RM",PSBIEN),U,10)
+73 ;HAZDIS
SET PSBHAZDS=$PIECE(^TMP("PSB",$JOB,"RM",PSBIEN),U,11)
+74 ;sort RMs 1st *83 '*106 adds haz handle/dispose notice
SET PSBTOT(RMDT,PSBOITX_"[sort1]",PSBONX)=PSBSM_U_"Dosage: "_PSBDOSE_" Route: "_PSBMR_" "_PSBIFR_U_PSBCLORD_U_"(RM)"_U_PSBHAZHN_U_PSBHAZDS
End DoDot:2
End DoDot:1
+75 ;
+76 ;print the patient report
+77 ;*83
NEW PREVRPDT
+78 SET PSBHDR(1)="WARD ADMINISTRATION TIMES"
+79 SET Y=$PIECE(PSBRPT(.1),U,6)
DO D^DIQ
SET PSBHDR(2)="ADMINISTRATION DATE: "_Y
+80 SET Y=PSBEVDT2
DO D^DIQ
SET PSBHDR(2)=PSBHDR(2)_" to "_Y
+81 SET PREVRPDT=""
+82 ;insure a header when no records found
if '$DATA(PSBTOT)
WRITE $$PTHDR()
+83 SET PSBX=""
FOR
SET PSBX=$ORDER(PSBTOT(PSBX))
if PSBX=""
QUIT
Begin DoDot:1
+84 SET PSBRPDT=$PIECE(PSBX,".")
+85 ;write hdr for each date found
+86 IF PREVRPDT'=PSBRPDT
WRITE $$PTHDR()
SET PREVRPDT=PSBRPDT
+87 WRITE !
+88 SET PSBY=""
FOR
SET PSBY=$ORDER(PSBTOT(PSBX,PSBY))
if PSBY=""
QUIT
Begin DoDot:2
+89 SET PSBZ=""
FOR
SET PSBZ=$ORDER(PSBTOT(PSBX,PSBY,PSBZ))
if PSBZ=""
QUIT
Begin DoDot:3
+90 if $Y>(IOSL-6)
WRITE $$PTFTR^PSBOHDR(),$$PTHDR()
+91 IF PSBX="MESSAGE"
WRITE !,$PIECE(PSBTOT(PSBX,PSBY,PSBZ),U,1),?20,PSBY
QUIT
+92 if PSBCLINORD
WRITE !,$PIECE(PSBTOT(PSBX,PSBY,PSBZ),U,3)
+93 ;remove code piece 4 if exists *83
WRITE !,$$TIMEOUT^PSBUTL(PSBX)," ",$PIECE(PSBTOT(PSBX,PSBY,PSBZ),U,4),?13
+94 ;*83
WRITE $PIECE(PSBTOT(PSBX,PSBY,PSBZ),U,1),?20,$PIECE(PSBY,"[sort"),?55,$PIECE(PSBTOT(PSBX,PSBY,PSBZ),U,2)
+95 ;*106 adds haz handle/dispose notice
+96 IF ($PIECE(PSBTOT(PSBX,PSBY,PSBZ),U,5)=1)!($PIECE(PSBTOT(PSBX,PSBY,PSBZ),U,6)=1)
WRITE !
+97 if $PIECE(PSBTOT(PSBX,PSBY,PSBZ),U,5)=1
WRITE ?20,"<<HAZ HANDLE>> "
+98 if $PIECE(PSBTOT(PSBX,PSBY,PSBZ),U,6)=1
WRITE ?20,"<<HAZ DISPOSE>>"
End DoDot:3
End DoDot:2
End DoDot:1
+99 ;write end of rpt footer
WRITE $$PTFTR^PSBOHDR()
+100 QUIT
+101 ;
WARD ;* * * * Print By Ward * * *
+1 FOR PSBIX=0:1
SET PSBRPDT=$$FMADD^XLFDT(PSBEVDT,PSBIX)
if PSBRPDT>PSBEVDT2!(PSBRPDT="-1")
QUIT
Begin DoDot:1
+2 FOR X=0,.01:.01:.24
SET PSBGTOT(X)=""
+3 WRITE $$WRDHDR()
+4 SET PSBINDX=""
+5 FOR
SET PSBINDX=$ORDER(^TMP("PSBO",$JOB,"B",PSBINDX))
if PSBINDX=""
QUIT
Begin DoDot:2
+6 FOR DFN=0:0
SET DFN=$ORDER(^TMP("PSBO",$JOB,"B",PSBINDX,DFN))
if 'DFN
QUIT
Begin DoDot:3
+7 if $Y>(IOSL-10)
WRITE $$WRDHDR()
+8 WRITE !,$PIECE(^DPT(DFN,0),U,1),!,"SSN: ",$PIECE(^(0),U,9)
+9 WRITE !,"Ward: ",$EXTRACT($GET(^DPT(DFN,.1)),1,25),!,"Room-Bed: ",$EXTRACT($GET(^(.101)),1,21)
+10 WRITE ?32
+11 FOR X=0,.01:.01:.24
SET PSBTOT(X)=""
+12 KILL ^TMP("PSJ",$JOB)
+13 DO EN^PSJBCMA(DFN,$PIECE(PSBRPT(.1),U,6))
+14 ;*70 always remove CO orders from ward
DO REMOVECO^PSBVDLU1
+15 FOR PSBX=0:0
SET PSBX=$ORDER(^TMP("PSJ",$JOB,PSBX))
if 'PSBX
QUIT
Begin DoDot:4
+16 ; No Orders
if ^TMP("PSJ",$JOB,PSBX,0)=-1
QUIT
+17 DO CLEAN^PSBVT
+18 DO PSJ^PSBVT(PSBX)
+19 ; Not a Continuous
if PSBSCHT'="C"
QUIT
+20 ; Active? - PSB*3*56 adds on call as an active status
if PSBOSTS'="A"&(PSBOSTS'="R")&(PSBOSTS'="O")
QUIT
+21 ;Self med?
if PSBSM=1
QUIT
+22 SET (PSBCADM,PSBYES,PSBODD)=0
+23 SET PSBFREQ=$$GETFREQ^PSBVDLU1(DFN,PSBONX)
+24 if $$PSBDCHK1^PSBVT1(PSBSCH)
SET PSBYES=1
+25 FOR I=1:1
if $PIECE(PSBSCH,"-",I)=""
QUIT
IF ($PIECE(PSBSCH,"-",I)?2N)!($PIECE(PSBSCH,"-",I)?4N)
SET PSBYES=1
+26 IF PSBYES
IF PSBADST=""
IF PSBSCHT'="O"
IF PSBSCHT'="OC"
IF PSBSCHT'="P"
Begin DoDot:5
+27 DO ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Admin times required",PSBSCH)
End DoDot:5
QUIT
+28 IF "PCS"'[PSBIVT
IF PSBONX'["U"
QUIT
+29 ; allow intermittent syringe only
IF PSBIVT["S"
IF PSBISYR'=1
QUIT
+30 IF PSBIVT["C"
IF PSBCHEMT'="P"
IF PSBISYR'=1
QUIT
+31 ; allow Chemo with intermittent syringe or Piggyback type only
IF PSBIVT["C"
IF PSBCHEMT="A"
QUIT
+32 IF PSBFREQ="D"
SET PSBFREQ=""
+33 IF 'PSBYES
IF PSBFREQ<1
Begin DoDot:5
+34 DO ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Invalid frequency received from order",PSBSCH)
End DoDot:5
QUIT
+35 IF +PSBFREQ>0
Begin DoDot:5
+36 IF (PSBFREQ#1440'=0)
IF (1440#PSBFREQ'=0)
SET PSBODD=1
End DoDot:5
+37 IF PSBODD
IF PSBADST'=""
Begin DoDot:5
+38 DO ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Administration Times on ODD SCHEDULE",PSBSCH)
End DoDot:5
QUIT
+39 KILL ^TMP("PSB",$JOB,"GETADMIN")
+40 IF PSBADST=""
SET PSBADST=$$GETADMIN^PSBVDLU1(DFN,PSBONX,PSBOST,PSBFREQ,PSBRPDT)
if PSBADST'=""
SET PSBCADM=1
+41 IF '$TEST
SET ^TMP("PSB",$JOB,"GETADMIN",0)=PSBADST
+42 if PSBADST=""
QUIT
+43 ;*70
IF PSBONX'["V"
Begin DoDot:5
End DoDot:5
if '$$OKAY^PSBVDLU1(PSBOST,PSBRPDT,PSBSCH,PSBONX,PSBOIT,PSBFREQ)
QUIT
+44 ;*70
IF PSBONX["V"
IF PSBSCH'=""
if '$$OKAY^PSBVDLU1(PSBOST,PSBRPDT,PSBSCH,PSBONX,PSBOIT,PSBFREQ)
QUIT
+45 FOR PSBXX=0:1
if '$DATA(^TMP("PSB",$JOB,"GETADMIN",PSBXX))
QUIT
SET PSBADST=$GET(^TMP("PSB",$JOB,"GETADMIN",PSBXX))
Begin DoDot:5
+46 FOR Y=1:1:$LENGTH(PSBADST,"-")
SET Z=+("."_$EXTRACT($PIECE(PSBADST,"-",Y),1,2))
Begin DoDot:6
+47 ;Start Date
if ((PSBRPDT+Z)<$EXTRACT(PSBOST,1,12))&($GET(Z)'=0)
QUIT
+48 ;Stop Date
if (PSBRPDT+Z)'<$EXTRACT(PSBOSP,1,12)
QUIT
+49 ;For invalid admin times
+50 if ($PIECE(PSBADST,"-",Y)'?2N)&($PIECE(PSBADST,"-",Y)'?4N)
Begin DoDot:7
+51 DO ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Invalid Admin times",PSBSCH)
End DoDot:7
+52 SET PSBTOT(Z)=PSBTOT(Z)+1
+53 SET PSBGTOT(Z)=PSBGTOT(Z)+1
+54 ;mrr meds admins have a Remove, count it *83
if PSBMRRFL
Begin DoDot:7
+55 SET PSBTOT(Z)=PSBTOT(Z)+1
+56 SET PSBGTOT(Z)=PSBGTOT(Z)+1
End DoDot:7
End DoDot:6
End DoDot:5
End DoDot:4
+57 ;print ward stats rpt from array
+58 SET PSBX=""
FOR
SET PSBX=$ORDER(PSBTOT(PSBX))
if $GET(PSBX)=""
QUIT
WRITE $JUSTIFY(PSBTOT(PSBX),4)
+59 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","-")
End DoDot:3
End DoDot:2
+60 WRITE !!,$TRANSLATE($JUSTIFY("",IOM)," ","=")
+61 WRITE !?32
FOR X=0,.01:.01:.24
WRITE $JUSTIFY($EXTRACT(X_"00",2,3),4)
+62 WRITE !,"Hourly Totals:",?32
+63 SET PSBGTOT=0
+64 SET PSBX=""
FOR
SET PSBX=$ORDER(PSBGTOT(PSBX))
if $GET(PSBX)=""
QUIT
Begin DoDot:2
+65 WRITE $JUSTIFY(PSBGTOT(PSBX),4)
+66 SET PSBGTOT=PSBGTOT+PSBGTOT(PSBX)
End DoDot:2
+67 WRITE !!,"Ward Total:",?32,$JUSTIFY(PSBGTOT,4)
+68 WRITE !!,$TRANSLATE($JUSTIFY("",IOM)," ","-")
End DoDot:1
+69 QUIT
+70 ;
CLINIC ;* * * Print By Clinic * * * ;*70-1480
+1 FOR PSBIX=0:1
SET PSBRPDT=$$FMADD^XLFDT(PSBEVDT,PSBIX)
if PSBRPDT>PSBEVDT2!(PSBRPDT="-1")
QUIT
Begin DoDot:1
+2 FOR X=0,.01:.01:.24
SET PSBGTOT(PSBRPDT,X)=""
+3 SET PSBINDX=""
+4 FOR
SET PSBINDX=$ORDER(^TMP("PSBO",$JOB,"B",PSBINDX))
if PSBINDX=""
QUIT
Begin DoDot:2
+5 FOR DFN=0:0
SET DFN=$ORDER(^TMP("PSBO",$JOB,"B",PSBINDX,DFN))
if 'DFN
QUIT
Begin DoDot:3
+6 KILL ^TMP("PSJ",$JOB)
+7 DO EN^PSJBCMA(DFN,$PIECE(PSBRPT(.1),U,6))
+8 ;Filter in/out Clinic Orders *70
+9 if PSBCLINORD
Begin DoDot:4
+10 IF $DATA(PSBRPT(2))
DO FILTERCO^PSBO
QUIT
+11 DO INCLUDCO^PSBVDLU1
End DoDot:4
+12 FOR PSBX=0:0
SET PSBX=$ORDER(^TMP("PSJ",$JOB,PSBX))
if 'PSBX
QUIT
Begin DoDot:4
+13 SET PSBCL=$PIECE($GET(^TMP("PSJ",$JOB,PSBX,0)),U,11)
+14 IF PSBCL]""
FOR X=0,.01:.01:.24
SET PSBTOT(PSBRPDT,DFN,PSBCL,X)=""
End DoDot:4
+15 FOR PSBX=0:0
SET PSBX=$ORDER(^TMP("PSJ",$JOB,PSBX))
if 'PSBX
QUIT
Begin DoDot:4
+16 SET PSBCL=$PIECE($GET(^TMP("PSJ",$JOB,PSBX,0)),U,11)
+17 ; No Orders
if ^TMP("PSJ",$JOB,PSBX,0)=-1
QUIT
+18 DO CLEAN^PSBVT
+19 DO PSJ^PSBVT(PSBX)
+20 ; Not a Continuous
if PSBSCHT'="C"
QUIT
+21 ; Active? - PSB*3*56 adds on call as an active status
if PSBOSTS'="A"&(PSBOSTS'="R")&(PSBOSTS'="O")
QUIT
+22 ;Self med?
if PSBSM=1
QUIT
+23 SET (PSBCADM,PSBYES,PSBODD)=0
+24 SET PSBFREQ=$$GETFREQ^PSBVDLU1(DFN,PSBONX)
+25 if $$PSBDCHK1^PSBVT1(PSBSCH)
SET PSBYES=1
+26 FOR I=1:1
if $PIECE(PSBSCH,"-",I)=""
QUIT
IF ($PIECE(PSBSCH,"-",I)?2N)!($PIECE(PSBSCH,"-",I)?4N)
SET PSBYES=1
+27 IF PSBYES
IF PSBADST=""
IF PSBSCHT'="O"
IF PSBSCHT'="OC"
IF PSBSCHT'="P"
Begin DoDot:5
+28 DO ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Admin times required",PSBSCH)
End DoDot:5
QUIT
+29 IF "PCS"'[PSBIVT
IF PSBONX'["U"
QUIT
+30 ; allow intermittent syringe only
IF PSBIVT["S"
IF PSBISYR'=1
QUIT
+31 IF PSBIVT["C"
IF PSBCHEMT'="P"
IF PSBISYR'=1
QUIT
+32 ; allow Chemo with intermittent syringe or Piggyback type only
IF PSBIVT["C"
IF PSBCHEMT="A"
QUIT
+33 IF PSBFREQ="D"
SET PSBFREQ=""
+34 IF 'PSBYES
IF PSBFREQ<1
Begin DoDot:5
+35 DO ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Invalid frequency received from order",PSBSCH)
End DoDot:5
QUIT
+36 IF +PSBFREQ>0
Begin DoDot:5
+37 IF (PSBFREQ#1440'=0)
IF (1440#PSBFREQ'=0)
SET PSBODD=1
End DoDot:5
+38 IF PSBODD
IF PSBADST'=""
Begin DoDot:5
+39 DO ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Administration Times on ODD SCHEDULE",PSBSCH)
End DoDot:5
QUIT
+40 KILL ^TMP("PSB",$JOB,"GETADMIN")
+41 IF PSBADST=""
SET PSBADST=$$GETADMIN^PSBVDLU1(DFN,PSBONX,PSBOST,PSBFREQ,PSBRPDT)
if PSBADST'=""
SET PSBCADM=1
+42 IF '$TEST
SET ^TMP("PSB",$JOB,"GETADMIN",0)=PSBADST
+43 if PSBADST=""
QUIT
+44 IF PSBONX'["V"
Begin DoDot:5
End DoDot:5
if '$$OKAY^PSBVDLU1(PSBOST,PSBRPDT,PSBSCH,PSBONX,PSBOIT,PSBFREQ)
QUIT
+45 IF PSBONX["V"
IF PSBSCH'=""
if '$$OKAY^PSBVDLU1(PSBOST,PSBRPDT,PSBSCH,PSBONX,PSBOIT,PSBFREQ)
QUIT
+46 FOR PSBXX=0:1
if '$DATA(^TMP("PSB",$JOB,"GETADMIN",PSBXX))
QUIT
SET PSBADST=$GET(^TMP("PSB",$JOB,"GETADMIN",PSBXX))
Begin DoDot:5
+47 FOR Y=1:1:$LENGTH(PSBADST,"-")
SET Z=+("."_$EXTRACT($PIECE(PSBADST,"-",Y),1,2))
Begin DoDot:6
+48 ;Start Date
if ((PSBRPDT)<$EXTRACT(PSBOST,1,12))&($GET(Z)'=0)
QUIT
+49 ;Stop Date
if (PSBRPDT)'<$EXTRACT(PSBOSP,1,12)
QUIT
+50 ;For invalid admin times
+51 if ($PIECE(PSBADST,"-",Y)'?2N)&($PIECE(PSBADST,"-",Y)'?4N)
Begin DoDot:7
+52 DO ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Invalid Admin times",PSBSCH)
End DoDot:7
+53 SET PSBTOT(PSBRPDT,DFN,PSBCL,Z)=PSBTOT(PSBRPDT,DFN,PSBCL,Z)+1
+54 SET PSBGTOT(PSBRPDT,Z)=PSBGTOT(PSBRPDT,Z)+1
+55 ;mrr meds admins have a Remove, count it *83
if PSBMRRFL
Begin DoDot:7
+56 SET PSBTOT(PSBRPDT,DFN,PSBCL,Z)=PSBTOT(PSBRPDT,DFN,PSBCL,Z)+1
+57 SET PSBGTOT(PSBRPDT,Z)=PSBGTOT(PSBRPDT,Z)+1
End DoDot:7
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+58 ;
+59 ;print clinic stats rpt from array
+60 SET PSBRPDT=""
FOR
SET PSBRPDT=$ORDER(PSBTOT(PSBRPDT))
if PSBRPDT=""
QUIT
Begin DoDot:2
+61 WRITE $$CLNHDR()
+62 SET DFN=""
FOR
SET DFN=$ORDER(PSBTOT(PSBRPDT,DFN))
if DFN=""
QUIT
Begin DoDot:3
+63 if $Y>(IOSL-10)
WRITE $$CLNHDR()
+64 WRITE !,$PIECE(^DPT(DFN,0),U),!,$PIECE(^(0),U,9)
+65 SET PSBCL=""
FOR
SET PSBCL=$ORDER(PSBTOT(PSBRPDT,DFN,PSBCL))
if PSBCL=""
QUIT
Begin DoDot:4
+66 if $Y>(IOSL-10)
WRITE $$CLNHDR()
+67 WRITE !,PSBCL,?32
+68 SET PSBX=""
FOR
SET PSBX=$ORDER(PSBTOT(PSBRPDT,DFN,PSBCL,PSBX))
if PSBX=""
QUIT
Begin DoDot:5
+69 if $Y>(IOSL-10)
WRITE $$CLNHDR()
+70 WRITE $JUSTIFY(PSBTOT(PSBRPDT,DFN,PSBCL,PSBX),4)
End DoDot:5
End DoDot:4
+71 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","-")
End DoDot:3
+72 WRITE !!,$TRANSLATE($JUSTIFY("",IOM)," ","=")
+73 WRITE !?32
FOR X=0,.01:.01:.24
WRITE $JUSTIFY($EXTRACT(X_"00",2,3),4)
+74 WRITE !,"Hourly Totals:",?32
+75 SET PSBGTOT=0
+76 SET PSBX=""
FOR
SET PSBX=$ORDER(PSBGTOT(PSBRPDT,PSBX))
if $GET(PSBX)=""
QUIT
Begin DoDot:3
+77 WRITE $JUSTIFY(PSBGTOT(PSBRPDT,PSBX),4)
+78 SET PSBGTOT=PSBGTOT+PSBGTOT(PSBRPDT,PSBX)
End DoDot:3
+79 WRITE !!,"Report Date Total:",?32,$JUSTIFY(PSBGTOT,4)
+80 WRITE !!,$TRANSLATE($JUSTIFY("",IOM)," ","-")
End DoDot:2
End DoDot:1
+81 QUIT
+82 ;
QUIT DO CLEAN^PSBVT
+1 KILL I,^TMP("PSJ",$JOB),^TMP("PSB",$JOB)
+2 QUIT
+3 ;
+4 ;
WRDHDR() ;
+1 SET PSBHDR(1)="WARD ADMINISTRATION TIMES"
+2 DO WARD^PSBOHDR(PSBWRD,.PSBHDR,,,PSBSRCHL)
+3 SET Y=PSBRPDT
DO D^DIQ
+4 WRITE !,"Patient Name",?64,Y_" Administration Times"
+5 WRITE !,"Room-Bed",?32
+6 FOR X=0,.01:.01:.24
WRITE $JUSTIFY($EXTRACT(X_"00",2,3),4)
+7 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","-")
+8 QUIT ""
+9 ;
CLNHDR() ;
+1 SET PSBHDR(1)="CLINIC ADMINISTRATION TIMES"
+2 DO CLINIC^PSBOHDR(.PSBRPT,.PSBHDR,,,PSBSRCHL)
+3 ;
+4 SET Y=PSBRPDT
DO D^DIQ
+5 WRITE !,"Patient Name",?64,Y_" Administration Times"
+6 ;*70
WRITE !,"SSN",!,"Location",?32
+7 FOR X=0,.01:.01:.24
WRITE $JUSTIFY($EXTRACT(X_"00",2,3),4)
+8 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","-")
+9 QUIT ""
+10 ;
PTHDR() ;
+1 SET PSBHDR(1)="PATIENT ADMINISTRATION TIMES"
+2 DO PT^PSBOHDR(PSBDFN,.PSBHDR,,,PSBSRCHL)
+3 if PSBCLINORD
WRITE !,"Location"
+4 WRITE !,"Date/Time",?10,"Self Med",?20,"Medication",?55,"Dose/Route"
+5 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","-")
+6 SET Y=PSBRPDT
DO D^DIQ
+7 WRITE !!,Y,!
+8 QUIT ""
