- 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 Mar 13, 2025@21:09 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
