PSBODL1 ;BIRMINGHAM/VRN-DUE LIST ;Mar 2004
;;3.0;BAR CODE MED ADMIN;**5,9,32,28**;Mar 2004;Build 9
;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
;
EN ;
S PSBFOHDR=0
S PSBORD=0 F S PSBORD=$O(^TMP("PSBO",$J,DFN,PSBORD)) Q:PSBORD="" S PSBTYPE=$O(^TMP("PSBO",$J,DFN,PSBORD,"")) D
.D CLEAN^PSBVT
.D PSJ1^PSBVT(DFN,PSBORD)
.I PSBSCHT="C" D Q:PSBADMIN=""
..S PSBX=PSBADST,PSBFLAG=1
..I PSBX="",PSBONX["V",PSBIVT'="P" S PSBFLAG=0
..S (PSBYES,PSBODD)=0
..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" Q
..I PSBFREQ="O" S PSBFREQ=1440
..I 'PSBYES,PSBADST="",PSBFREQ<1 Q
..I +PSBFREQ>0 I (PSBFREQ#1440'=0),(1440#PSBFREQ'=0) S PSBODD=1
..I PSBODD,PSBADST'="" Q
..D:PSBX=""
...I PSBIVT="C",PSBCHEMT="A" S PSBX="0000",PSBFLAG=0
...I PSBIVT="C",PSBISYR=0 S PSBX="0000",PSBFLAG=0
...I PSBIVT="S",PSBISYR=0 S PSBX="0000",PSBFLAG=0
...I "HA"[PSBIVT S PSBX="0000",PSBFLAG=0
..I ("SC"[PSBIVT),(PSBISYR=1) S PSBX=""
..I (PSBIVT="C"),(PSBCHEMT="P") S PSBX=""
..I PSBOTYP="U",PSBX="0000" S PSBX=""
..I PSBIVT="P",$G(PSBX)=0 S PSBX=""
..I PSBX="" S PSBX=$$GETADMIN^PSBVDLU1(DFN,PSBONX,PSBOST,PSBFREQ,PSBEVDT)
..E K ^TMP("PSB",$J,"GETADMIN") S ^TMP("PSB",$J,"GETADMIN",0)=PSBX
..S PSBADMIN=""
..F PSBXX=0:1 Q:'$D(^TMP("PSB",$J,"GETADMIN",PSBXX)) S PSBX=$G(^TMP("PSB",$J,"GETADMIN",PSBXX)) D
...F PSBY=1:1:$L(PSBX,"-") D
....Q:($P(PSBX,"-",PSBY)'?2N)&($P(PSBX,"-",PSBY)'?4N)
....S PSBAT=+(PSBODATE_"."_$P(PSBX,"-",PSBY))
....I PSBFLAG Q:PSBAT<PSBOSTRT!(PSBAT>PSBOSTOP) ; Report Window
....D VAL^PSBMLVAL(.PSBZ,DFN,PSBONX,PSBTYPE,PSBAT)
....S:$G(PSBFREQ)>29 PSBADMIN=PSBADMIN_$S(PSBADMIN]"":"-",1:"")_$P(PSBX,"-",PSBY)
....S:$G(PSBFREQ)<30 PSBADMIN="Due every "_$G(PSBFREQ)_" minutes."
.I PSBSCHT'="C" S PSBADMIN=PSBADST
.; Get LAST GIVEN date/time
.S PSBLGDT="",X=""
.F S X=$O(^PSB(53.79,"AOIP",DFN,+PSBOIT,X),-1) Q:'X D Q:PSBLGDT
..S PSBIEN=""
..F S PSBIEN=$O(^PSB(53.79,"AOIP",DFN,+PSBOIT,X,PSBIEN),-1) Q:PSBIEN="" D Q:PSBLGDT
...S:"MHNR"'[$P($G(^PSB(53.79,PSBIEN,0)),U,9) PSBLGDT=X
.I $Y>(IOSL-12) I $Y<(IOSL-4) W !?(IOM-36\2),"(Medications Continued on Next Page)",$$FTR(),$$HDR()
.I PSBSM S PSBSM=$S(PSBSMX:"H",1:"")_"SM"
.E S PSBSM=""
.I 'PSBFOHDR S PSBFOHDR=1 W $$HDR()
.W !,$J(PSBSM,3),?6,PSBTYPE,$E(PSBSCHT,1,4),?12 S PSBWFLAG=1
.S X="",Y=0
.W $$WRAP(14,34,PSBOITX)
.S PSBADM="Give: "_PSBDOSE_" "_PSBSCH
.W $$WRAP(50,27,PSBADM)
.W $$WRAP(78,6,PSBMR)
.W ?85 I PSBLGDT W $E(PSBLGDT,4,5),"/",$E(PSBLGDT,6,7),"/",$E(PSBLGDT,2,3) W "@",$E($P(PSBLGDT,".",2)_"0000",1,4)
.W ?100,$P($TR($$FMTE^XLFDT(PSBOST,2),"@"," ")," ")
.W ?110,$P($TR($$FMTE^XLFDT(PSBOSP,2),"@"," ")," ")
.W ?120,$S(PSBVPHI]"":PSBVPHI,1:"***"),"/",$S(PSBVNI]"":PSBVNI,1:"***")
.W !,?100,"@"_$P(PSBOSTX," ",2),?110,"@"_$P(PSBOSPX," ",2)
.W IOINHI ; To Highlight the Dispense Drugs...
.I $D(PSBDDA) S Y=0 F S Y=$O(PSBDDA(Y)) Q:'Y D
..Q:$P(PSBDDA(Y),U,5)&($P(PSBDDA(Y),U,5)<PSBNOW)
..W !?14,"*",$$WRAP(15,33,$P(PSBDDA(Y),U,3)_" ("_+$P(PSBDDA(Y),U,2)_")")
.I $D(PSBADA) S Y=0 F S Y=$O(PSBADA(Y)) Q:'Y W !?14,"*",$$WRAP(15,33,$P(PSBADA(Y),U,3)_" ("_$P(PSBADA(Y),U,4)_")")
.I $D(PSBSOLA) S Y=0 F S Y=$O(PSBSOLA(Y)) Q:'Y W !?14,"*",$$WRAP(15,33,$P(PSBSOLA(Y),U,3)_" ("_$P(PSBSOLA(Y),U,4)_")")
.W IOINORM ; Highlight Off
.S PSBADM=$S(PSBADMIN]"":"Admin Times: "_PSBADMIN,1:"")
.W:PSBADM]"" $$WRAP(50,27,PSBADM)
.S X=$S(PSBOTXT]"":PSBOTXT,1:"<None Entered>")
.I $E(X,1)="!" S $E(X,1)=""
.W $$WRAP(14,34,"Spec Inst: "_X),!,$TR($J("",IOM)," ","-")
I '$G(PSBWFLAG) W !!,?10,"** NO SPECIFIED MEDICATIONS TO PRINT **"
W:PSBFOHDR $$BLANKS(),$$FTR()
K ^TMP("PSB",$J,"GETADMIN")
Q
;
WRAPPUP ;Do wrapping per PSBODL (Due List Report)
;
W $$WRAP(14,34,PSBMED)
S PSBADM="Give: "_PSBDOSE_" "_PSBSCH
W $$WRAP(50,27,PSBADM),?78,$$WRAP(78,6,PSBMR)
W ?85 D:PSBLGDT
.W $E(PSBLGDT,4,5),"/",$E(PSBLGDT,6,7),"/",$E(PSBLGDT,2,3),"@",$E($P(PSBLGDT,".",2)_"0000",1,4)
W ?100,$P($TR($$FMTE^XLFDT(PSBOST,2),"@"," ")," "),?110,$P($TR($$FMTE^XLFDT(PSBOSP,2),"@"," ")," "),?120,$S(PSBVPHI]"":PSBVPHI,1:"***"),"/"
W $S(PSBVNI]"":PSBVNI,1:"***"),!,?100,"@"_$P(PSBOSTX," ",2),?110,"@"_$P(PSBOSPX," ",2)
W IOINHI
I $D(PSBDDA) S Y=0 F S Y=$O(PSBDDA(Y)) Q:'Y D
.Q:$P(PSBDDA(Y),U,5)&($P(PSBDDA(Y),U,5)<PSBNOW)
.W !?14,"*",$$WRAP(15,33,$P(PSBDDA(Y),U,3)) ;_" ("_+$P(PSBDDA(Y),U,2)_")")
I $D(PSBADA) S Y=0 F S Y=$O(PSBADA(Y)) Q:'Y W !?14,"*",$$WRAP(15,33,$P(PSBADA(Y),U,3)) ;_" ("_$P(PSBADA(Y),U,4)_")")
I $D(PSBSOLA) S Y=0 F S Y=$O(PSBSOLA(Y)) Q:'Y W !?14,"*",$$WRAP(15,33,$P(PSBSOLA(Y),U,3)) ;_" ("_$P(PSBSOLA(Y),U,4)_")")
W IOINORM ; Hlight Off
S PSBADM=$S(PSBADMIN]"":"Admin Times: "_PSBADMIN,1:"")
W:PSBADM]"" $$WRAP(50,27,PSBADM)
S X=$S(PSBOTXT]"":PSBOTXT,1:"<None Entered>")
I $E(X,1)="!" S $E(X,1)=""
W $$WRAP(14,34,"Spec Inst: "_X),!,$TR($J("",IOM)," ","-")
Q
;
WRAP(X,Y,Z) ; Quick text wrap
F Q:'$L(Z) D
.W:$X>X !
.W:$X<X ?X
.I $L(Z)<Y W Z S Z="" Q
.F PSB=Y:-1:0 Q:$E(Z,PSB)=" "
.S:PSB<1 PSB=Y
.W $E(Z,1,PSB)
.S Z=$E(Z,PSB+1,255)
Q ""
;
FTR() ; [Extrinsic] Page footer
;
; Sub Module Description:
; (No Description Available)
;
I (IOSL<100) F Q:$Y>(IOSL-10) W !
W !,$TR($J("",IOM)," ","=")
S X="Ward: "_PSBHDR("WARD")_" Room-Bed: "_PSBHDR("ROOM")
W !,PSBHDR("NAME"),?(IOM-11\2),PSBHDR("SSN"),?(IOM-$L(X)),X
Q ""
;
HDR() ; Page Header
Q:'PSBFOHDR ""
D PT^PSBOHDR(DFN,.PSBHDR)
W !
W !
W !,?(IOM-28\2),"***** FUTURE ORDERS *****"
W !
W !,"Self",?85,"Last",?100,"Start",?110,"Stop",?120,"Verifying"
W !,"Med",?6,"Sched",?14,"Medication",?50,"Dose",?78,"Route",?85,"Given",?100,"Date",?110,"Date",?120,"Rph/Rn"
W !,?100,"@Time",?110,"@Time"
W !,$TR($J("",IOM)," ","-")
Q ""
;
BLANKS() ; [Extrinsic] Print blanks at end of printout for changes
Q:'$P(PSBRPT(.2),U,5) ""
W !
I $Y>(IOSL-26) W ?(IOM-42\2),"(Changes/Addendums to Orders on Next Page)" W $$FTR(),$$HDR() ; Not enough space - new page
I IOSL<100 F Q:$Y>(IOSL-26) W !
W ?(IOM-28\2),"Changes/Addendums to orders"
F X=1:1:4 D
.W !,$TR($J("",IOM)," ","-")
.W !!?3,"CON ___ PRN ___",?20,"Drug: ",$TR($J("",22)," ","_"),?50,"Give: ",$TR($J("",42)," ","_"),?100,"Start: _________ Stop: _________"
.W !?20,"Spec"
.W !?3,"OT ___ OC ___",?20,"Inst: ",$TR($J("",72)," ","_"),?100,"Initials: ______ Date: _________"
W !,$TR($J("",IOM)," ","-")
Q ""
;
PSBODL1 ;BIRMINGHAM/VRN-DUE LIST ;Mar 2004
+1 ;;3.0;BAR CODE MED ADMIN;**5,9,32,28**;Mar 2004;Build 9
+2 ;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
+3 ;
EN ;
+1 SET PSBFOHDR=0
+2 SET PSBORD=0
FOR
SET PSBORD=$ORDER(^TMP("PSBO",$JOB,DFN,PSBORD))
IF PSBORD=""
QUIT
SET PSBTYPE=$ORDER(^TMP("PSBO",$JOB,DFN,PSBORD,""))
Begin DoDot:1
+3 DO CLEAN^PSBVT
+4 DO PSJ1^PSBVT(DFN,PSBORD)
+5 IF PSBSCHT="C"
Begin DoDot:2
+6 SET PSBX=PSBADST
SET PSBFLAG=1
+7 IF PSBX=""
IF PSBONX["V"
IF PSBIVT'="P"
SET PSBFLAG=0
+8 SET (PSBYES,PSBODD)=0
+9 IF $$PSBDCHK1^PSBVT1(PSBSCH)
SET PSBYES=1
+10 FOR I=1:1
IF $PIECE(PSBSCH,"-",I)=""
QUIT
IF $PIECE(PSBSCH,"-",I)?2N!($PIECE(PSBSCH,"-",I)?4N)
SET PSBYES=1
+11 IF PSBYES
IF PSBADST=""
IF PSBSCHT'="O"
IF PSBSCHT'="OC"
IF PSBSCHT'="P"
QUIT
+12 IF PSBFREQ="O"
SET PSBFREQ=1440
+13 IF 'PSBYES
IF PSBADST=""
IF PSBFREQ<1
QUIT
+14 IF +PSBFREQ>0
IF (PSBFREQ#1440'=0)
IF (1440#PSBFREQ'=0)
SET PSBODD=1
+15 IF PSBODD
IF PSBADST'=""
QUIT
+16 IF PSBX=""
Begin DoDot:3
+17 IF PSBIVT="C"
IF PSBCHEMT="A"
SET PSBX="0000"
SET PSBFLAG=0
+18 IF PSBIVT="C"
IF PSBISYR=0
SET PSBX="0000"
SET PSBFLAG=0
+19 IF PSBIVT="S"
IF PSBISYR=0
SET PSBX="0000"
SET PSBFLAG=0
+20 IF "HA"[PSBIVT
SET PSBX="0000"
SET PSBFLAG=0
End DoDot:3
+21 IF ("SC"[PSBIVT)
IF (PSBISYR=1)
SET PSBX=""
+22 IF (PSBIVT="C")
IF (PSBCHEMT="P")
SET PSBX=""
+23 IF PSBOTYP="U"
IF PSBX="0000"
SET PSBX=""
+24 IF PSBIVT="P"
IF $GET(PSBX)=0
SET PSBX=""
+25 IF PSBX=""
SET PSBX=$$GETADMIN^PSBVDLU1(DFN,PSBONX,PSBOST,PSBFREQ,PSBEVDT)
+26 IF '$TEST
KILL ^TMP("PSB",$JOB,"GETADMIN")
SET ^TMP("PSB",$JOB,"GETADMIN",0)=PSBX
+27 SET PSBADMIN=""
+28 FOR PSBXX=0:1
IF '$DATA(^TMP("PSB",$JOB,"GETADMIN",PSBXX))
QUIT
SET PSBX=$GET(^TMP("PSB",$JOB,"GETADMIN",PSBXX))
Begin DoDot:3
+29 FOR PSBY=1:1:$LENGTH(PSBX,"-")
Begin DoDot:4
+30 IF ($PIECE(PSBX,"-",PSBY)'?2N)&($PIECE(PSBX,"-",PSBY)'?4N)
QUIT
+31 SET PSBAT=+(PSBODATE_"."_$PIECE(PSBX,"-",PSBY))
+32 ; Report Window
IF PSBFLAG
IF PSBAT<PSBOSTRT!(PSBAT>PSBOSTOP)
QUIT
+33 DO VAL^PSBMLVAL(.PSBZ,DFN,PSBONX,PSBTYPE,PSBAT)
+34 IF $GET(PSBFREQ)>29
SET PSBADMIN=PSBADMIN_$SELECT(PSBADMIN]"":"-",1:"")_$PIECE(PSBX,"-",PSBY)
+35 IF $GET(PSBFREQ)<30
SET PSBADMIN="Due every "_$GET(PSBFREQ)_" minutes."
End DoDot:4
End DoDot:3
End DoDot:2
IF PSBADMIN=""
QUIT
+36 IF PSBSCHT'="C"
SET PSBADMIN=PSBADST
+37 ; Get LAST GIVEN date/time
+38 SET PSBLGDT=""
SET X=""
+39 FOR
SET X=$ORDER(^PSB(53.79,"AOIP",DFN,+PSBOIT,X),-1)
IF 'X
QUIT
Begin DoDot:2
+40 SET PSBIEN=""
+41 FOR
SET PSBIEN=$ORDER(^PSB(53.79,"AOIP",DFN,+PSBOIT,X,PSBIEN),-1)
IF PSBIEN=""
QUIT
Begin DoDot:3
+42 IF "MHNR"'[$PIECE($GET(^PSB(53.79,PSBIEN,0)),U,9)
SET PSBLGDT=X
End DoDot:3
IF PSBLGDT
QUIT
End DoDot:2
IF PSBLGDT
QUIT
+43 IF $Y>(IOSL-12)
IF $Y<(IOSL-4)
WRITE !?(IOM-36\2),"(Medications Continued on Next Page)",$$FTR(),$$HDR()
+44 IF PSBSM
SET PSBSM=$SELECT(PSBSMX:"H",1:"")_"SM"
+45 IF '$TEST
SET PSBSM=""
+46 IF 'PSBFOHDR
SET PSBFOHDR=1
WRITE $$HDR()
+47 WRITE !,$JUSTIFY(PSBSM,3),?6,PSBTYPE,$EXTRACT(PSBSCHT,1,4),?12
SET PSBWFLAG=1
+48 SET X=""
SET Y=0
+49 WRITE $$WRAP(14,34,PSBOITX)
+50 SET PSBADM="Give: "_PSBDOSE_" "_PSBSCH
+51 WRITE $$WRAP(50,27,PSBADM)
+52 WRITE $$WRAP(78,6,PSBMR)
+53 WRITE ?85
IF PSBLGDT
WRITE $EXTRACT(PSBLGDT,4,5),"/",$EXTRACT(PSBLGDT,6,7),"/",$EXTRACT(PSBLGDT,2,3)
WRITE "@",$EXTRACT($PIECE(PSBLGDT,".",2)_"0000",1,4)
+54 WRITE ?100,$PIECE($TRANSLATE($$FMTE^XLFDT(PSBOST,2),"@"," ")," ")
+55 WRITE ?110,$PIECE($TRANSLATE($$FMTE^XLFDT(PSBOSP,2),"@"," ")," ")
+56 WRITE ?120,$SELECT(PSBVPHI]"":PSBVPHI,1:"***"),"/",$SELECT(PSBVNI]"":PSBVNI,1:"***")
+57 WRITE !,?100,"@"_$PIECE(PSBOSTX," ",2),?110,"@"_$PIECE(PSBOSPX," ",2)
+58 ; To Highlight the Dispense Drugs...
WRITE IOINHI
+59 IF $DATA(PSBDDA)
SET Y=0
FOR
SET Y=$ORDER(PSBDDA(Y))
IF 'Y
QUIT
Begin DoDot:2
+60 IF $PIECE(PSBDDA(Y),U,5)&($PIECE(PSBDDA(Y),U,5)<PSBNOW)
QUIT
+61 WRITE !?14,"*",$$WRAP(15,33,$PIECE(PSBDDA(Y),U,3)_" ("_+$PIECE(PSBDDA(Y),U,2)_")")
End DoDot:2
+62 IF $DATA(PSBADA)
SET Y=0
FOR
SET Y=$ORDER(PSBADA(Y))
IF 'Y
QUIT
WRITE !?14,"*",$$WRAP(15,33,$PIECE(PSBADA(Y),U,3)_" ("_$PIECE(PSBADA(Y),U,4)_")")
+63 IF $DATA(PSBSOLA)
SET Y=0
FOR
SET Y=$ORDER(PSBSOLA(Y))
IF 'Y
QUIT
WRITE !?14,"*",$$WRAP(15,33,$PIECE(PSBSOLA(Y),U,3)_" ("_$PIECE(PSBSOLA(Y),U,4)_")")
+64 ; Highlight Off
WRITE IOINORM
+65 SET PSBADM=$SELECT(PSBADMIN]"":"Admin Times: "_PSBADMIN,1:"")
+66 IF PSBADM]""
WRITE $$WRAP(50,27,PSBADM)
+67 SET X=$SELECT(PSBOTXT]"":PSBOTXT,1:"<None Entered>")
+68 IF $EXTRACT(X,1)="!"
SET $EXTRACT(X,1)=""
+69 WRITE $$WRAP(14,34,"Spec Inst: "_X),!,$TRANSLATE($JUSTIFY("",IOM)," ","-")
End DoDot:1
+70 IF '$GET(PSBWFLAG)
WRITE !!,?10,"** NO SPECIFIED MEDICATIONS TO PRINT **"
+71 IF PSBFOHDR
WRITE $$BLANKS(),$$FTR()
+72 KILL ^TMP("PSB",$JOB,"GETADMIN")
+73 QUIT
+74 ;
WRAPPUP ;Do wrapping per PSBODL (Due List Report)
+1 ;
+2 WRITE $$WRAP(14,34,PSBMED)
+3 SET PSBADM="Give: "_PSBDOSE_" "_PSBSCH
+4 WRITE $$WRAP(50,27,PSBADM),?78,$$WRAP(78,6,PSBMR)
+5 WRITE ?85
IF PSBLGDT
Begin DoDot:1
+6 WRITE $EXTRACT(PSBLGDT,4,5),"/",$EXTRACT(PSBLGDT,6,7),"/",$EXTRACT(PSBLGDT,2,3),"@",$EXTRACT($PIECE(PSBLGDT,".",2)_"0000",1,4)
End DoDot:1
+7 WRITE ?100,$PIECE($TRANSLATE($$FMTE^XLFDT(PSBOST,2),"@"," ")," "),?110,$PIECE($TRANSLATE($$FMTE^XLFDT(PSBOSP,2),"@"," ")," "),?120,$SELECT(PSBVPHI]"":PSBVPHI,1:"***"),"/"
+8 WRITE $SELECT(PSBVNI]"":PSBVNI,1:"***"),!,?100,"@"_$PIECE(PSBOSTX," ",2),?110,"@"_$PIECE(PSBOSPX," ",2)
+9 WRITE IOINHI
+10 IF $DATA(PSBDDA)
SET Y=0
FOR
SET Y=$ORDER(PSBDDA(Y))
IF 'Y
QUIT
Begin DoDot:1
+11 IF $PIECE(PSBDDA(Y),U,5)&($PIECE(PSBDDA(Y),U,5)<PSBNOW)
QUIT
+12 ;_" ("_+$P(PSBDDA(Y),U,2)_")")
WRITE !?14,"*",$$WRAP(15,33,$PIECE(PSBDDA(Y),U,3))
End DoDot:1
+13 ;_" ("_$P(PSBADA(Y),U,4)_")")
IF $DATA(PSBADA)
SET Y=0
FOR
SET Y=$ORDER(PSBADA(Y))
IF 'Y
QUIT
WRITE !?14,"*",$$WRAP(15,33,$PIECE(PSBADA(Y),U,3))
+14 ;_" ("_$P(PSBSOLA(Y),U,4)_")")
IF $DATA(PSBSOLA)
SET Y=0
FOR
SET Y=$ORDER(PSBSOLA(Y))
IF 'Y
QUIT
WRITE !?14,"*",$$WRAP(15,33,$PIECE(PSBSOLA(Y),U,3))
+15 ; Hlight Off
WRITE IOINORM
+16 SET PSBADM=$SELECT(PSBADMIN]"":"Admin Times: "_PSBADMIN,1:"")
+17 IF PSBADM]""
WRITE $$WRAP(50,27,PSBADM)
+18 SET X=$SELECT(PSBOTXT]"":PSBOTXT,1:"<None Entered>")
+19 IF $EXTRACT(X,1)="!"
SET $EXTRACT(X,1)=""
+20 WRITE $$WRAP(14,34,"Spec Inst: "_X),!,$TRANSLATE($JUSTIFY("",IOM)," ","-")
+21 QUIT
+22 ;
WRAP(X,Y,Z) ; Quick text wrap
+1 FOR
IF '$LENGTH(Z)
QUIT
Begin DoDot:1
+2 IF $X>X
WRITE !
+3 IF $X<X
WRITE ?X
+4 IF $LENGTH(Z)<Y
WRITE Z
SET Z=""
QUIT
+5 FOR PSB=Y:-1:0
IF $EXTRACT(Z,PSB)=" "
QUIT
+6 IF PSB<1
SET PSB=Y
+7 WRITE $EXTRACT(Z,1,PSB)
+8 SET Z=$EXTRACT(Z,PSB+1,255)
End DoDot:1
+9 QUIT ""
+10 ;
FTR() ; [Extrinsic] Page footer
+1 ;
+2 ; Sub Module Description:
+3 ; (No Description Available)
+4 ;
+5 IF (IOSL<100)
FOR
IF $Y>(IOSL-10)
QUIT
WRITE !
+6 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","=")
+7 SET X="Ward: "_PSBHDR("WARD")_" Room-Bed: "_PSBHDR("ROOM")
+8 WRITE !,PSBHDR("NAME"),?(IOM-11\2),PSBHDR("SSN"),?(IOM-$LENGTH(X)),X
+9 QUIT ""
+10 ;
HDR() ; Page Header
+1 IF 'PSBFOHDR
QUIT ""
+2 DO PT^PSBOHDR(DFN,.PSBHDR)
+3 WRITE !
+4 WRITE !
+5 WRITE !,?(IOM-28\2),"***** FUTURE ORDERS *****"
+6 WRITE !
+7 WRITE !,"Self",?85,"Last",?100,"Start",?110,"Stop",?120,"Verifying"
+8 WRITE !,"Med",?6,"Sched",?14,"Medication",?50,"Dose",?78,"Route",?85,"Given",?100,"Date",?110,"Date",?120,"Rph/Rn"
+9 WRITE !,?100,"@Time",?110,"@Time"
+10 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","-")
+11 QUIT ""
+12 ;
BLANKS() ; [Extrinsic] Print blanks at end of printout for changes
+1 IF '$PIECE(PSBRPT(.2),U,5)
QUIT ""
+2 WRITE !
+3 ; Not enough space - new page
IF $Y>(IOSL-26)
WRITE ?(IOM-42\2),"(Changes/Addendums to Orders on Next Page)"
WRITE $$FTR(),$$HDR()
+4 IF IOSL<100
FOR
IF $Y>(IOSL-26)
QUIT
WRITE !
+5 WRITE ?(IOM-28\2),"Changes/Addendums to orders"
+6 FOR X=1:1:4
Begin DoDot:1
+7 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","-")
+8 WRITE !!?3,"CON ___ PRN ___",?20,"Drug: ",$TRANSLATE($JUSTIFY("",22)," ","_"),?50,"Give: ",$TRANSLATE($JUSTIFY("",42)," ","_"),?100,"Start: _________ Stop: _________"
+9 WRITE !?20,"Spec"
+10 WRITE !?3,"OT ___ OC ___",?20,"Inst: ",$TRANSLATE($JUSTIFY("",72)," ","_"),?100,"Initials: ______ Date: _________"
End DoDot:1
+11 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","-")
+12 QUIT ""
+13 ;
