- 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
