PSBODO ;BIRMINGHAM/EFC-BCMA UNIT DOSE VIRTUAL DUE LIST FUNCTIONS ;Mar 2004
;;3.0;BAR CODE MED ADMIN;**5,21,24,38**;Mar 2004;Build 8
;Per VHA Directive 2004-038, this routine should not be modified.
;
; Reference/IA
; EN^PSJBCMA2/2830
EN ;
;
; Description:
; Returns a display for a selected order when double clicked on the VDL
;
N PSBGBL,DFN
S PSBGBL=$NAME(^TMP("PSBO",$J,"B"))
F S PSBGBL=$Q(@PSBGBL) Q:PSBGBL="" Q:$QS(PSBGBL,2)'=$J Q:$QS(PSBGBL,1)'["PSBO" D
.S DFN=$QS(PSBGBL,5)
.D DISPORD
Q
;
DISPORD ;
N PSBGBL,PSBOI,PSBHDR,PSJGLO
S PSBOI=$$GET1^DIQ(53.69,PSBRPT_",",.09)
D EN^PSJBCMA2(DFN,PSBOI)
S PSJGLO="^TMP(""PSJ"""_","_$J
D CLEAN^PSBVT
D PSJ1^PSBVT(DFN,PSBOI)
S PSBHDR(1)="BCMA - Display Order" D PT^PSBOHDR(DFN,.PSBHDR) W !
I '$G(PSBONX) W !,"Invalid Order"
D:$G(PSBONX)
.W !,"Orderable Item: ",PSBOITX
.I PSBONX["V" W !,"Infusion Rate: ",PSBIFR
.I PSBONX'["V" W !,"Dosage Ordered: ",PSBDOSE
.W ?40,"Start: ",PSBOSTX
.W !?40,"Stop: ",PSBOSPX
.W !,"Med Route: ",PSBMR
.W !,"Schedule Type: ",PSBSCHTX
.I PSBONX'["V" W ?40,"Self Med: ",PSBSMX
.W:PSBSM !?40,"Hosp Sup: ",PSBSMX
.W:PSBSCH'="" !,"Schedule: ",PSBSCH
.I PSBONX'["V" W !,"Admin Times: ",PSBADST
.I PSBONX["V",((PSBIVT="P")!(PSBISYR=1)) W !,"Admin Times: ",PSBADST
.W !,"Provider: ",PSBMDX
.I $E(PSBOTXT,1)="!" S $E(PSBOTXT,1)=""
.W !,"Spec Inst: ",PSBOTXT
.W !
.I $D(PSBDDA(1)) D
..W !,"Dispense Drugs",!,"Drug Name",?40,"Units",?50,"Inactive Date"
..W !,$TR($J("",75)," ","-")
..F Y=0:0 S Y=$O(PSBDDA(Y)) Q:'Y D
...S X=$P(PSBDDA(Y),U,4)
...W !,$P(PSBDDA(Y),U,3),?40,$S(X]"":X,1:1)
...S X=$P(PSBDDA(Y),U,5) Q:'X
...W ?50,$E(X,4,5),"/",$E(X,6,7),"/",(1700+$E(X,1,3))
.I $D(PSBADA(1)) D
..W !!,"Additives",!,"Name",?40,"Strength"
..W !,$TR($J("",75)," ","-")
..F Y=0:0 S Y=$O(PSBADA(Y)) Q:'Y D
...W !,$P(PSBADA(Y),U,3),?40,$P(PSBADA(Y),U,4)
.I $D(PSBSOLA(1)) D
..W !!,"Solution",!,"Name",?40,"Volume"
..W !,$TR($J("",75)," ","-")
..F Y=0:0 S Y=$O(PSBSOLA(Y)) Q:'Y D
...W !,$P(PSBSOLA(Y),U,3),?40,$P(PSBSOLA(Y),U,4)
.I $P(@(PSJGLO_","_0_")"),U,1)'=-1 D
..W !,$TR($J("",75)," ","-")
..W !,"Pharmacy Activity Log: "
..F I=1:1:$P(@(PSJGLO_","_0_")"),U,4) D
...W !?9,"Date: ",$$FMTE^XLFDT($P(@(PSJGLO_","_I_","_1_")"),U,1)),?35,"User: ",$P(@(PSJGLO_","_I_","_1_")"),U,2)
...W !?5,"Activity: ",$P(@(PSJGLO_","_I_","_1_")"),U,4)
...I $D(@(PSJGLO_","_I_","_2_")")) W !?8,"Field: ",$P(@(PSJGLO_","_I_","_1_")"),U,3),!?5,"Old Data: ",@(PSJGLO_","_I_","_2_")")
...I $D(@(PSJGLO_","_I_","_3_")")) W !?7,"Reason: ",@(PSJGLO_","_I_","_3_")")
...W !
W !!
D CLEAN^PSBVT K @(PSJGLO_")")
Q
PSBODO ;BIRMINGHAM/EFC-BCMA UNIT DOSE VIRTUAL DUE LIST FUNCTIONS ;Mar 2004
+1 ;;3.0;BAR CODE MED ADMIN;**5,21,24,38**;Mar 2004;Build 8
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; Reference/IA
+5 ; EN^PSJBCMA2/2830
EN ;
+1 ;
+2 ; Description:
+3 ; Returns a display for a selected order when double clicked on the VDL
+4 ;
+5 NEW PSBGBL,DFN
+6 SET PSBGBL=$NAME(^TMP("PSBO",$JOB,"B"))
+7 FOR
SET PSBGBL=$QUERY(@PSBGBL)
IF PSBGBL=""
QUIT
IF $QSUBSCRIPT(PSBGBL,2)'=$JOB
QUIT
IF $QSUBSCRIPT(PSBGBL,1)'["PSBO"
QUIT
Begin DoDot:1
+8 SET DFN=$QSUBSCRIPT(PSBGBL,5)
+9 DO DISPORD
End DoDot:1
+10 QUIT
+11 ;
DISPORD ;
+1 NEW PSBGBL,PSBOI,PSBHDR,PSJGLO
+2 SET PSBOI=$$GET1^DIQ(53.69,PSBRPT_",",.09)
+3 DO EN^PSJBCMA2(DFN,PSBOI)
+4 SET PSJGLO="^TMP(""PSJ"""_","_$JOB
+5 DO CLEAN^PSBVT
+6 DO PSJ1^PSBVT(DFN,PSBOI)
+7 SET PSBHDR(1)="BCMA - Display Order"
DO PT^PSBOHDR(DFN,.PSBHDR)
WRITE !
+8 IF '$GET(PSBONX)
WRITE !,"Invalid Order"
+9 IF $GET(PSBONX)
Begin DoDot:1
+10 WRITE !,"Orderable Item: ",PSBOITX
+11 IF PSBONX["V"
WRITE !,"Infusion Rate: ",PSBIFR
+12 IF PSBONX'["V"
WRITE !,"Dosage Ordered: ",PSBDOSE
+13 WRITE ?40,"Start: ",PSBOSTX
+14 WRITE !?40,"Stop: ",PSBOSPX
+15 WRITE !,"Med Route: ",PSBMR
+16 WRITE !,"Schedule Type: ",PSBSCHTX
+17 IF PSBONX'["V"
WRITE ?40,"Self Med: ",PSBSMX
+18 IF PSBSM
WRITE !?40,"Hosp Sup: ",PSBSMX
+19 IF PSBSCH'=""
WRITE !,"Schedule: ",PSBSCH
+20 IF PSBONX'["V"
WRITE !,"Admin Times: ",PSBADST
+21 IF PSBONX["V"
IF ((PSBIVT="P")!(PSBISYR=1))
WRITE !,"Admin Times: ",PSBADST
+22 WRITE !,"Provider: ",PSBMDX
+23 IF $EXTRACT(PSBOTXT,1)="!"
SET $EXTRACT(PSBOTXT,1)=""
+24 WRITE !,"Spec Inst: ",PSBOTXT
+25 WRITE !
+26 IF $DATA(PSBDDA(1))
Begin DoDot:2
+27 WRITE !,"Dispense Drugs",!,"Drug Name",?40,"Units",?50,"Inactive Date"
+28 WRITE !,$TRANSLATE($JUSTIFY("",75)," ","-")
+29 FOR Y=0:0
SET Y=$ORDER(PSBDDA(Y))
IF 'Y
QUIT
Begin DoDot:3
+30 SET X=$PIECE(PSBDDA(Y),U,4)
+31 WRITE !,$PIECE(PSBDDA(Y),U,3),?40,$SELECT(X]"":X,1:1)
+32 SET X=$PIECE(PSBDDA(Y),U,5)
IF 'X
QUIT
+33 WRITE ?50,$EXTRACT(X,4,5),"/",$EXTRACT(X,6,7),"/",(1700+$EXTRACT(X,1,3))
End DoDot:3
End DoDot:2
+34 IF $DATA(PSBADA(1))
Begin DoDot:2
+35 WRITE !!,"Additives",!,"Name",?40,"Strength"
+36 WRITE !,$TRANSLATE($JUSTIFY("",75)," ","-")
+37 FOR Y=0:0
SET Y=$ORDER(PSBADA(Y))
IF 'Y
QUIT
Begin DoDot:3
+38 WRITE !,$PIECE(PSBADA(Y),U,3),?40,$PIECE(PSBADA(Y),U,4)
End DoDot:3
End DoDot:2
+39 IF $DATA(PSBSOLA(1))
Begin DoDot:2
+40 WRITE !!,"Solution",!,"Name",?40,"Volume"
+41 WRITE !,$TRANSLATE($JUSTIFY("",75)," ","-")
+42 FOR Y=0:0
SET Y=$ORDER(PSBSOLA(Y))
IF 'Y
QUIT
Begin DoDot:3
+43 WRITE !,$PIECE(PSBSOLA(Y),U,3),?40,$PIECE(PSBSOLA(Y),U,4)
End DoDot:3
End DoDot:2
+44 IF $PIECE(@(PSJGLO_","_0_")"),U,1)'=-1
Begin DoDot:2
+45 WRITE !,$TRANSLATE($JUSTIFY("",75)," ","-")
+46 WRITE !,"Pharmacy Activity Log: "
+47 FOR I=1:1:$PIECE(@(PSJGLO_","_0_")"),U,4)
Begin DoDot:3
+48 WRITE !?9,"Date: ",$$FMTE^XLFDT($PIECE(@(PSJGLO_","_I_","_1_")"),U,1)),?35,"User: ",$PIECE(@(PSJGLO_","_I_","_1_")"),U,2)
+49 WRITE !?5,"Activity: ",$PIECE(@(PSJGLO_","_I_","_1_")"),U,4)
+50 IF $DATA(@(PSJGLO_","_I_","_2_")"))
WRITE !?8,"Field: ",$PIECE(@(PSJGLO_","_I_","_1_")"),U,3),!?5,"Old Data: ",@(PSJGLO_","_I_","_2_")")
+51 IF $DATA(@(PSJGLO_","_I_","_3_")"))
WRITE !?7,"Reason: ",@(PSJGLO_","_I_","_3_")")
+52 WRITE !
End DoDot:3
End DoDot:2
End DoDot:1
+53 WRITE !!
+54 DO CLEAN^PSBVT
KILL @(PSJGLO_")")
+55 QUIT
