- 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 ;
