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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVAOR1 1717 printed Oct 16, 2024@18:04:39 Page 2
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
