Routine: PSJHIS

PSJHIS ;BIR/MLM-PRINT HISTORY LOG ;23 SEP 97 / 1:10 PM

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

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

 ; Reference to ^%ZTLOAD is supported by DBIA 10063.

 ; Reference to ^%DTC is supported by DBIA 10000.

 ; Reference to ^%ZIS is supported by DBIA 10086.

 ; Reference to ^%ZISC is supported by DBIA 10089.

 ; Reference to ^DIR is supported by DBIA 10026.

ENHIS(DFN,PSJHON,PSJHT) ; History log from beginning.

 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 IO("Q"),ZTDTH,ZTSAVE,ZTSK S ZTIO=ION,ZTRTN="DEQ^PSJHIS" F X="DFN","PSJHON","PSJHT","PSJORD","PSJSYSU","PSJSYSP" S ZTSAVE(X)="",ZTDESC="INPATIENT HISTORY LOG"

 D ^%ZTLOAD W:$D(ZTSK) !,"Queued."

 D HOME^%ZIS

DEQ ; Entry from queue.

 N DIR,DONE,DTOUT,DUOUT,HDT,ON,ON55,P,PG,PPAGE,PSGORD,PSIVAC,PSJACNWP,PSJNEW,PSJPTR,UL80

 S PSGP=DFN,PSJACNWP=1 D ENBOTH^PSJAC,NOW^%DTC S UL80="",$P(UL80,"-",80)="",HDT=$$ENDTC^PSGMI(%),PSJPTR=$E(IOST)'="C",PG=0,ON=PSJHON,PSIVAC="PH" U IO

 D RELATE,ENHEAD:PSJPTR W:'PSJPTR&($Y) @IOF I '$L(PSJOLD_PSJNEW) W !!,?27,"No History Log to Report." G K

 S:'PSJOLD PSJOLD=PSJHON F  S ON=PSJOLD D RELATE Q:PSJOLD=""

 F  D DISPLAY,PAUSE:'PSJPTR,RELATE S ON=PSJNEW Q:PSJNEW=""!$D(DONE)

K ; Kill and exit.

 K DFN,PSJHON,PSJHT

 W:$G(PSJPTR)&($Y) @IOF S:$D(ZTQUEUED) ZTREQ="@" D ^%ZISC

