PSIVHIS ;BIR/MLM-PRINT HISTORY LOG ;22 MAY 95 / 12:20 PM
;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
;
SPRINT(DFN,PSIVH) ; History log from beginning.
N DONE,ON,ON55,P,PSIVAC,PSIVOLD,PSIVNEW
S (ON55,ON)=PSIVH,PSIVAC="PH" D RELATE I '$L(PSIVOLD_PSIVNEW) W !,"No History Log to Report." S DIRUT=1 Q
S:'PSIVOLD PSIVOLD=PSIVH
QUE ;Ask device, queue if necessary.
W ! K IO("Q"),%ZIS,IOP S %ZIS="QM" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED" G K
G:'$D(IO("Q")) DEQ K ZTDTH,ZTSAVE,ZTSK S ZTIO=ION,ZTSAVE("PSIVOLD")="",ZTSAVE("DFN")="",ZTDESC="IV HISTORY LOG",ZTRTN="DEQ^PSIVHIS" K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !,"Queued."
Q
;
DEQ ;Entry from queue.
N DONE,DTOUT,DUOUT,ON55,PSIVNEW,PSGP,PSGORD,PSJSYSU
U IO F S ON=PSIVOLD D RELATE Q:PSIVOLD=""
F S (P("PON"),ON55)=ON D DISPLAY,RELATE S ON=PSIVNEW Q:PSIVNEW=""!$D(DONE)
S:$D(ZTQUEUED) ZTREQ="@" D ^%ZISC
;
K ; Kill and exit.
K PSIVOLD W:$E(IOST,1)'="C"&($Y) @IOF
Q
DISPLAY ; Display order.
I ON["A" S PSJSYSU=1,PSGP=DFN,PSGORD=+ON D EN2^PSGVW
I ON'["A" D @$S(ON["V":"GT55^PSIVORFB",1:"GT531^PSIVORFA(DFN,ON)"),ENNONUM^PSIVORV2(DFN,ON)
I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR I $D(DTOUT)!($D(DUOUT)) S DONE=1 Q
Q
RELATE ; Get related order.
I ON["A" S PSIVOLD=$P($G(^PS(55,DFN,5,+ON,0)),U,25),PSIVNEW=$P($G(^(0)),U,26) Q
I ON["V" S PSIVOLD=$P($G(^PS(55,DFN,"IV",+ON,2)),U,5),PSIVNEW=$P($G(^(2)),U,6) Q
S PSIVOLD=$P($G(^PS(53.1,+ON,0)),U,25),PSIVNEW=$P($G(^(0)),U,26)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVHIS 1480 printed Nov 22, 2024@17:14:13 Page 2
PSIVHIS ;BIR/MLM-PRINT HISTORY LOG ;22 MAY 95 / 12:20 PM
+1 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
+2 ;
SPRINT(DFN,PSIVH) ; History log from beginning.
+1 NEW DONE,ON,ON55,P,PSIVAC,PSIVOLD,PSIVNEW
+2 SET (ON55,ON)=PSIVH
SET PSIVAC="PH"
DO RELATE
IF '$LENGTH(PSIVOLD_PSIVNEW)
WRITE !,"No History Log to Report."
SET DIRUT=1
QUIT
+3 if 'PSIVOLD
SET PSIVOLD=PSIVH
QUE ;Ask device, queue if necessary.
+1 WRITE !
KILL IO("Q"),%ZIS,IOP
SET %ZIS="QM"
DO ^%ZIS
IF POP
WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED"
GOTO K
+2 if '$DATA(IO("Q"))
GOTO DEQ
KILL ZTDTH,ZTSAVE,ZTSK
SET ZTIO=ION
SET ZTSAVE("PSIVOLD")=""
SET ZTSAVE("DFN")=""
SET ZTDESC="IV HISTORY LOG"
SET ZTRTN="DEQ^PSIVHIS"
KILL IO("Q")
DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !,"Queued."
+3 QUIT
+4 ;
DEQ ;Entry from queue.
+1 NEW DONE,DTOUT,DUOUT,ON55,PSIVNEW,PSGP,PSGORD,PSJSYSU
+2 USE IO
FOR
SET ON=PSIVOLD
DO RELATE
if PSIVOLD=""
QUIT
+3 FOR
SET (P("PON"),ON55)=ON
DO DISPLAY
DO RELATE
SET ON=PSIVNEW
if PSIVNEW=""!$DATA(DONE)
QUIT
+4 if $DATA(ZTQUEUED)
SET ZTREQ="@"
DO ^%ZISC
+5 ;
K ; Kill and exit.
+1 KILL PSIVOLD
if $EXTRACT(IOST,1)'="C"&($Y)
WRITE @IOF
+2 QUIT
DISPLAY ; Display order.
+1 IF ON["A"
SET PSJSYSU=1
SET PSGP=DFN
SET PSGORD=+ON
DO EN2^PSGVW
+2 IF ON'["A"
DO @$SELECT(ON["V":"GT55^PSIVORFB",1:"GT531^PSIVORFA(DFN,ON)")
DO ENNONUM^PSIVORV2(DFN,ON)
+3 IF $EXTRACT(IOST)="C"
KILL DIR
SET DIR(0)="E"
DO ^DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
SET DONE=1
QUIT
+4 QUIT
RELATE ; Get related order.
+1 IF ON["A"
SET PSIVOLD=$PIECE($GET(^PS(55,DFN,5,+ON,0)),U,25)
SET PSIVNEW=$PIECE($GET(^(0)),U,26)
QUIT
+2 IF ON["V"
SET PSIVOLD=$PIECE($GET(^PS(55,DFN,"IV",+ON,2)),U,5)
SET PSIVNEW=$PIECE($GET(^(2)),U,6)
QUIT
+3 SET PSIVOLD=$PIECE($GET(^PS(53.1,+ON,0)),U,25)
SET PSIVNEW=$PIECE($GET(^(0)),U,26)
+4 QUIT