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
Q
;
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
Q
;
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
Q
;
PAUSE ; Hold screen.
K DIR S DIR(0)="E" D ^DIR S:$D(DTOUT)!($D(DUOUT)) DONE=1
Q
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)
Q
;
ENHEAD ; Header for Inpatient History log.
S PPAGE=0 NEW PSJNEW D ENTRY^PSJHEAD(PSGP,0,0,0,0)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJHIS 2134 printed Oct 16, 2024@18:07:40 Page 2
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
