Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSBOWA

PSBOWA.m

Go to the documentation of this file.
  1. 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
  1. ;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
  1. ;
  1. ; Reference/IA
  1. ; ^DPT/10035
  1. ; EN^PSJBCMA/2828
  1. ;
  1. ;*70 - add Clinic filter and clinic name into array
  1. ; 1480: Add clinic to header and breakdown by clinic in detail.
  1. ;*83 - add ability to print Scheduled Removals on Patient report
  1. ; - count Removes in the Ward & Clinic reports.
  1. ;*106- add Hazardous Handle & Dispose flags
  1. ;
  1. EN ;
  1. N PSBHDR,PSBGTOT,PSBTOT,PSBINDX,DFN,PSBX,PSBY,PSBSM,PSBADST,PSBZ
  1. N PSBSRCHL,PSBSORT,PSBCL ;*70
  1. N RMDT,PSBIEN
  1. S PSBSORT=$P(PSBRPT(.1),U,1) ;init PSBSORT ;*70
  1. S (Y,PSBEVDT)=$P(PSBRPT(.1),U,6) D D^DIQ
  1. S PSBHDR(2)="ADMINISTRATION DATE: "_Y
  1. ;check Clinic or Nurs Unit search list ;*70
  1. S PSBSRCHL=$$SRCHLIST^PSBOHDR()
  1. D:$G(PSBSRCHL)]""
  1. .S PSBHDR(3)=""
  1. .S:$P(PSBRPT(4),U,2)="C" PSBHDR(4)="Clinic Search List: "
  1. .S:$P(PSBRPT(4),U,2)="I" PSBHDR(4)="Ward Location: "
  1. ;
  1. S (Y,PSBEVDT2)=$S($P(PSBRPT(.1),U,8)']"":PSBEVDT,1:$P(PSBRPT(.1),U,8)) D D^DIQ
  1. S PSBHDR(2)=PSBHDR(2)_" to "_Y
  1. ;
  1. I PSBSORT="P" D PATIENT
  1. I PSBSORT="W" D WARD
  1. I PSBSORT="C" D CLINIC
  1. D QUIT
  1. Q
  1. ;
  1. PATIENT ;* * * Print By Patient * * *
  1. F PSBIX=0:1 S PSBRPDT=$$FMADD^XLFDT(PSBEVDT,PSBIX) Q:PSBRPDT>PSBEVDT2!(PSBRPDT="-1") D
  1. .; * * * Print By Patient * * *
  1. .D:PSBSORT="P"
  1. ..S DFN=PSBDFN
  1. ..K ^TMP("PSJ",$J)
  1. ..D EN^PSJBCMA(PSBDFN,PSBRPDT,"")
  1. ..D:PSBCLINORD ;*70 filer clinics
  1. ... I $D(PSBRPT(2)) D FILTERCO^PSBO Q
  1. ... D INCLUDCO^PSBVDLU1
  1. ..I 'PSBCLINORD D REMOVECO^PSBVDLU1 ;*70
  1. ..F PSBX=0:0 S PSBX=$O(^TMP("PSJ",$J,PSBX)) Q:'PSBX D
  1. ...Q:^TMP("PSJ",$J,PSBX,0)=-1 ; No Orders
  1. ...D CLEAN^PSBVT
  1. ...D PSJ^PSBVT(PSBX)
  1. ...Q:PSBSCHT'="C" ; Not a Continuous
  1. ...Q:PSBOSTS'="A"&(PSBOSTS'="R")&(PSBOSTS'="O") ; Active? - PSB*3*56 adds on call as an active status
  1. ...S (PSBCADM,PSBYES,PSBODD)=0
  1. ...S PSBFREQ=$$GETFREQ^PSBVDLU1(DFN,PSBONX)
  1. ...S:$$PSBDCHK1^PSBVT1(PSBSCH) PSBYES=1
  1. ...F I=1:1 Q:$P(PSBSCH,"-",I)="" I ($P(PSBSCH,"-",I)?2N)!($P(PSBSCH,"-",I)?4N) S PSBYES=1
  1. ...I PSBYES,PSBADST="",PSBSCHT'="O",PSBSCHT'="OC",PSBSCHT'="P" D Q
  1. ....D ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Admin times required",PSBSCH)
  1. ...I "PCS"'[PSBIVT,PSBONX'["U" Q
  1. ...I PSBIVT["S",PSBISYR'=1 Q ; allow intermittent syringe only
  1. ...I PSBIVT["C",PSBCHEMT'="P",PSBISYR'=1 Q
  1. ...I PSBIVT["C",PSBCHEMT="A" Q ; allow Chemo with intermittent syringe or Piggyback type only
  1. ...I PSBFREQ="D" S PSBFREQ=""
  1. ...I 'PSBYES,PSBFREQ<1 D Q
  1. ....D ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Invalid frequency received from order",PSBSCH)
  1. ...I +PSBFREQ>0 D
  1. ....I (PSBFREQ#1440'=0),(1440#PSBFREQ'=0) S PSBODD=1
  1. ...I PSBODD,PSBADST'="" D Q
  1. ....D ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Administration Times on ODD SCHEDULE",PSBSCH)
  1. ...K ^TMP("PSB",$J,"GETADMIN")
  1. ...I PSBADST="",+$G(PSBFREQ)>0,$G(PSBFREQ)<30 S PSBADST="MESSAGE",$P(PSBTOT(PSBADST,PSBOITX,PSBONX),2)="Due every "_PSBFREQ_" Mins" Q
  1. ...I PSBADST="",+$G(PSBFREQ)'<30 S PSBADST=$$GETADMIN^PSBVDLU1(DFN,PSBONX,PSBOST,PSBFREQ,PSBRPDT) S:PSBADST'="" PSBCADM=1
  1. ...E S ^TMP("PSB",$J,"GETADMIN",0)=PSBADST
  1. ...Q:PSBADST=""
  1. ...I PSBONX'["V" D Q:'$$OKAY^PSBVDLU1(PSBOST,PSBRPDT,PSBSCH,PSBONX,PSBOIT,PSBFREQ)
  1. ...I PSBONX["V",PSBSCH'="" Q:'$$OKAY^PSBVDLU1(PSBOST,PSBRPDT,PSBSCH,PSBONX,PSBOIT,PSBFREQ)
  1. ...F PSBXX=0:1 Q:'$D(^TMP("PSB",$J,"GETADMIN",PSBXX)) S PSBADST=$G(^TMP("PSB",$J,"GETADMIN",PSBXX)) D
  1. ....F Y=1:1:$L(PSBADST,"-") S Z=+("."_$P(PSBADST,"-",Y)) D
  1. .....Q:(PSBRPDT+Z)<$E(PSBOST,1,12) ; Start Date
  1. .....Q:(PSBRPDT+Z)'<$E(PSBOSP,1,12) ; Stop Date
  1. .....;For Invalid admin times
  1. .....D:($P(PSBADST,"-",Y)'?2N)&($P(PSBADST,"-",Y)'?4N)
  1. ......D ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Invalid Admin times",PSBSCH)
  1. .....S PSBSM=$S(PSBHSM=1:"HSM",PSBSM=1:"SM",1:"")
  1. .....;*** Local array to include order no
  1. .....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
  1. ;
  1. ;process removes for MRR meds and add to print array if applies
  1. K ^TMP("PSB",$J,"RM")
  1. D GETREMOV^PSBO1(DFN)
  1. ;
  1. D:$D(^TMP("PSB",$J,"RM"))
  1. .F PSBIEN=0:0 S PSBIEN=$O(^TMP("PSB",$J,"RM",PSBIEN)) Q:'PSBIEN D
  1. ..S RMDT=$P(^TMP("PSB",$J,"RM",PSBIEN),U,1)
  1. ..Q:($P(RMDT,".")<PSBEVDT)!($P(RMDT,".")>PSBEVDT2)
  1. ..S PSBCLORD=$P(^TMP("PSB",$J,"RM",PSBIEN),U,6) ;CLOR
  1. ..Q:(PSBCLINORD)&(PSBCLORD="")
  1. ..Q:('PSBCLINORD)&(PSBCLORD]"")
  1. ..S PSBONX=$P(^TMP("PSB",$J,"RM",PSBIEN),U,2) ;ONX
  1. ..S PSBOITX=$P(^TMP("PSB",$J,"RM",PSBIEN),U,3) ;OITX
  1. ..S PSBOSTS=$P(^TMP("PSB",$J,"RM",PSBIEN),U,4) ;OSTS
  1. ..S PSBOSP=$P(^TMP("PSB",$J,"RM",PSBIEN),U,5) ;OSP
  1. ..S PSBDOSE=$P(^TMP("PSB",$J,"RM",PSBIEN),U,7) ;DOSE
  1. ..S PSBMR=$P(^TMP("PSB",$J,"RM",PSBIEN),U,8) ;MR
  1. ..S PSBSM=$P(^TMP("PSB",$J,"RM",PSBIEN),U,9) ;SM
  1. ..S PSBSM=$S($G(PSBHSM)=1:"HSM",PSBSM=1:"SM",1:"")
  1. ..S PSBIFR="" ;infuse rt n/a for MRR meds
  1. ..S PSBHAZHN=$P(^TMP("PSB",$J,"RM",PSBIEN),U,10) ;HAZHAN
  1. ..S PSBHAZDS=$P(^TMP("PSB",$J,"RM",PSBIEN),U,11) ;HAZDIS
  1. ..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
  1. ;
  1. ;print the patient report
  1. N PREVRPDT ;*83
  1. S PSBHDR(1)="WARD ADMINISTRATION TIMES"
  1. S Y=$P(PSBRPT(.1),U,6) D D^DIQ S PSBHDR(2)="ADMINISTRATION DATE: "_Y
  1. S Y=PSBEVDT2 D D^DIQ S PSBHDR(2)=PSBHDR(2)_" to "_Y
  1. S PREVRPDT=""
  1. W:'$D(PSBTOT) $$PTHDR() ;insure a header when no records found
  1. S PSBX="" F S PSBX=$O(PSBTOT(PSBX)) Q:PSBX="" D
  1. .S PSBRPDT=$P(PSBX,".")
  1. .;write hdr for each date found
  1. .I PREVRPDT'=PSBRPDT W $$PTHDR() S PREVRPDT=PSBRPDT
  1. .W !
  1. .S PSBY="" F S PSBY=$O(PSBTOT(PSBX,PSBY)) Q:PSBY="" D
  1. ..S PSBZ="" F S PSBZ=$O(PSBTOT(PSBX,PSBY,PSBZ)) Q:PSBZ="" D
  1. ...W:$Y>(IOSL-6) $$PTFTR^PSBOHDR(),$$PTHDR()
  1. ...I PSBX="MESSAGE" W !,$P(PSBTOT(PSBX,PSBY,PSBZ),U,1),?20,PSBY Q
  1. ...W:PSBCLINORD !,$P(PSBTOT(PSBX,PSBY,PSBZ),U,3)
  1. ...W !,$$TIMEOUT^PSBUTL(PSBX)," ",$P(PSBTOT(PSBX,PSBY,PSBZ),U,4),?13 ;remove code piece 4 if exists *83
  1. ...W $P(PSBTOT(PSBX,PSBY,PSBZ),U,1),?20,$P(PSBY,"[sort"),?55,$P(PSBTOT(PSBX,PSBY,PSBZ),U,2) ;*83
  1. ...;*106 adds haz handle/dispose notice
  1. ...I ($P(PSBTOT(PSBX,PSBY,PSBZ),U,5)=1)!($P(PSBTOT(PSBX,PSBY,PSBZ),U,6)=1) W !
  1. ...W:$P(PSBTOT(PSBX,PSBY,PSBZ),U,5)=1 ?20,"<<HAZ HANDLE>> "
  1. ...W:$P(PSBTOT(PSBX,PSBY,PSBZ),U,6)=1 ?20,"<<HAZ DISPOSE>>"
  1. W $$PTFTR^PSBOHDR() ;write end of rpt footer
  1. Q
  1. ;
  1. WARD ;* * * * Print By Ward * * *
  1. F PSBIX=0:1 S PSBRPDT=$$FMADD^XLFDT(PSBEVDT,PSBIX) Q:PSBRPDT>PSBEVDT2!(PSBRPDT="-1") D
  1. .F X=0,.01:.01:.24 S PSBGTOT(X)=""
  1. .W $$WRDHDR()
  1. .S PSBINDX=""
  1. .F S PSBINDX=$O(^TMP("PSBO",$J,"B",PSBINDX)) Q:PSBINDX="" D
  1. ..F DFN=0:0 S DFN=$O(^TMP("PSBO",$J,"B",PSBINDX,DFN)) Q:'DFN D
  1. ...W:$Y>(IOSL-10) $$WRDHDR()
  1. ...W !,$P(^DPT(DFN,0),U,1),!,"SSN: ",$P(^(0),U,9)
  1. ...W !,"Ward: ",$E($G(^DPT(DFN,.1)),1,25),!,"Room-Bed: ",$E($G(^(.101)),1,21)
  1. ...W ?32
  1. ...F X=0,.01:.01:.24 S PSBTOT(X)=""
  1. ...K ^TMP("PSJ",$J)
  1. ...D EN^PSJBCMA(DFN,$P(PSBRPT(.1),U,6))
  1. ...D REMOVECO^PSBVDLU1 ;*70 always remove CO orders from ward
  1. ...F PSBX=0:0 S PSBX=$O(^TMP("PSJ",$J,PSBX)) Q:'PSBX D
  1. ....Q:^TMP("PSJ",$J,PSBX,0)=-1 ; No Orders
  1. ....D CLEAN^PSBVT
  1. ....D PSJ^PSBVT(PSBX)
  1. ....Q:PSBSCHT'="C" ; Not a Continuous
  1. ....Q:PSBOSTS'="A"&(PSBOSTS'="R")&(PSBOSTS'="O") ; Active? - PSB*3*56 adds on call as an active status
  1. ....Q:PSBSM=1 ;Self med?
  1. ....S (PSBCADM,PSBYES,PSBODD)=0
  1. ....S PSBFREQ=$$GETFREQ^PSBVDLU1(DFN,PSBONX)
  1. ....S:$$PSBDCHK1^PSBVT1(PSBSCH) PSBYES=1
  1. ....F I=1:1 Q:$P(PSBSCH,"-",I)="" I ($P(PSBSCH,"-",I)?2N)!($P(PSBSCH,"-",I)?4N) S PSBYES=1
  1. ....I PSBYES,PSBADST="",PSBSCHT'="O",PSBSCHT'="OC",PSBSCHT'="P" D Q
  1. .....D ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Admin times required",PSBSCH)
  1. ....I "PCS"'[PSBIVT,PSBONX'["U" Q
  1. ....I PSBIVT["S",PSBISYR'=1 Q ; allow intermittent syringe only
  1. ....I PSBIVT["C",PSBCHEMT'="P",PSBISYR'=1 Q
  1. ....I PSBIVT["C",PSBCHEMT="A" Q ; allow Chemo with intermittent syringe or Piggyback type only
  1. ....I PSBFREQ="D" S PSBFREQ=""
  1. ....I 'PSBYES,PSBFREQ<1 D Q
  1. .....D ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Invalid frequency received from order",PSBSCH)
  1. ....I +PSBFREQ>0 D
  1. .....I (PSBFREQ#1440'=0),(1440#PSBFREQ'=0) S PSBODD=1
  1. ....I PSBODD,PSBADST'="" D Q
  1. .....D ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Administration Times on ODD SCHEDULE",PSBSCH)
  1. ....K ^TMP("PSB",$J,"GETADMIN")
  1. ....I PSBADST="" S PSBADST=$$GETADMIN^PSBVDLU1(DFN,PSBONX,PSBOST,PSBFREQ,PSBRPDT) S:PSBADST'="" PSBCADM=1
  1. ....E S ^TMP("PSB",$J,"GETADMIN",0)=PSBADST
  1. ....Q:PSBADST=""
  1. ....I PSBONX'["V" D Q:'$$OKAY^PSBVDLU1(PSBOST,PSBRPDT,PSBSCH,PSBONX,PSBOIT,PSBFREQ) ;*70
  1. ....I PSBONX["V",PSBSCH'="" Q:'$$OKAY^PSBVDLU1(PSBOST,PSBRPDT,PSBSCH,PSBONX,PSBOIT,PSBFREQ) ;*70
  1. ....F PSBXX=0:1 Q:'$D(^TMP("PSB",$J,"GETADMIN",PSBXX)) S PSBADST=$G(^TMP("PSB",$J,"GETADMIN",PSBXX)) D
  1. .....F Y=1:1:$L(PSBADST,"-") S Z=+("."_$E($P(PSBADST,"-",Y),1,2)) D
  1. ......Q:((PSBRPDT+Z)<$E(PSBOST,1,12))&($G(Z)'=0) ;Start Date
  1. ......Q:(PSBRPDT+Z)'<$E(PSBOSP,1,12) ;Stop Date
  1. ......;For invalid admin times
  1. ......D:($P(PSBADST,"-",Y)'?2N)&($P(PSBADST,"-",Y)'?4N)
  1. .......D ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Invalid Admin times",PSBSCH)
  1. ......S PSBTOT(Z)=PSBTOT(Z)+1
  1. ......S PSBGTOT(Z)=PSBGTOT(Z)+1
  1. ......D:PSBMRRFL ;mrr meds admins have a Remove, count it *83
  1. .......S PSBTOT(Z)=PSBTOT(Z)+1
  1. .......S PSBGTOT(Z)=PSBGTOT(Z)+1
  1. ...;print ward stats rpt from array
  1. ...S PSBX="" F S PSBX=$O(PSBTOT(PSBX)) Q:$G(PSBX)="" W $J(PSBTOT(PSBX),4)
  1. ...W !,$TR($J("",IOM)," ","-")
  1. .W !!,$TR($J("",IOM)," ","=")
  1. .W !?32 F X=0,.01:.01:.24 W $J($E(X_"00",2,3),4)
  1. .W !,"Hourly Totals:",?32
  1. .S PSBGTOT=0
  1. .S PSBX="" F S PSBX=$O(PSBGTOT(PSBX)) Q:$G(PSBX)="" D
  1. ..W $J(PSBGTOT(PSBX),4)
  1. ..S PSBGTOT=PSBGTOT+PSBGTOT(PSBX)
  1. .W !!,"Ward Total:",?32,$J(PSBGTOT,4)
  1. .W !!,$TR($J("",IOM)," ","-")
  1. Q
  1. ;
  1. CLINIC ;* * * Print By Clinic * * * ;*70-1480
  1. F PSBIX=0:1 S PSBRPDT=$$FMADD^XLFDT(PSBEVDT,PSBIX) Q:PSBRPDT>PSBEVDT2!(PSBRPDT="-1") D
  1. .F X=0,.01:.01:.24 S PSBGTOT(PSBRPDT,X)=""
  1. .S PSBINDX=""
  1. .F S PSBINDX=$O(^TMP("PSBO",$J,"B",PSBINDX)) Q:PSBINDX="" D
  1. ..F DFN=0:0 S DFN=$O(^TMP("PSBO",$J,"B",PSBINDX,DFN)) Q:'DFN D
  1. ...K ^TMP("PSJ",$J)
  1. ...D EN^PSJBCMA(DFN,$P(PSBRPT(.1),U,6))
  1. ...;Filter in/out Clinic Orders *70
  1. ...D:PSBCLINORD
  1. ....I $D(PSBRPT(2)) D FILTERCO^PSBO Q
  1. ....D INCLUDCO^PSBVDLU1
  1. ...F PSBX=0:0 S PSBX=$O(^TMP("PSJ",$J,PSBX)) Q:'PSBX D
  1. ....S PSBCL=$P($G(^TMP("PSJ",$J,PSBX,0)),U,11)
  1. ....I PSBCL]"" F X=0,.01:.01:.24 S PSBTOT(PSBRPDT,DFN,PSBCL,X)=""
  1. ...F PSBX=0:0 S PSBX=$O(^TMP("PSJ",$J,PSBX)) Q:'PSBX D
  1. ....S PSBCL=$P($G(^TMP("PSJ",$J,PSBX,0)),U,11)
  1. ....Q:^TMP("PSJ",$J,PSBX,0)=-1 ; No Orders
  1. ....D CLEAN^PSBVT
  1. ....D PSJ^PSBVT(PSBX)
  1. ....Q:PSBSCHT'="C" ; Not a Continuous
  1. ....Q:PSBOSTS'="A"&(PSBOSTS'="R")&(PSBOSTS'="O") ; Active? - PSB*3*56 adds on call as an active status
  1. ....Q:PSBSM=1 ;Self med?
  1. ....S (PSBCADM,PSBYES,PSBODD)=0
  1. ....S PSBFREQ=$$GETFREQ^PSBVDLU1(DFN,PSBONX)
  1. ....S:$$PSBDCHK1^PSBVT1(PSBSCH) PSBYES=1
  1. ....F I=1:1 Q:$P(PSBSCH,"-",I)="" I ($P(PSBSCH,"-",I)?2N)!($P(PSBSCH,"-",I)?4N) S PSBYES=1
  1. ....I PSBYES,PSBADST="",PSBSCHT'="O",PSBSCHT'="OC",PSBSCHT'="P" D Q
  1. .....D ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Admin times required",PSBSCH)
  1. ....I "PCS"'[PSBIVT,PSBONX'["U" Q
  1. ....I PSBIVT["S",PSBISYR'=1 Q ; allow intermittent syringe only
  1. ....I PSBIVT["C",PSBCHEMT'="P",PSBISYR'=1 Q
  1. ....I PSBIVT["C",PSBCHEMT="A" Q ; allow Chemo with intermittent syringe or Piggyback type only
  1. ....I PSBFREQ="D" S PSBFREQ=""
  1. ....I 'PSBYES,PSBFREQ<1 D Q
  1. .....D ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Invalid frequency received from order",PSBSCH)
  1. ....I +PSBFREQ>0 D
  1. .....I (PSBFREQ#1440'=0),(1440#PSBFREQ'=0) S PSBODD=1
  1. ....I PSBODD,PSBADST'="" D Q
  1. .....D ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Administration Times on ODD SCHEDULE",PSBSCH)
  1. ....K ^TMP("PSB",$J,"GETADMIN")
  1. ....I PSBADST="" S PSBADST=$$GETADMIN^PSBVDLU1(DFN,PSBONX,PSBOST,PSBFREQ,PSBRPDT) S:PSBADST'="" PSBCADM=1
  1. ....E S ^TMP("PSB",$J,"GETADMIN",0)=PSBADST
  1. ....Q:PSBADST=""
  1. ....I PSBONX'["V" D Q:'$$OKAY^PSBVDLU1(PSBOST,PSBRPDT,PSBSCH,PSBONX,PSBOIT,PSBFREQ)
  1. ....I PSBONX["V",PSBSCH'="" Q:'$$OKAY^PSBVDLU1(PSBOST,PSBRPDT,PSBSCH,PSBONX,PSBOIT,PSBFREQ)
  1. ....F PSBXX=0:1 Q:'$D(^TMP("PSB",$J,"GETADMIN",PSBXX)) S PSBADST=$G(^TMP("PSB",$J,"GETADMIN",PSBXX)) D
  1. .....F Y=1:1:$L(PSBADST,"-") S Z=+("."_$E($P(PSBADST,"-",Y),1,2)) D
  1. ......Q:((PSBRPDT)<$E(PSBOST,1,12))&($G(Z)'=0) ;Start Date
  1. ......Q:(PSBRPDT)'<$E(PSBOSP,1,12) ;Stop Date
  1. ......;For invalid admin times
  1. ......D:($P(PSBADST,"-",Y)'?2N)&($P(PSBADST,"-",Y)'?4N)
  1. .......D ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Invalid Admin times",PSBSCH)
  1. ......S PSBTOT(PSBRPDT,DFN,PSBCL,Z)=PSBTOT(PSBRPDT,DFN,PSBCL,Z)+1
  1. ......S PSBGTOT(PSBRPDT,Z)=PSBGTOT(PSBRPDT,Z)+1
  1. ......D:PSBMRRFL ;mrr meds admins have a Remove, count it *83
  1. .......S PSBTOT(PSBRPDT,DFN,PSBCL,Z)=PSBTOT(PSBRPDT,DFN,PSBCL,Z)+1
  1. .......S PSBGTOT(PSBRPDT,Z)=PSBGTOT(PSBRPDT,Z)+1
  1. .;
  1. .;print clinic stats rpt from array
  1. .S PSBRPDT="" F S PSBRPDT=$O(PSBTOT(PSBRPDT)) Q:PSBRPDT="" D
  1. ..W $$CLNHDR()
  1. ..S DFN="" F S DFN=$O(PSBTOT(PSBRPDT,DFN)) Q:DFN="" D
  1. ...W:$Y>(IOSL-10) $$CLNHDR()
  1. ...W !,$P(^DPT(DFN,0),U),!,$P(^(0),U,9)
  1. ...S PSBCL="" F S PSBCL=$O(PSBTOT(PSBRPDT,DFN,PSBCL)) Q:PSBCL="" D
  1. ....W:$Y>(IOSL-10) $$CLNHDR()
  1. ....W !,PSBCL,?32
  1. ....S PSBX="" F S PSBX=$O(PSBTOT(PSBRPDT,DFN,PSBCL,PSBX)) Q:PSBX="" D
  1. .....W:$Y>(IOSL-10) $$CLNHDR()
  1. .....W $J(PSBTOT(PSBRPDT,DFN,PSBCL,PSBX),4)
  1. ...W !,$TR($J("",IOM)," ","-")
  1. ..W !!,$TR($J("",IOM)," ","=")
  1. ..W !?32 F X=0,.01:.01:.24 W $J($E(X_"00",2,3),4)
  1. ..W !,"Hourly Totals:",?32
  1. ..S PSBGTOT=0
  1. ..S PSBX="" F S PSBX=$O(PSBGTOT(PSBRPDT,PSBX)) Q:$G(PSBX)="" D
  1. ...W $J(PSBGTOT(PSBRPDT,PSBX),4)
  1. ...S PSBGTOT=PSBGTOT+PSBGTOT(PSBRPDT,PSBX)
  1. ..W !!,"Report Date Total:",?32,$J(PSBGTOT,4)
  1. ..W !!,$TR($J("",IOM)," ","-")
  1. Q
  1. ;
  1. QUIT D CLEAN^PSBVT
  1. K I,^TMP("PSJ",$J),^TMP("PSB",$J)
  1. Q
  1. ;
  1. ;
  1. WRDHDR() ;
  1. S PSBHDR(1)="WARD ADMINISTRATION TIMES"
  1. D WARD^PSBOHDR(PSBWRD,.PSBHDR,,,PSBSRCHL)
  1. S Y=PSBRPDT D D^DIQ
  1. W !,"Patient Name",?64,Y_" Administration Times"
  1. W !,"Room-Bed",?32
  1. F X=0,.01:.01:.24 W $J($E(X_"00",2,3),4)
  1. W !,$TR($J("",IOM)," ","-")
  1. Q ""
  1. ;
  1. CLNHDR() ;
  1. S PSBHDR(1)="CLINIC ADMINISTRATION TIMES"
  1. D CLINIC^PSBOHDR(.PSBRPT,.PSBHDR,,,PSBSRCHL)
  1. ;
  1. S Y=PSBRPDT D D^DIQ
  1. W !,"Patient Name",?64,Y_" Administration Times"
  1. W !,"SSN",!,"Location",?32 ;*70
  1. F X=0,.01:.01:.24 W $J($E(X_"00",2,3),4)
  1. W !,$TR($J("",IOM)," ","-")
  1. Q ""
  1. ;
  1. PTHDR() ;
  1. S PSBHDR(1)="PATIENT ADMINISTRATION TIMES"
  1. D PT^PSBOHDR(PSBDFN,.PSBHDR,,,PSBSRCHL)
  1. W:PSBCLINORD !,"Location"
  1. W !,"Date/Time",?10,"Self Med",?20,"Medication",?55,"Dose/Route"
  1. W !,$TR($J("",IOM)," ","-")
  1. S Y=PSBRPDT D D^DIQ
  1. W !!,Y,!
  1. Q ""