- PSBOWA ;BIRMINGHAM/EFC-WARD ADMINISTRATION TIMES ;29-May-2012 14:21;PLS
- ;;3.0;BAR CODE MED ADMIN;**9,1005,32,1010,56,1015**;23-May-2012 13:30;Build 62
- ;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
- ;Modified - IHS/MSC/PLS - 02/22/07 - Line EN+11
- ;
- ; Reference/IA
- ; ^DPT/10035
- ; EN^PSJBCMA/2828
- EN ;
- N PSBHDR,PSBGTOT,PSBTOT,PSBINDX,DFN,PSBX,PSBY,PSBSM,PSBADST,PSBZ
- S (Y,PSBEVDT)=$P(PSBRPT(.1),U,6) D D^DIQ
- S PSBHDR(2)="ADMINISTRATION DATE: "_Y
- 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
- F PSBIX=0:1 S PSBRPDT=$$FMADD^XLFDT(PSBEVDT,PSBIX) Q:PSBRPDT>PSBEVDT2!(PSBRPDT="-1") D
- .D:$P(PSBRPT(.1),U)="W"
- ..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()
- ....; IHS/MSC/PLS - 02/22/07 - Commented out next line, added following line
- ....;W !,$P(^DPT(DFN,0),U,1),!,"SSN: ",$P(^(0),U,9)
- ....W !,$P(^DPT(DFN,0),U,1),!,$$GET^XPAR("ALL","PSB PATIENT ID LABEL")_" : "_$$PTID^PSBOML(DFN)
- ....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))
- ....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,$P(PSBRPT(.1),U,6),PSBSCH,PSBONX,PSBOIT,PSBFREQ)
- .....I PSBONX["V",PSBSCH'="" Q:'$$OKAY^PSBVDLU1(PSBOST,$P(PSBRPT(.1),U,6),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:(($P(PSBRPT(.1),U,6)+Z)<$E(PSBOST,1,12))&($G(Z)'=0) ;Start Date
- .......Q:($P(PSBRPT(.1),U,6)+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
- ....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)," ","-")
- ..K ^TMP("PSJ",$J)
- .D:$P(PSBRPT(.1),U)="P"
- ..S DFN=PSBDFN
- ..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
- ..W $$PTHDR()
- ..K ^TMP("PSJ",$J),PSBTOT
- ..D EN^PSJBCMA(PSBDFN,PSBRPDT,"")
- ..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(Z,PSBOITX,PSBONX)=PSBSM_U_"Dosage: "_PSBDOSE_" Route: "_PSBMR_" "_PSBIFR
- ..S PSBX="" F S PSBX=$O(PSBTOT(PSBX)) Q:PSBX="" D
- ...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 !,$$TIMEOUT^PSBUTL(PSBX),?10
- .....W $P(PSBTOT(PSBX,PSBY,PSBZ),U,1),?20,PSBY,?55,$P(PSBTOT(PSBX,PSBY,PSBZ),U,2)
- ..W $$PTFTR^PSBOHDR()
- .K ^TMP("PSJ",$J),^TMP("PSB",$J)
- .Q
- ;
- WRDHDR() ;
- S PSBHDR(1)="WARD ADMINISTRATION TIMES"
- D WARD^PSBOHDR(PSBWRD,.PSBHDR)
- 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 ""
- ;
- PTHDR() ;
- S PSBHDR(1)="PATIENT ADMINISTRATION TIMES"
- D PT^PSBOHDR(PSBDFN,.PSBHDR)
- W !,"Date/Time",?10,"Self Med",?20,"Medication",?55,"Dose/Route"
- W !,$TR($J("",IOM)," ","-")
- S Y=PSBRPDT D D^DIQ
- W !!,Y,!
- Q ""
- ;
- 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
- +2 ;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
- +3 ;Modified - IHS/MSC/PLS - 02/22/07 - Line EN+11
- +4 ;
- +5 ; Reference/IA
- +6 ; ^DPT/10035
- +7 ; EN^PSJBCMA/2828
- EN ;
- +1 NEW PSBHDR,PSBGTOT,PSBTOT,PSBINDX,DFN,PSBX,PSBY,PSBSM,PSBADST,PSBZ
- +2 SET (Y,PSBEVDT)=$PIECE(PSBRPT(.1),U,6)
- DO D^DIQ
- +3 SET PSBHDR(2)="ADMINISTRATION DATE: "_Y
- +4 SET (Y,PSBEVDT2)=$SELECT($PIECE(PSBRPT(.1),U,8)']"":PSBEVDT,1:$PIECE(PSBRPT(.1),U,8))
- DO D^DIQ
- +5 SET PSBHDR(2)=PSBHDR(2)_" to "_Y
- +6 FOR PSBIX=0:1
- SET PSBRPDT=$$FMADD^XLFDT(PSBEVDT,PSBIX)
- IF PSBRPDT>PSBEVDT2!(PSBRPDT="-1")
- QUIT
- Begin DoDot:1
- +7 IF $PIECE(PSBRPT(.1),U)="W"
- Begin DoDot:2
- +8 FOR X=0,.01:.01:.24
- SET PSBGTOT(X)=""
- +9 WRITE $$WRDHDR()
- +10 SET PSBINDX=""
- +11 FOR
- SET PSBINDX=$ORDER(^TMP("PSBO",$JOB,"B",PSBINDX))
- IF PSBINDX=""
- QUIT
- Begin DoDot:3
- +12 FOR DFN=0:0
- SET DFN=$ORDER(^TMP("PSBO",$JOB,"B",PSBINDX,DFN))
- IF 'DFN
- QUIT
- Begin DoDot:4
- +13 IF $Y>(IOSL-10)
- WRITE $$WRDHDR()
- +14 ; IHS/MSC/PLS - 02/22/07 - Commented out next line, added following line
- +15 ;W !,$P(^DPT(DFN,0),U,1),!,"SSN: ",$P(^(0),U,9)
- +16 WRITE !,$PIECE(^DPT(DFN,0),U,1),!,$$GET^XPAR("ALL","PSB PATIENT ID LABEL")_" : "_$$PTID^PSBOML(DFN)
- +17 WRITE !,"Ward: ",$EXTRACT($GET(^DPT(DFN,.1)),1,25),!,"Room-Bed: ",$EXTRACT($GET(^(.101)),1,21)
- +18 WRITE ?32
- +19 FOR X=0,.01:.01:.24
- SET PSBTOT(X)=""
- +20 KILL ^TMP("PSJ",$JOB)
- +21 DO EN^PSJBCMA(DFN,$PIECE(PSBRPT(.1),U,6))
- +22 FOR PSBX=0:0
- SET PSBX=$ORDER(^TMP("PSJ",$JOB,PSBX))
- IF 'PSBX
- QUIT
- Begin DoDot:5
- +23 ; No Orders
- IF ^TMP("PSJ",$JOB,PSBX,0)=-1
- QUIT
- +24 DO CLEAN^PSBVT
- +25 DO PSJ^PSBVT(PSBX)
- +26 ; Not a Continuous
- IF PSBSCHT'="C"
- QUIT
- +27 ; Active? - PSB*3*56 adds on call as an active status
- IF PSBOSTS'="A"&(PSBOSTS'="R")&(PSBOSTS'="O")
- QUIT
- +28 ;Self med?
- IF PSBSM=1
- QUIT
- +29 SET (PSBCADM,PSBYES,PSBODD)=0
- +30 SET PSBFREQ=$$GETFREQ^PSBVDLU1(DFN,PSBONX)
- +31 IF $$PSBDCHK1^PSBVT1(PSBSCH)
- SET PSBYES=1
- +32 FOR I=1:1
- IF $PIECE(PSBSCH,"-",I)=""
- QUIT
- IF ($PIECE(PSBSCH,"-",I)?2N)!($PIECE(PSBSCH,"-",I)?4N)
- SET PSBYES=1
- +33 IF PSBYES
- IF PSBADST=""
- IF PSBSCHT'="O"
- IF PSBSCHT'="OC"
- IF PSBSCHT'="P"
- Begin DoDot:6
- +34 DO ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Admin times required",PSBSCH)
- End DoDot:6
- QUIT
- +35 IF "PCS"'[PSBIVT
- IF PSBONX'["U"
- QUIT
- +36 ; allow intermittent syringe only
- IF PSBIVT["S"
- IF PSBISYR'=1
- QUIT
- +37 IF PSBIVT["C"
- IF PSBCHEMT'="P"
- IF PSBISYR'=1
- QUIT
- +38 ; allow Chemo with intermittent syringe or Piggyback type only
- IF PSBIVT["C"
- IF PSBCHEMT="A"
- QUIT
- +39 IF PSBFREQ="D"
- SET PSBFREQ=""
- +40 IF 'PSBYES
- IF PSBFREQ<1
- Begin DoDot:6
- +41 DO ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Invalid frequency received from order",PSBSCH)
- End DoDot:6
- QUIT
- +42 IF +PSBFREQ>0
- Begin DoDot:6
- +43 IF (PSBFREQ#1440'=0)
- IF (1440#PSBFREQ'=0)
- SET PSBODD=1
- End DoDot:6
- +44 IF PSBODD
- IF PSBADST'=""
- Begin DoDot:6
- +45 DO ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Administration Times on ODD SCHEDULE",PSBSCH)
- End DoDot:6
- QUIT
- +46 KILL ^TMP("PSB",$JOB,"GETADMIN")
- +47 IF PSBADST=""
- SET PSBADST=$$GETADMIN^PSBVDLU1(DFN,PSBONX,PSBOST,PSBFREQ,PSBRPDT)
- IF PSBADST'=""
- SET PSBCADM=1
- +48 IF '$TEST
- SET ^TMP("PSB",$JOB,"GETADMIN",0)=PSBADST
- +49 IF PSBADST=""
- QUIT
- +50 IF PSBONX'["V"
- Begin DoDot:6
- End DoDot:6
- IF '$$OKAY^PSBVDLU1(PSBOST,$PIECE(PSBRPT(.1),U,6),PSBSCH,PSBONX,PSBOIT,PSBFREQ)
- QUIT
- +51 IF PSBONX["V"
- IF PSBSCH'=""
- IF '$$OKAY^PSBVDLU1(PSBOST,$PIECE(PSBRPT(.1),U,6),PSBSCH,PSBONX,PSBOIT,PSBFREQ)
- QUIT
- +52 FOR PSBXX=0:1
- IF '$DATA(^TMP("PSB",$JOB,"GETADMIN",PSBXX))
- QUIT
- SET PSBADST=$GET(^TMP("PSB",$JOB,"GETADMIN",PSBXX))
- Begin DoDot:6
- +53 FOR Y=1:1:$LENGTH(PSBADST,"-")
- SET Z=+("."_$EXTRACT($PIECE(PSBADST,"-",Y),1,2))
- Begin DoDot:7
- +54 ;Start Date
- IF (($PIECE(PSBRPT(.1),U,6)+Z)<$EXTRACT(PSBOST,1,12))&($GET(Z)'=0)
- QUIT
- +55 ;Stop Date
- IF ($PIECE(PSBRPT(.1),U,6)+Z)'<$EXTRACT(PSBOSP,1,12)
- QUIT
- +56 ;For invalid admin times
- +57 IF ($PIECE(PSBADST,"-",Y)'?2N)&($PIECE(PSBADST,"-",Y)'?4N)
- Begin DoDot:8
- +58 DO ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Invalid Admin times",PSBSCH)
- End DoDot:8
- +59 SET PSBTOT(Z)=PSBTOT(Z)+1
- +60 SET PSBGTOT(Z)=PSBGTOT(Z)+1
- End DoDot:7
- End DoDot:6
- End DoDot:5
- +61 SET PSBX=""
- FOR
- SET PSBX=$ORDER(PSBTOT(PSBX))
- IF $GET(PSBX)=""
- QUIT
- WRITE $JUSTIFY(PSBTOT(PSBX),4)
- +62 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","-")
- End DoDot:4
- End DoDot:3
- +63 WRITE !!,$TRANSLATE($JUSTIFY("",IOM)," ","=")
- +64 WRITE !?32
- FOR X=0,.01:.01:.24
- WRITE $JUSTIFY($EXTRACT(X_"00",2,3),4)
- +65 WRITE !,"Hourly Totals:",?32
- +66 SET PSBGTOT=0
- +67 SET PSBX=""
- FOR
- SET PSBX=$ORDER(PSBGTOT(PSBX))
- IF $GET(PSBX)=""
- QUIT
- Begin DoDot:3
- +68 WRITE $JUSTIFY(PSBGTOT(PSBX),4)
- +69 SET PSBGTOT=PSBGTOT+PSBGTOT(PSBX)
- End DoDot:3
- +70 WRITE !!,"Ward Total:",?32,$JUSTIFY(PSBGTOT,4)
- +71 WRITE !!,$TRANSLATE($JUSTIFY("",IOM)," ","-")
- +72 KILL ^TMP("PSJ",$JOB)
- End DoDot:2
- +73 IF $PIECE(PSBRPT(.1),U)="P"
- Begin DoDot:2
- +74 SET DFN=PSBDFN
- +75 SET PSBHDR(1)="WARD ADMINISTRATION TIMES"
- +76 SET Y=$PIECE(PSBRPT(.1),U,6)
- DO D^DIQ
- SET PSBHDR(2)="ADMINISTRATION DATE: "_Y
- +77 SET Y=PSBEVDT2
- DO D^DIQ
- SET PSBHDR(2)=PSBHDR(2)_" to "_Y
- +78 WRITE $$PTHDR()
- +79 KILL ^TMP("PSJ",$JOB),PSBTOT
- +80 DO EN^PSJBCMA(PSBDFN,PSBRPDT,"")
- +81 FOR PSBX=0:0
- SET PSBX=$ORDER(^TMP("PSJ",$JOB,PSBX))
- IF 'PSBX
- QUIT
- Begin DoDot:3
- +82 ; No Orders
- IF ^TMP("PSJ",$JOB,PSBX,0)=-1
- QUIT
- +83 DO CLEAN^PSBVT
- +84 DO PSJ^PSBVT(PSBX)
- +85 ; Not a Continuous
- IF PSBSCHT'="C"
- QUIT
- +86 ; Active? - PSB*3*56 adds on call as an active status
- IF PSBOSTS'="A"&(PSBOSTS'="R")&(PSBOSTS'="O")
- QUIT
- +87 SET (PSBCADM,PSBYES,PSBODD)=0
- +88 SET PSBFREQ=$$GETFREQ^PSBVDLU1(DFN,PSBONX)
- +89 IF $$PSBDCHK1^PSBVT1(PSBSCH)
- SET PSBYES=1
- +90 FOR I=1:1
- IF $PIECE(PSBSCH,"-",I)=""
- QUIT
- IF ($PIECE(PSBSCH,"-",I)?2N)!($PIECE(PSBSCH,"-",I)?4N)
- SET PSBYES=1
- +91 IF PSBYES
- IF PSBADST=""
- IF PSBSCHT'="O"
- IF PSBSCHT'="OC"
- IF PSBSCHT'="P"
- Begin DoDot:4
- +92 DO ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Admin times required",PSBSCH)
- End DoDot:4
- QUIT
- +93 IF "PCS"'[PSBIVT
- IF PSBONX'["U"
- QUIT
- +94 ; allow intermittent syringe only
- IF PSBIVT["S"
- IF PSBISYR'=1
- QUIT
- +95 IF PSBIVT["C"
- IF PSBCHEMT'="P"
- IF PSBISYR'=1
- QUIT
- +96 ; allow Chemo with intermittent syringe or Piggyback type only
- IF PSBIVT["C"
- IF PSBCHEMT="A"
- QUIT
- +97 IF PSBFREQ="D"
- SET PSBFREQ=""
- +98 IF 'PSBYES
- IF PSBFREQ<1
- Begin DoDot:4
- +99 DO ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Invalid frequency received from order",PSBSCH)
- End DoDot:4
- QUIT
- +100 IF +PSBFREQ>0
- Begin DoDot:4
- +101 IF (PSBFREQ#1440'=0)
- IF (1440#PSBFREQ'=0)
- SET PSBODD=1
- End DoDot:4
- +102 IF PSBODD
- IF PSBADST'=""
- Begin DoDot:4
- +103 DO ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Administration Times on ODD SCHEDULE",PSBSCH)
- End DoDot:4
- QUIT
- +104 KILL ^TMP("PSB",$JOB,"GETADMIN")
- +105 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
- +106 IF PSBADST=""
- IF +$GET(PSBFREQ)'<30
- SET PSBADST=$$GETADMIN^PSBVDLU1(DFN,PSBONX,PSBOST,PSBFREQ,PSBRPDT)
- IF PSBADST'=""
- SET PSBCADM=1
- +107 IF '$TEST
- SET ^TMP("PSB",$JOB,"GETADMIN",0)=PSBADST
- +108 IF PSBADST=""
- QUIT
- +109 IF PSBONX'["V"
- Begin DoDot:4
- End DoDot:4
- IF '$$OKAY^PSBVDLU1(PSBOST,PSBRPDT,PSBSCH,PSBONX,PSBOIT,PSBFREQ)
- QUIT
- +110 IF PSBONX["V"
- IF PSBSCH'=""
- IF '$$OKAY^PSBVDLU1(PSBOST,PSBRPDT,PSBSCH,PSBONX,PSBOIT,PSBFREQ)
- QUIT
- +111 FOR PSBXX=0:1
- IF '$DATA(^TMP("PSB",$JOB,"GETADMIN",PSBXX))
- QUIT
- SET PSBADST=$GET(^TMP("PSB",$JOB,"GETADMIN",PSBXX))
- Begin DoDot:4
- +112 FOR Y=1:1:$LENGTH(PSBADST,"-")
- SET Z=+("."_$PIECE(PSBADST,"-",Y))
- Begin DoDot:5
- +113 ; Start Date
- IF (PSBRPDT+Z)<$EXTRACT(PSBOST,1,12)
- QUIT
- +114 ; Stop Date
- IF (PSBRPDT+Z)'<$EXTRACT(PSBOSP,1,12)
- QUIT
- +115 ;For Invalid admin times
- +116 IF ($PIECE(PSBADST,"-",Y)'?2N)&($PIECE(PSBADST,"-",Y)'?4N)
- Begin DoDot:6
- +117 DO ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Invalid Admin times",PSBSCH)
- End DoDot:6
- +118 SET PSBSM=$SELECT(PSBHSM=1:"HSM",PSBSM=1:"SM",1:"")
- +119 ;*** Local array to include order no
- +120 SET PSBTOT(Z,PSBOITX,PSBONX)=PSBSM_U_"Dosage: "_PSBDOSE_" Route: "_PSBMR_" "_PSBIFR
- End DoDot:5
- End DoDot:4
- End DoDot:3
- +121 SET PSBX=""
- FOR
- SET PSBX=$ORDER(PSBTOT(PSBX))
- IF PSBX=""
- QUIT
- Begin DoDot:3
- +122 WRITE !
- +123 SET PSBY=""
- FOR
- SET PSBY=$ORDER(PSBTOT(PSBX,PSBY))
- IF PSBY=""
- QUIT
- Begin DoDot:4
- +124 SET PSBZ=""
- FOR
- SET PSBZ=$ORDER(PSBTOT(PSBX,PSBY,PSBZ))
- IF PSBZ=""
- QUIT
- Begin DoDot:5
- +125 IF $Y>(IOSL-6)
- WRITE $$PTFTR^PSBOHDR(),$$PTHDR()
- +126 IF PSBX="MESSAGE"
- WRITE !,$PIECE(PSBTOT(PSBX,PSBY,PSBZ),U,1),?20,PSBY
- QUIT
- +127 WRITE !,$$TIMEOUT^PSBUTL(PSBX),?10
- +128 WRITE $PIECE(PSBTOT(PSBX,PSBY,PSBZ),U,1),?20,PSBY,?55,$PIECE(PSBTOT(PSBX,PSBY,PSBZ),U,2)
- End DoDot:5
- End DoDot:4
- End DoDot:3
- +129 WRITE $$PTFTR^PSBOHDR()
- End DoDot:2
- +130 KILL ^TMP("PSJ",$JOB),^TMP("PSB",$JOB)
- +131 QUIT
- End DoDot:1
- +132 ;
- WRDHDR() ;
- +1 SET PSBHDR(1)="WARD ADMINISTRATION TIMES"
- +2 DO WARD^PSBOHDR(PSBWRD,.PSBHDR)
- +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 ;
- PTHDR() ;
- +1 SET PSBHDR(1)="PATIENT ADMINISTRATION TIMES"
- +2 DO PT^PSBOHDR(PSBDFN,.PSBHDR)
- +3 WRITE !,"Date/Time",?10,"Self Med",?20,"Medication",?55,"Dose/Route"
- +4 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","-")
- +5 SET Y=PSBRPDT
- DO D^DIQ
- +6 WRITE !!,Y,!
- +7 QUIT ""
- +8 ;