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 ;29-May-2012 14:21;PLS
  1. ;;3.0;BAR CODE MED ADMIN;**9,1005,32,1010,56,1015**;23-May-2012 13:30;Build 62
  1. ;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
  1. ;Modified - IHS/MSC/PLS - 02/22/07 - Line EN+11
  1. ;
  1. ; Reference/IA
  1. ; ^DPT/10035
  1. ; EN^PSJBCMA/2828
  1. EN ;
  1. N PSBHDR,PSBGTOT,PSBTOT,PSBINDX,DFN,PSBX,PSBY,PSBSM,PSBADST,PSBZ
  1. S (Y,PSBEVDT)=$P(PSBRPT(.1),U,6) D D^DIQ
  1. S PSBHDR(2)="ADMINISTRATION DATE: "_Y
  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. F PSBIX=0:1 S PSBRPDT=$$FMADD^XLFDT(PSBEVDT,PSBIX) Q:PSBRPDT>PSBEVDT2!(PSBRPDT="-1") D
  1. .D:$P(PSBRPT(.1),U)="W"
  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. ....; IHS/MSC/PLS - 02/22/07 - Commented out next line, added following line
  1. ....;W !,$P(^DPT(DFN,0),U,1),!,"SSN: ",$P(^(0),U,9)
  1. ....W !,$P(^DPT(DFN,0),U,1),!,$$GET^XPAR("ALL","PSB PATIENT ID LABEL")_" : "_$$PTID^PSBOML(DFN)
  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. ....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,$P(PSBRPT(.1),U,6),PSBSCH,PSBONX,PSBOIT,PSBFREQ)
  1. .....I PSBONX["V",PSBSCH'="" Q:'$$OKAY^PSBVDLU1(PSBOST,$P(PSBRPT(.1),U,6),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:(($P(PSBRPT(.1),U,6)+Z)<$E(PSBOST,1,12))&($G(Z)'=0) ;Start Date
  1. .......Q:($P(PSBRPT(.1),U,6)+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. ....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. ..K ^TMP("PSJ",$J)
  1. .D:$P(PSBRPT(.1),U)="P"
  1. ..S DFN=PSBDFN
  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. ..W $$PTHDR()
  1. ..K ^TMP("PSJ",$J),PSBTOT
  1. ..D EN^PSJBCMA(PSBDFN,PSBRPDT,"")
  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(Z,PSBOITX,PSBONX)=PSBSM_U_"Dosage: "_PSBDOSE_" Route: "_PSBMR_" "_PSBIFR
  1. ..S PSBX="" F S PSBX=$O(PSBTOT(PSBX)) Q:PSBX="" D
  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 !,$$TIMEOUT^PSBUTL(PSBX),?10
  1. .....W $P(PSBTOT(PSBX,PSBY,PSBZ),U,1),?20,PSBY,?55,$P(PSBTOT(PSBX,PSBY,PSBZ),U,2)
  1. ..W $$PTFTR^PSBOHDR()
  1. .K ^TMP("PSJ",$J),^TMP("PSB",$J)
  1. .Q
  1. ;
  1. WRDHDR() ;
  1. S PSBHDR(1)="WARD ADMINISTRATION TIMES"
  1. D WARD^PSBOHDR(PSBWRD,.PSBHDR)
  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. PTHDR() ;
  1. S PSBHDR(1)="PATIENT ADMINISTRATION TIMES"
  1. D PT^PSBOHDR(PSBDFN,.PSBHDR)
  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 ""
  1. ;