PSBOML ;BIRMINGHAM/EFC-MEDICATION LOG ;29-May-2012 14:20;PLS
;;3.0;BAR CODE MED ADMIN;**3,11,1005,50,1015**;Mar 2004;Build 62
;
; Modified - IHS/CIA/PLS - 06/21/04 - Line EN+6
; IHS/MSC/PLS - 02/22/07 - Line EN+35
; Added PTID API
; Reference/IA
; ^DPT/10035
;
;
EN ; Begin printing
N PSBSTRT,PSBSTOP,PSBHDR,DFN
S PSBSTRT=$P(PSBRPT(.1),U,6)+$P(PSBRPT(.1),U,7)
S PSBSTOP=$P(PSBRPT(.1),U,8)+$P(PSBRPT(.1),U,9)
S PSBAUDF=$P(PSBRPT(.2),U,9)
S PSBHDR(0)="Medication Log Report"
; IHS/CIA/PLS - 06/21/04 - Removed reference to VA Form
;S PSBHDR(1)="Continuing/PRN/Stat/One Time Medication/Treatment Record (Detailed Log) (VAF 10-2970 B, C, D)"
S PSBHDR(1)="Continuing/PRN/Stat/One Time Medication/Treatment Record (Detailed Log)"
;
; Patient Report
;
D:$P(PSBRPT(.1),U,1)="P"
.S PSBHDR(2)="Log Type: INDIVIDUAL PATIENT"
.S DFN=+$P(PSBRPT(.1),U,2)
.W $$PTHDR()
.S X=$O(^PSB(53.79,"AADT",DFN,PSBSTRT-.0000001))
.I X>PSBSTOP!(X="") W !!?10,"<<<< NO MEDICATIONS FOUND FOR THIS TIME FRAME >>>>",!! Q
.S PSBGBL=$NAME(^PSB(53.79,"AADT",DFN,PSBSTRT-.0000001))
.F S PSBGBL=$Q(@PSBGBL) Q:PSBGBL="" Q:$QS(PSBGBL,2)'="AADT"!($QS(PSBGBL,3)'=DFN)!($QS(PSBGBL,4)>PSBSTOP) D
..S PSBIEN=$QS(PSBGBL,5) Q:'$D(^PSB(53.79,PSBIEN))
..I $P(^PSB(53.79,PSBIEN,0),U,6)'=$QS(PSBGBL,4) Q
..I $Y>(IOSL-10) W $$PTFTR^PSBOHDR(),$$PTHDR()
..W $$LINE(PSBIEN)
.W $$PTFTR^PSBOHDR()
;
; Ward Output
;
D:$P(PSBRPT(.1),U,1)="W"
.S PSBHDR(2)="LOG TYPE: WARD"
.W $$WDHDR(PSBWRD)
.S PSBTMPG=$NAME(^TMP("PSBO",$J,"B"))
.F S PSBTMPG=$Q(@PSBTMPG) Q:PSBTMPG="" Q:$QS(PSBTMPG,1)'="PSBO"!($QS(PSBTMPG,2)'=$J) D
..S DFN=$QS(PSBTMPG,5)
..I $Y>(IOSL-14) W $$WDHDR(PSBWRD)
..; IHS/MSC/PLS - 02/22/07 - Next line commented out, following line added
..;W !,$P(^DPT(DFN,0),U)," (",$P(^(0),U,9),")"
..W !,$P(^DPT(DFN,0),U)," (",$$PTID(DFN),")"
..W !,"Ward: ",$G(^DPT(DFN,.1),"***")," Rm-Bed: ",$G(^DPT(DFN,.101),"***"),!
..S X=$O(^PSB(53.79,"AADT",DFN,PSBSTRT-.0000001))
..I X>PSBSTOP!(X="") W !!?10,"<<<< NO MEDICATIONS FOUND FOR THIS TIME FRAME >>>>",!! Q
..S PSBGBL=$NAME(^PSB(53.79,"AADT",DFN,PSBSTRT-.0000001))
..F S PSBGBL=$Q(@PSBGBL) Q:PSBGBL="" Q:$QS(PSBGBL,2)'="AADT"!($QS(PSBGBL,3)'=DFN)!($QS(PSBGBL,4)>PSBSTOP) D
...S PSBIEN=$QS(PSBGBL,5) I $P(^PSB(53.79,PSBIEN,0),U,6)'=$QS(PSBGBL,4) Q
...W:$Y>(IOSL-10) $$WDHDR(PSBWRD)
...W $$LINE(PSBIEN)
Q
;
LINE(PSBIEN) ; Displays the med log entry in PSBIEN
N PSBX,PSBASTUS
S X=$P($G(^PSB(53.79,PSBIEN,.1)),U)
I X="" W !,"Error: Med Log Entry ",PSBIEN," has no order reference number!" Q ""
I 'PSBAUDF,$P(^PSB(53.79,PSBIEN,0),U,9)="N" Q ""
D CLEAN^PSBVT
D PSJ1^PSBVT(DFN,X)
I PSBDFN="-1" W !,"Error: Inpatient Meds API Failure!" Q ""
M PSBX=^PSB(53.79,PSBIEN)
S Y=$P(PSBX(0),U,4)+.0000001
W !,$E(Y,4,5),"/",$E(Y,6,7),"/",$E(Y,2,3)
W " ",$E(Y,9,10),":",$E(Y,11,12)
S Y=$$GET1^DIQ(53.79,PSBIEN_",",.08)
S Y=Y_" ["_PSBDOSE_PSBIFR_" "_PSBSCH
S Y=Y_" "_PSBMRAB
S:$P($G(^PSB(53.79,PSBIEN,.1)),U,6)]"" Y=Y_" Inj Site: "_$P(^(.1),U,6)
S Y=Y_"]"
W $$WRAP^PSBO(16,32,Y)
W ?50,$$GET1^DIQ(53.79,PSBIEN_",","ACTION BY:INITIAL")
S X=$P(PSBX(0),U,9)
S PSBASTUS=$S(X="G":"Given",X="H":"Held",X="R":"Refused",X="I":"Infusing",X="C":"Completed",X="S":"Stopped",X="N":"Not Given",X="RM":"Removed",X="M":"Missing dose",1:"Status Unknown")
S Y=$P(PSBX(0),U,6)+.0000001
S Y=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)_" "_$E(Y,9,10)_":"_$E(Y,11,12)
S Y=Y_" "_PSBASTUS
W $$WRAP^PSBO(57,15,Y)
W:$P(PSBX(.1),U)["V" ?75,"Bag ID #",$$GET1^DIQ(53.79,PSBIEN,"IV UNIQUE ID")
W:$P(PSBX(.1),U)["V" ?107,"NA",?115,"NA",?120,"NA"
W !,$TR($$FMTE^XLFDT(PSBOST,2),"@"," ")_">"
F PSBZ=.5,.6,.7 S PSBDHIT=0 F PSBY=0:0 S PSBY=$O(PSBX(PSBZ,PSBY)) Q:'PSBY D
.W:$X>75 !
.S PSBDD=$S(PSBZ=.5:53.795,PSBZ=.6:53.796,1:53.797)
.S Y=$$EXTERNAL^DILFD(PSBDD,.01,"",$P(PSBX(PSBZ,PSBY,0),U,1))
.W $$WRAP^PSBO(75,28,Y)
.I $P(PSBX(.1),U)["U" W ?105,$J($P(PSBX(PSBZ,PSBY,0),U,2),6,2),?113,$J($P(PSBX(PSBZ,PSBY,0),U,3),6,2) W $$WRAP^PSBO(120,12,$P(PSBX(PSBZ,PSBY,0),U,4)) S PSBDHIT=1
.W:$P(PSBX(.1),U)["V"&($X+3+$L($P(PSBX(PSBZ,PSBY,0),U,3))>105) !?75
.W:$P(PSBX(.1),U)["V" " - ",$P(PSBX(PSBZ,PSBY,0),U,3)
D:$P($G(^PSB(53.79,PSBIEN,.1)),U,2)="P"
.W !?16,"PRN Reason: ",?30,$$GET1^DIQ(53.79,PSBIEN_",",.21)
.W !?16,"PRN Effectiveness: "
.I $P($G(^PSB(53.79,PSBIEN,.2)),U,2)="" W "<No PRN Effectiveness Entered>" Q
.N PSBEIECMT S PSBEIECMT="" I $P($G(^PSB(53.79,PSBIEN,.2)),U,2)'="",$P(PSBRPT(.2),U,8)=0 S PSBEIECMT=$$PRNEFF^PSBO(PSBEIECMT,PSBIEN)
.W $$WRAP^PSBO(20,100,$$GET1^DIQ(53.79,PSBIEN_",",.22)_PSBEIECMT)
.W !?20,"Entered By: ",$$GET1^DIQ(53.79,PSBIEN_",",.23)
.W " Date/Time: ",$$GET1^DIQ(53.79,PSBIEN_",",.24)
.W " Minutes: ",$$GET1^DIQ(53.79,PSBIEN_",",.25)
D:$P(PSBRPT(.2),U,8)
.W !?16,"Comments: ",?30 I '$O(PSBX(.3,0)) W "<No Comments>"
.F PSBY=0:0 S PSBY=$O(PSBX(.3,PSBY)) Q:'PSBY D
..W:$X>30 !?30
..S Y=$P(PSBX(.3,PSBY,0),U,3)+.0000001
..W $E(Y,4,5),"/",$E(Y,6,7),"/",$E(Y,2,3)
..W " ",$E(Y,9,10),":",$E(Y,11,12)
..W ?46,$$GET1^DIQ(53.793,PSBY_","_PSBIEN_",","ENTERED BY:INITIAL")
..W $$WRAP^PSBO(52,70,$P(PSBX(.3,PSBY,0),U,1))
W !,$TR($$FMTE^XLFDT(PSBOSP,2),"@"," ")_"<"
D:PSBAUDF
.W !?16,"Audits: ",?30 I '$O(PSBX(.9,0)) W "<No Audits>" Q
.F PSBY=0:0 S PSBY=$O(PSBX(.9,PSBY)) Q:'PSBY D
..W:$X>30 !?30
..S Y=$P(PSBX(.9,PSBY,0),U,1)+.0000001
..W $E(Y,4,5),"/",$E(Y,6,7),"/",$E(Y,2,3)
..W " ",$E(Y,9,10),":",$E(Y,11,12)
..W ?46,$$GET1^DIQ(53.799,PSBY_","_PSBIEN_",","USER:INITIAL")
..W $$WRAP^PSBO(52,70,$P(PSBX(.9,PSBY,0),U,3))
W !,$TR($J("",IOM)," ","-")
Q ""
;
WDHDR(PSBWARD) ;
D WARD^PSBOHDR(PSBWARD,.PSBHDR)
W $$SUB()
Q ""
;
PTHDR() ;
D PT^PSBOHDR(DFN,.PSBHDR)
W $$SUB()
Q ""
;
SUB() ; Med Log Sub Header
W:$X>1 !
W "Activity Date",?16,"Orderable Item",?50,"Action",?57,"Action"
W !,"Start Date>",?16,"[Dose/Sched/Route/Inj Site]",?50,"By"
W ?57,"Date/Time",?75,"Drug/Additive/Solution",?105," U/Ord"
W ?113," U/Gvn",?120,"Unit",!,"Stop Date<"
W !,$TR($J("",IOM)," ","-")
Q ""
;
;
PTID(DFN,TYP) ;
N VADM,VAERR,VA
D DEM^VADPT
Q $S($G(TYP):$G(VA("BID")),1:$G(VA("PID")))
PSBOML ;BIRMINGHAM/EFC-MEDICATION LOG ;29-May-2012 14:20;PLS
+1 ;;3.0;BAR CODE MED ADMIN;**3,11,1005,50,1015**;Mar 2004;Build 62
+2 ;
+3 ; Modified - IHS/CIA/PLS - 06/21/04 - Line EN+6
+4 ; IHS/MSC/PLS - 02/22/07 - Line EN+35
+5 ; Added PTID API
+6 ; Reference/IA
+7 ; ^DPT/10035
+8 ;
+9 ;
EN ; Begin printing
+1 NEW PSBSTRT,PSBSTOP,PSBHDR,DFN
+2 SET PSBSTRT=$PIECE(PSBRPT(.1),U,6)+$PIECE(PSBRPT(.1),U,7)
+3 SET PSBSTOP=$PIECE(PSBRPT(.1),U,8)+$PIECE(PSBRPT(.1),U,9)
+4 SET PSBAUDF=$PIECE(PSBRPT(.2),U,9)
+5 SET PSBHDR(0)="Medication Log Report"
+6 ; IHS/CIA/PLS - 06/21/04 - Removed reference to VA Form
+7 ;S PSBHDR(1)="Continuing/PRN/Stat/One Time Medication/Treatment Record (Detailed Log) (VAF 10-2970 B, C, D)"
+8 SET PSBHDR(1)="Continuing/PRN/Stat/One Time Medication/Treatment Record (Detailed Log)"
+9 ;
+10 ; Patient Report
+11 ;
+12 IF $PIECE(PSBRPT(.1),U,1)="P"
Begin DoDot:1
+13 SET PSBHDR(2)="Log Type: INDIVIDUAL PATIENT"
+14 SET DFN=+$PIECE(PSBRPT(.1),U,2)
+15 WRITE $$PTHDR()
+16 SET X=$ORDER(^PSB(53.79,"AADT",DFN,PSBSTRT-.0000001))
+17 IF X>PSBSTOP!(X="")
WRITE !!?10,"<<<< NO MEDICATIONS FOUND FOR THIS TIME FRAME >>>>",!!
QUIT
+18 SET PSBGBL=$NAME(^PSB(53.79,"AADT",DFN,PSBSTRT-.0000001))
+19 FOR
SET PSBGBL=$QUERY(@PSBGBL)
IF PSBGBL=""
QUIT
IF $QSUBSCRIPT(PSBGBL,2)'="AADT"!($QSUBSCRIPT(PSBGBL,3)'=DFN)!($QSUBSCRIPT(PSBGBL,4)>PSBSTOP)
QUIT
Begin DoDot:2
+20 SET PSBIEN=$QSUBSCRIPT(PSBGBL,5)
IF '$DATA(^PSB(53.79,PSBIEN))
QUIT
+21 IF $PIECE(^PSB(53.79,PSBIEN,0),U,6)'=$QSUBSCRIPT(PSBGBL,4)
QUIT
+22 IF $Y>(IOSL-10)
WRITE $$PTFTR^PSBOHDR(),$$PTHDR()
+23 WRITE $$LINE(PSBIEN)
End DoDot:2
+24 WRITE $$PTFTR^PSBOHDR()
End DoDot:1
+25 ;
+26 ; Ward Output
+27 ;
+28 IF $PIECE(PSBRPT(.1),U,1)="W"
Begin DoDot:1
+29 SET PSBHDR(2)="LOG TYPE: WARD"
+30 WRITE $$WDHDR(PSBWRD)
+31 SET PSBTMPG=$NAME(^TMP("PSBO",$JOB,"B"))
+32 FOR
SET PSBTMPG=$QUERY(@PSBTMPG)
IF PSBTMPG=""
QUIT
IF $QSUBSCRIPT(PSBTMPG,1)'="PSBO"!($QSUBSCRIPT(PSBTMPG,2)'=$JOB)
QUIT
Begin DoDot:2
+33 SET DFN=$QSUBSCRIPT(PSBTMPG,5)
+34 IF $Y>(IOSL-14)
WRITE $$WDHDR(PSBWRD)
+35 ; IHS/MSC/PLS - 02/22/07 - Next line commented out, following line added
+36 ;W !,$P(^DPT(DFN,0),U)," (",$P(^(0),U,9),")"
+37 WRITE !,$PIECE(^DPT(DFN,0),U)," (",$$PTID(DFN),")"
+38 WRITE !,"Ward: ",$GET(^DPT(DFN,.1),"***")," Rm-Bed: ",$GET(^DPT(DFN,.101),"***"),!
+39 SET X=$ORDER(^PSB(53.79,"AADT",DFN,PSBSTRT-.0000001))
+40 IF X>PSBSTOP!(X="")
WRITE !!?10,"<<<< NO MEDICATIONS FOUND FOR THIS TIME FRAME >>>>",!!
QUIT
+41 SET PSBGBL=$NAME(^PSB(53.79,"AADT",DFN,PSBSTRT-.0000001))
+42 FOR
SET PSBGBL=$QUERY(@PSBGBL)
IF PSBGBL=""
QUIT
IF $QSUBSCRIPT(PSBGBL,2)'="AADT"!($QSUBSCRIPT(PSBGBL,3)'=DFN)!($QSUBSCRIPT(PSBGBL,4)>PSBSTOP)
QUIT
Begin DoDot:3
+43 SET PSBIEN=$QSUBSCRIPT(PSBGBL,5)
IF $PIECE(^PSB(53.79,PSBIEN,0),U,6)'=$QSUBSCRIPT(PSBGBL,4)
QUIT
+44 IF $Y>(IOSL-10)
WRITE $$WDHDR(PSBWRD)
+45 WRITE $$LINE(PSBIEN)
End DoDot:3
End DoDot:2
End DoDot:1
+46 QUIT
+47 ;
LINE(PSBIEN) ; Displays the med log entry in PSBIEN
+1 NEW PSBX,PSBASTUS
+2 SET X=$PIECE($GET(^PSB(53.79,PSBIEN,.1)),U)
+3 IF X=""
WRITE !,"Error: Med Log Entry ",PSBIEN," has no order reference number!"
QUIT ""
+4 IF 'PSBAUDF
IF $PIECE(^PSB(53.79,PSBIEN,0),U,9)="N"
QUIT ""
+5 DO CLEAN^PSBVT
+6 DO PSJ1^PSBVT(DFN,X)
+7 IF PSBDFN="-1"
WRITE !,"Error: Inpatient Meds API Failure!"
QUIT ""
+8 MERGE PSBX=^PSB(53.79,PSBIEN)
+9 SET Y=$PIECE(PSBX(0),U,4)+.0000001
+10 WRITE !,$EXTRACT(Y,4,5),"/",$EXTRACT(Y,6,7),"/",$EXTRACT(Y,2,3)
+11 WRITE " ",$EXTRACT(Y,9,10),":",$EXTRACT(Y,11,12)
+12 SET Y=$$GET1^DIQ(53.79,PSBIEN_",",.08)
+13 SET Y=Y_" ["_PSBDOSE_PSBIFR_" "_PSBSCH
+14 SET Y=Y_" "_PSBMRAB
+15 IF $PIECE($GET(^PSB(53.79,PSBIEN,.1)),U,6)]""
SET Y=Y_" Inj Site: "_$PIECE(^(.1),U,6)
+16 SET Y=Y_"]"
+17 WRITE $$WRAP^PSBO(16,32,Y)
+18 WRITE ?50,$$GET1^DIQ(53.79,PSBIEN_",","ACTION BY:INITIAL")
+19 SET X=$PIECE(PSBX(0),U,9)
+20 SET PSBASTUS=$SELECT(X="G":"Given",X="H":"Held",X="R":"Refused",X="I":"Infusing",X="C":"Completed",X="S":"Stopped",X="N":"Not Given",X="RM":"Removed",X="M":"Missing dose",1:"Status Unknown")
+21 SET Y=$PIECE(PSBX(0),U,6)+.0000001
+22 SET Y=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)_" "_$EXTRACT(Y,9,10)_":"_$EXTRACT(Y,11,12)
+23 SET Y=Y_" "_PSBASTUS
+24 WRITE $$WRAP^PSBO(57,15,Y)
+25 IF $PIECE(PSBX(.1),U)["V"
WRITE ?75,"Bag ID #",$$GET1^DIQ(53.79,PSBIEN,"IV UNIQUE ID")
+26 IF $PIECE(PSBX(.1),U)["V"
WRITE ?107,"NA",?115,"NA",?120,"NA"
+27 WRITE !,$TRANSLATE($$FMTE^XLFDT(PSBOST,2),"@"," ")_">"
+28 FOR PSBZ=.5,.6,.7
SET PSBDHIT=0
FOR PSBY=0:0
SET PSBY=$ORDER(PSBX(PSBZ,PSBY))
IF 'PSBY
QUIT
Begin DoDot:1
+29 IF $X>75
WRITE !
+30 SET PSBDD=$SELECT(PSBZ=.5:53.795,PSBZ=.6:53.796,1:53.797)
+31 SET Y=$$EXTERNAL^DILFD(PSBDD,.01,"",$PIECE(PSBX(PSBZ,PSBY,0),U,1))
+32 WRITE $$WRAP^PSBO(75,28,Y)
+33 IF $PIECE(PSBX(.1),U)["U"
WRITE ?105,$JUSTIFY($PIECE(PSBX(PSBZ,PSBY,0),U,2),6,2),?113,$JUSTIFY($PIECE(PSBX(PSBZ,PSBY,0),U,3),6,2)
WRITE $$WRAP^PSBO(120,12,$PIECE(PSBX(PSBZ,PSBY,0),U,4))
SET PSBDHIT=1
+34 IF $PIECE(PSBX(.1),U)["V"&($X+3+$LENGTH($PIECE(PSBX(PSBZ,PSBY,0),U,3))>105)
WRITE !?75
+35 IF $PIECE(PSBX(.1),U)["V"
WRITE " - ",$PIECE(PSBX(PSBZ,PSBY,0),U,3)
End DoDot:1
+36 IF $PIECE($GET(^PSB(53.79,PSBIEN,.1)),U,2)="P"
Begin DoDot:1
+37 WRITE !?16,"PRN Reason: ",?30,$$GET1^DIQ(53.79,PSBIEN_",",.21)
+38 WRITE !?16,"PRN Effectiveness: "
+39 IF $PIECE($GET(^PSB(53.79,PSBIEN,.2)),U,2)=""
WRITE "<No PRN Effectiveness Entered>"
QUIT
+40 NEW PSBEIECMT
SET PSBEIECMT=""
IF $PIECE($GET(^PSB(53.79,PSBIEN,.2)),U,2)'=""
IF $PIECE(PSBRPT(.2),U,8)=0
SET PSBEIECMT=$$PRNEFF^PSBO(PSBEIECMT,PSBIEN)
+41 WRITE $$WRAP^PSBO(20,100,$$GET1^DIQ(53.79,PSBIEN_",",.22)_PSBEIECMT)
+42 WRITE !?20,"Entered By: ",$$GET1^DIQ(53.79,PSBIEN_",",.23)
+43 WRITE " Date/Time: ",$$GET1^DIQ(53.79,PSBIEN_",",.24)
+44 WRITE " Minutes: ",$$GET1^DIQ(53.79,PSBIEN_",",.25)
End DoDot:1
+45 IF $PIECE(PSBRPT(.2),U,8)
Begin DoDot:1
+46 WRITE !?16,"Comments: ",?30
IF '$ORDER(PSBX(.3,0))
WRITE "<No Comments>"
+47 FOR PSBY=0:0
SET PSBY=$ORDER(PSBX(.3,PSBY))
IF 'PSBY
QUIT
Begin DoDot:2
+48 IF $X>30
WRITE !?30
+49 SET Y=$PIECE(PSBX(.3,PSBY,0),U,3)+.0000001
+50 WRITE $EXTRACT(Y,4,5),"/",$EXTRACT(Y,6,7),"/",$EXTRACT(Y,2,3)
+51 WRITE " ",$EXTRACT(Y,9,10),":",$EXTRACT(Y,11,12)
+52 WRITE ?46,$$GET1^DIQ(53.793,PSBY_","_PSBIEN_",","ENTERED BY:INITIAL")
+53 WRITE $$WRAP^PSBO(52,70,$PIECE(PSBX(.3,PSBY,0),U,1))
End DoDot:2
End DoDot:1
+54 WRITE !,$TRANSLATE($$FMTE^XLFDT(PSBOSP,2),"@"," ")_"<"
+55 IF PSBAUDF
Begin DoDot:1
+56 WRITE !?16,"Audits: ",?30
IF '$ORDER(PSBX(.9,0))
WRITE "<No Audits>"
QUIT
+57 FOR PSBY=0:0
SET PSBY=$ORDER(PSBX(.9,PSBY))
IF 'PSBY
QUIT
Begin DoDot:2
+58 IF $X>30
WRITE !?30
+59 SET Y=$PIECE(PSBX(.9,PSBY,0),U,1)+.0000001
+60 WRITE $EXTRACT(Y,4,5),"/",$EXTRACT(Y,6,7),"/",$EXTRACT(Y,2,3)
+61 WRITE " ",$EXTRACT(Y,9,10),":",$EXTRACT(Y,11,12)
+62 WRITE ?46,$$GET1^DIQ(53.799,PSBY_","_PSBIEN_",","USER:INITIAL")
+63 WRITE $$WRAP^PSBO(52,70,$PIECE(PSBX(.9,PSBY,0),U,3))
End DoDot:2
End DoDot:1
+64 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","-")
+65 QUIT ""
+66 ;
WDHDR(PSBWARD) ;
+1 DO WARD^PSBOHDR(PSBWARD,.PSBHDR)
+2 WRITE $$SUB()
+3 QUIT ""
+4 ;
PTHDR() ;
+1 DO PT^PSBOHDR(DFN,.PSBHDR)
+2 WRITE $$SUB()
+3 QUIT ""
+4 ;
SUB() ; Med Log Sub Header
+1 IF $X>1
WRITE !
+2 WRITE "Activity Date",?16,"Orderable Item",?50,"Action",?57,"Action"
+3 WRITE !,"Start Date>",?16,"[Dose/Sched/Route/Inj Site]",?50,"By"
+4 WRITE ?57,"Date/Time",?75,"Drug/Additive/Solution",?105," U/Ord"
+5 WRITE ?113," U/Gvn",?120,"Unit",!,"Stop Date<"
+6 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","-")
+7 QUIT ""
+8 ;
+9 ;
PTID(DFN,TYP) ;
+1 NEW VADM,VAERR,VA
+2 DO DEM^VADPT
+3 QUIT $SELECT($GET(TYP):$GET(VA("BID")),1:$GET(VA("PID")))
