PSIVAOR1.m

PSIVAOR1 ;BIR/PR-PRINT ACT/DC ORDER RPT BY WD/DRG ;16 DEC 97 / 1:39 PM 

 ;;5.0; INPATIENT MEDICATIONS ;**31**;16 DEC 97

 ;

 ; Reference to ^PS(55 is supported by DBIA 2191

 ; Reference to ^PS(52.6 is supported by DBIA 1231

 ; Reference to ^PS(52.7 is supported by DBIA 2173

 ;

P1 ;Print IV room

 F IV=0:0 D F S IV=$O(^TMP("PSJ",$J,IV)) Q:'IV  W !!,"IV ROOM: ",$S($D(^PS(59.5,IV,0)):$P(^(0),U),1:"Broken pointer??") D P2

 Q

P2 ;Print out ward

 S WD="" F P2=0:0 D F S WD=$O(^TMP("PSJ",$J,IV,WD)) Q:WD=""  W !!?1,"WARD: ",WD D P3

 Q

P3 ;Print out patient

 S PAT="" F P3=0:0 D F S PAT=$O(^TMP("PSJ",$J,IV,WD,PAT)) Q:PAT=""  S DFN=$P(PAT,U,2),ON="" W !!,?4,$P(PAT,U)," ",$P(PAT,U,3)," ",$P(PAT,U,4) D P4

 Q

P4 ;Print order number

 F Q=0:0 D F S ON=$O(^TMP("PSJ",$J,IV,WD,PAT,ON)) Q:ON=""  W !!?7,"[",+ON,"]     ",$P(ON,U,2) S G=^PS(55,DFN,"IV",+ON,0) D P40 S Y=$P(G,U,3),P6=$P(G,U,6) X ^DD("DD") S P6=$S($D(^VA(200,P6,0)):$P(^(0),U),1:"?") W ?35,Y,?60,$E(P6,1,20) D P5

 Q

P40 ;Print ONCALL or HOLD

 I "HO"[$P(G,U,17) W $S($P(G,U,17)="H":"  (*ON HOLD*)",1:"  (*ON CALL*)")

 Q

P5 ;Print out order contents

 F P5=0:0 D F S P5=$O(^PS(55,DFN,"IV",+ON,"AD",P5)) Q:'P5  I $D(^(P5,0)) S NA=^(0) W !,?9,$P(^PS(52.6,+NA,0),U)," ",$P(NA,U,2)

 F P5=0:0 D F S P5=$O(^PS(55,DFN,"IV",+ON,"SOL",P5)) Q:'P5  I $D(^(P5,0)) S NA=^(0) W !?9,$P(^PS(52.7,+NA,0),U)," ",$P(NA,U,2)

 D F W !?9,$P(^PS(55,DFN,"IV",+ON,0),U,8) I $P(^(0),U,9)'="" D F W !?9,$P(^(0),U,9)," ",$P(^(0),U,11)

 D F W !?9,"Cumulative doses: ",$S($D(^PS(55,DFN,"IV",+ON,9)):+$P(^(9),U,3),1:0)

 I XREF="ADC" D F S Y=$S($D(^PS(55,DFN,"IV",+ON,"ADC")):^("ADC"),1:"NF") I Y X ^DD("DD") W !?9,"Last DC'd on: ",Y

 ;

 Q

F I $Y+5>IOSL D H^PSIVAOR

 Q

PSIVAOR1  ;BIR/PR-PRINT ACT/DC ORDER RPT BY WD/DRG ;16 DEC 97 / 1:39 PM 

 +1       ;;5.0; INPATIENT MEDICATIONS ;**31**;16 DEC 97

 +2       ;

 +3       ; Reference to ^PS(55 is supported by DBIA 2191

 +4       ; Reference to ^PS(52.6 is supported by DBIA 1231

 +5       ; Reference to ^PS(52.7 is supported by DBIA 2173

 +6       ;

P1        ;Print IV room

 +1        FOR IV=0:0

               DO F

               SET IV=$ORDER(^TMP("PSJ",$JOB,IV))

               IF 'IV

                   QUIT 

               WRITE !!,"IV ROOM: ",$SELECT($DATA(^PS(59.5,IV,0)):$PIECE(^(0),U),1:"Broken pointer??")

               DO P2

 +2        QUIT 

P2        ;Print out ward

 +1        SET WD=""

           FOR P2=0:0

               DO F

               SET WD=$ORDER(^TMP("PSJ",$JOB,IV,WD))

               IF WD=""

                   QUIT 

               WRITE !!?1,"WARD: ",WD

               DO P3

 +2        QUIT 

P3        ;Print out patient

 +1        SET PAT=""

           FOR P3=0:0

               DO F

               SET PAT=$ORDER(^TMP("PSJ",$JOB,IV,WD,PAT))

               IF PAT=""

                   QUIT 

               SET DFN=$PIECE(PAT,U,2)

               SET ON=""

               WRITE !!,?4,$PIECE(PAT,U)," ",$PIECE(PAT,U,3)," ",$PIECE(PAT,U,4)

               DO P4

 +2        QUIT 

P4        ;Print order number

 +1        FOR Q=0:0

               DO F

               SET ON=$ORDER(^TMP("PSJ",$JOB,IV,WD,PAT,ON))

               IF ON=""

                   QUIT 

               WRITE !!?7,"[",+ON,"]     ",$PIECE(ON,U,2)

               SET G=^PS(55,DFN,"IV",+ON,0)

               DO P40

               SET Y=$PIECE(G,U,3)

               SET P6=$PIECE(G,U,6)

               XECUTE ^DD("DD")

               SET P6=$SELECT($DATA(^VA(200,P6,0)):$PIECE(^(0),U),1:"?")

               WRITE ?35,Y,?60,$EXTRACT(P6,1,20)

               DO P5

 +2        QUIT 

P40       ;Print ONCALL or HOLD

 +1        IF "HO"[$PIECE(G,U,17)

               WRITE $SELECT($PIECE(G,U,17)="H":"  (*ON HOLD*)",1:"  (*ON CALL*)")

 +2        QUIT 

P5        ;Print out order contents

 +1        FOR P5=0:0

               DO F

               SET P5=$ORDER(^PS(55,DFN,"IV",+ON,"AD",P5))

               IF 'P5

                   QUIT 

               IF $DATA(^(P5,0))

                   SET NA=^(0)

                   WRITE !,?9,$PIECE(^PS(52.6,+NA,0),U)," ",$PIECE(NA,U,2)

 +2        FOR P5=0:0

               DO F

               SET P5=$ORDER(^PS(55,DFN,"IV",+ON,"SOL",P5))

               IF 'P5

                   QUIT 

               IF $DATA(^(P5,0))

                   SET NA=^(0)

                   WRITE !?9,$PIECE(^PS(52.7,+NA,0),U)," ",$PIECE(NA,U,2)

 +3        DO F

           WRITE !?9,$PIECE(^PS(55,DFN,"IV",+ON,0),U,8)

           IF $PIECE(^(0),U,9)'=""

               DO F

               WRITE !?9,$PIECE(^(0),U,9)," ",$PIECE(^(0),U,11)

 +4        DO F

           WRITE !?9,"Cumulative doses: ",$SELECT($DATA(^PS(55,DFN,"IV",+ON,9)):+$PIECE(^(9),U,3),1:0)

 +5        IF XREF="ADC"

               DO F

               SET Y=$SELECT($DATA(^PS(55,DFN,"IV",+ON,"ADC")):^("ADC"),1:"NF")

               IF Y

                   XECUTE ^DD("DD")

                   WRITE !?9,"Last DC'd on: ",Y

 +6       ;

 +7        QUIT 

F          IF $Y+5>IOSL

               DO H^PSIVAOR

 +1        QUIT