- 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 Jan 18, 2025@02:42:11 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 ""