DISPLAY ; Display order.

 I ON["V" S (ON55,PSJORD)=ON D GT55^PSIVORFB,ENNH^PSIVORV2(ON) Q

 I ON["P",($P($G(^PS(53.1,+ON,0)),U,4)="F"!(PSJHT="V")) D GT531^PSIVORFA(DFN,ON),ENNH^PSIVORV2(ON) Q

 S PSGORD=ON N PSJLM D EN2^PSGVW

PAUSE ; Hold screen.

 K DIR S DIR(0)="E" D ^DIR S:$D(DTOUT)!($D(DUOUT)) DONE=1

RELATE ; Get related order.

 I ON["U"!(ON["A")!(ON["O") S PSJOLD=$P($G(^PS(55,DFN,5,+ON,0)),U,25),PSJNEW=$P($G(^(0)),U,26) Q

 I ON["V" S PSJOLD=$P($G(^PS(55,DFN,"IV",+ON,2)),U,5),PSJNEW=$P($G(^(2)),U,6) Q

 S PSJOLD=$P($G(^PS(53.1,+ON,0)),U,25),PSJNEW=$P($G(^(0)),U,26)

ENHEAD ; Header for Inpatient History log.

 S PPAGE=0 NEW PSJNEW D ENTRY^PSJHEAD(PSGP,0,0,0,0)

PSJHIS    ;BIR/MLM-PRINT HISTORY LOG ;23 SEP 97 / 1:10 PM

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

 +2       ;

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

 +4       ; Reference to ^%ZTLOAD is supported by DBIA 10063.

 +5       ; Reference to ^%DTC is supported by DBIA 10000.

 +6       ; Reference to ^%ZIS is supported by DBIA 10086.

 +7       ; Reference to ^%ZISC is supported by DBIA 10089.

 +8       ; Reference to ^DIR is supported by DBIA 10026.

 +9       ;

ENHIS(DFN,PSJHON,PSJHT) ; History log from beginning.

 +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 IO("Q"),ZTDTH,ZTSAVE,ZTSK

           SET ZTIO=ION

           SET ZTRTN="DEQ^PSJHIS"

           FOR X="DFN","PSJHON","PSJHT","PSJORD","PSJSYSU","PSJSYSP"

               SET ZTSAVE(X)=""

               SET ZTDESC="INPATIENT HISTORY LOG"

 +3        DO ^%ZTLOAD

           IF $DATA(ZTSK)

               WRITE !,"Queued."

 +4        DO HOME^%ZIS

 +5        QUIT

 +6       ;

DEQ       ; Entry from queue.

 +1        NEW DIR,DONE,DTOUT,DUOUT,HDT,ON,ON55,P,PG,PPAGE,PSGORD,PSIVAC,PSJACNWP,PSJNEW,PSJPTR,UL80

 +2        SET PSGP=DFN

           SET PSJACNWP=1

           DO ENBOTH^PSJAC

           DO NOW^%DTC

           SET UL80=""

           SET $PIECE(UL80,"-",80)=""

           SET HDT=$$ENDTC^PSGMI(%)

           SET PSJPTR=$EXTRACT(IOST)'="C"

           SET PG=0

           SET ON=PSJHON

           SET PSIVAC="PH"

           USE IO

 +3        DO RELATE

           IF PSJPTR

               DO ENHEAD

           IF 'PSJPTR&($Y)

               WRITE @IOF

           IF '$LENGTH(PSJOLD_PSJNEW)

               WRITE !!,?27,"No History Log to Report."

               GOTO K

 +4        IF 'PSJOLD

               SET PSJOLD=PSJHON

FOR

               SET ON=PSJOLD

               DO RELATE

               IF PSJOLD=""

                   QUIT

 +5        FOR

               DO DISPLAY

               IF 'PSJPTR

                   DO PAUSE

               DO RELATE

               SET ON=PSJNEW

               IF PSJNEW=""!$DATA(DONE)

                   QUIT

 +6       ;

K         ; Kill and exit.

 +1        KILL DFN,PSJHON,PSJHT

 +2        IF $GET(PSJPTR)&($Y)

               WRITE @IOF

           IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

           DO ^%ZISC

 +3        QUIT

 +4       ;

DISPLAY   ; Display order.

 +1        IF ON["V"

               SET (ON55,PSJORD)=ON

               DO GT55^PSIVORFB

               DO ENNH^PSIVORV2(ON)

               QUIT

 +2        IF ON["P"

               IF ($PIECE($GET(^PS(53.1,+ON,0)),U,4)="F"!(PSJHT="V"))

                   DO GT531^PSIVORFA(DFN,ON)

                   DO ENNH^PSIVORV2(ON)

                   QUIT

 +3        SET PSGORD=ON

           NEW PSJLM

           DO EN2^PSGVW

 +4        QUIT

 +5       ;

PAUSE     ; Hold screen.

 +1        KILL DIR

           SET DIR(0)="E"

           DO ^DIR

           IF $DATA(DTOUT)!($DATA(DUOUT))

               SET DONE=1

 +2        QUIT

RELATE    ; Get related order.

 +1        IF ON["U"!(ON["A")!(ON["O")

               SET PSJOLD=$PIECE($GET(^PS(55,DFN,5,+ON,0)),U,25)

               SET PSJNEW=$PIECE($GET(^(0)),U,26)

               QUIT

 +2        IF ON["V"

               SET PSJOLD=$PIECE($GET(^PS(55,DFN,"IV",+ON,2)),U,5)

               SET PSJNEW=$PIECE($GET(^(2)),U,6)

               QUIT

 +3        SET PSJOLD=$PIECE($GET(^PS(53.1,+ON,0)),U,25)

           SET PSJNEW=$PIECE($GET(^(0)),U,26)

 +4        QUIT

 +5       ;

ENHEAD    ; Header for Inpatient History log.

 +1        SET PPAGE=0

           NEW PSJNEW

           DO ENTRY^PSJHEAD(PSGP,0,0,0,0)

 +2        QUIT

PSJHIS.m