PSBOWA.m

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       ;