PSJINHIS ;BIR/MLM-PRINT HISTORY LOG ;23 SEP 97 / 1:10 PM
;;5.0;INPATIENT MEDICATIONS;**267**;16 DEC 97;Build 158
;
; 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.
N POP,X,ZTIO,ZTRTN
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^PSJINHIS" 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,PSJCHTO,PSJPR,PSJPRCOM,TMPTO,PN,PSJHDRF,%,ZTREQ,ZTQUEUED S PN=0
S PSJCHTO="" 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) I $G(PSJORD) N PSGORD S PSGORD=PSJORD D EN0^PSJINVW(1,.PSJCHTO) G K
S:'PSJOLD PSJOLD=PSJHON F S ON=PSJOLD D RELATE Q:PSJOLD=""
F D DISPLAY,RELATE S ON=PSJNEW Q:PSJNEW=""!$D(DONE)
;
K ; Kill and exit.
K DFN,PSJHON,PSJHT,TMPTO
W:$G(PSJPTR)&($Y) @IOF S:$D(ZTQUEUED) ZTREQ="@" D ^%ZISC
W !!
Q
;
DISPLAY ; Display order.
S PSGORD=ON N PSJLM D EN0^PSJINVW(1,.PSJCHTO)
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) I PSJNEW=ON S PSJNEW=""
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[HPSJINHIS 2141 printed Sep 23, 2025@19:43:18 Page 2
PSJINHIS ;BIR/MLM-PRINT HISTORY LOG ;23 SEP 97 / 1:10 PM
+1 ;;5.0;INPATIENT MEDICATIONS;**267**;16 DEC 97;Build 158
+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 NEW POP,X,ZTIO,ZTRTN
+2 WRITE !
KILL IO("Q"),%ZIS,IOP
SET %ZIS="QM"
DO ^%ZIS
IF POP
WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED"
GOTO K
+3 if '$DATA(IO("Q"))
GOTO DEQ
KILL IO("Q"),ZTDTH,ZTSAVE,ZTSK
SET ZTIO=ION
SET ZTRTN="DEQ^PSJINHIS"
FOR X="DFN","PSJHON","PSJHT","PSJORD","PSJSYSU","PSJSYSP"
SET ZTSAVE(X)=""
SET ZTDESC="INPATIENT HISTORY LOG"
+4 DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !,"Queued."
+5 DO HOME^%ZIS
+6 QUIT
+7 ;
DEQ ; Entry from queue.
+1 NEW DIR,DONE,DTOUT,DUOUT,HDT,ON,ON55,P,PG,PPAGE,PSGORD,PSIVAC,PSJACNWP,PSJNEW,PSJPTR,UL80,PSJCHTO,PSJPR,PSJPRCOM,TMPTO,PN,PSJHDRF,%,ZTREQ,ZTQUEUED
SET PN=0
+2 SET PSJCHTO=""
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)
IF $GET(PSJORD)
NEW PSGORD
SET PSGORD=PSJORD
DO EN0^PSJINVW(1,.PSJCHTO)
GOTO K
+4 if 'PSJOLD
SET PSJOLD=PSJHON
FOR
SET ON=PSJOLD
DO RELATE
if PSJOLD=""
QUIT
+5 FOR
DO DISPLAY
DO RELATE
SET ON=PSJNEW
if PSJNEW=""!$DATA(DONE)
QUIT
+6 ;
K ; Kill and exit.
+1 KILL DFN,PSJHON,PSJHT,TMPTO
+2 if $GET(PSJPTR)&($Y)
WRITE @IOF
if $DATA(ZTQUEUED)
SET ZTREQ="@"
DO ^%ZISC
+3 WRITE !!
+4 QUIT
+5 ;
DISPLAY ; Display order.
+1 SET PSGORD=ON
NEW PSJLM
DO EN0^PSJINVW(1,.PSJCHTO)
+2 QUIT
+3 ;
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)
IF PSJNEW=ON
SET PSJNEW=""
+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
