- 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
