PSIVPR ;BIR/PR,CML3-PRINT PROFILE REPORT ;16 JUL 97 / 9:49 AM
;;5.0; INPATIENT MEDICATIONS ;**38**;16 DEC 97
K ^TMP("PSIV",$J) N PSJNEW,PSGPTMP,PPAGE S PSJNEW=1
EN ; Entry from option.
N XQUIT D ^PSIVXU Q:$D(XQUIT)
EN1 ; Start here if from OE/RR.
S (PSIVLAB,PSIVLOG,PSIVPR1,PSIVPPR)=0,PSJOL="L"
BEG ;Ask for order view.
F Q=0:0 W !,"View each order in the profile" S %=1 D YN^DICN Q:% S HELP="PRORPT" D ^PSIVHLP
G:%<1 Q I %=2 S NOLOG=1 G PAT
S PSIVPR1=1
;
BEG1 ;Ask for activity log.
F Q=0:0 W !,"View each activity log in the profile" S %=1 D YN^DICN Q:% S HELP="PRORPT1" D ^PSIVHLP1
G:%<1 Q S PSIVLOG=%
;
BEG2 ;
F Q=0:0 W !,"View the label log in the profile" S %=1 D YN^DICN Q:% S HELP="LABLOG" D ^PSIVHLP2
G:%<1 Q S PSIVLAB=%
;
PAT ;Get patient
I '$D(PSIVOEDF) D ENGETP^PSIV G @$S(DFN<0:"Q",PSIVPR=ION:"DEQ",1:"QUEUE")
W ! K IO("Q"),%ZIS,IOP S %ZIS="QM",%ZIS("A")="Select PRINT DEVICE: " D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED" Q
G:'$D(IO("Q")) DEQ
;
QUEUE ;Queue logic.
S ZTIO=$S($D(PSIVOEDF):ION,1:PSIVPR),ZTDESC="IV PATIENT PROFILE REPORT",ZTRTN="DEQ^PSIVPR" F X="NOLOG","PSIVLOG","PSIVLAB","PSIVSN","PSIVSITE","DFN" S ZTSAVE(X)=""
F X="PSIVPR1","PSJSYSW0","PSJSYSU","PSJSYSP","PSJSYSP0","PSGPTMP","PPAGE" S ZTSAVE(X)=""
D ^%ZTLOAD W:$D(ZTSK) !,"Queued." G Q
DEQ ;
;*
NEW SUB3,SUB4,X
S SUB3="" F S SUB3=$O(^TMP("PSIV",$J,SUB3)) Q:SUB3="" F SUB4=0:0 S SUB4=$O(^TMP("PSIV",$J,SUB3,SUB4)) Q:'SUB4 S ^TMP("PSIVSV",$J,SUB3,SUB4)=^TMP("PSIV",$J,SUB3,SUB4)
S X=$G(^TMP("PSJPRO",$J,0)) I X]"" S ^TMP("PSJPROSV",$J,0)=X D
. F SUB3=0:0 S SUB3=$O(^TMP("PSJPRO",$J,SUB3)) Q:'SUB3 S ^TMP("PSJPROSV",$J,SUB3,0)=$G(^TMP("PSJPRO",$J,SUB3,0))
S X=$G(^TMP("PSJI",$J,0)) I X]"" S ^TMP("PSJISV",$J,0)=X D
. F SUB3=0:0 S SUB3=$O(^TMP("PSJI",$J,SUB3)) Q:'SUB3 S ^TMP("PSJISV",$J,SUB3,0)=$G(^TMP("PSJI",$J,SUB3,0))
K PSJDNE D:'$D(VAIN) ENIV^PSJAC S PSGP(0)=VADM(1) D ENNA^PSIVACT,^PSIVPRO G:X="^" Q
D DISPLAY
S PSIVSCR=$E(IOST)="C" ;* D:PSIVSCR PAUSE G:X="^" Q
;* I $D(PSIVPR),PS>0,'$D(PSIVPPR) S PSIVBR="Q" D ASK^PSIV K PSIVBR
I 'PSIVSCR&('$G(NOLOG)) D NOW^%DTC S Y=% W:$Y @IOF W !!,"PATIENT PROFILE REPORT on " D WD
I PSIVPR1 F PRX="AB","NB","XB" F ON1=0:0 S ON1=$O(^TMP("PSIV",$J,PRX,ON1)) Q:'ON1!$D(PSJDNE) S (ON,ON55,P("PON"))=9999999999-^TMP("PSIV",$J,PRX,ON1)_$S(PRX="NB":"P",1:"V") D DEQ1
;
Q W:'$G(PSIVSCR)&($Y) @IOF D ^%ZISC,ENIVKV^PSGSETU S:$D(ZTQUEUED) ZTREQ="@"
K %,%I,J,JJ,OG,COU,L,USER,A,D,DA,DFN,DIC,I,N,NOLOG,N2,ON,P1,KEY,P,P17,PRX,PSQ,Y,PRY,PS,PSIV,PSIVLAB,PSIVLOG,PSIVPR,PSIVPR1,PSIVPPR,PSIVREA,PSIVSCR,PSJDNE,PSJOPC,VAERR
K X,X1,X2,Y,Z,Z1,Z2,ZTSK,ZZ,^TMP("PSIV",$J),^TMP("PSJPRO",$J),^TMP("PSJI",$J)
NEW SUB3,SUB4,X
S SUB3="" F S SUB3=$O(^TMP("PSIVSV",$J,SUB3)) Q:SUB3="" F SUB4=0:0 S SUB4=$O(^TMP("PSIVSV",$J,SUB3,SUB4)) Q:'SUB4 S ^TMP("PSIV",$J,SUB3,SUB4)=$G(^TMP("PSIVSV",$J,SUB3,SUB4))
S X=$G(^TMP("PSJPROSV",$J,0)) I X]"" S ^TMP("PSJPRO",$J,0)=X D
. F SUB3=0:0 S SUB3=$O(^TMP("PSJPROSV",$J,SUB3)) Q:'SUB3 S ^TMP("PSJPRO",$J,SUB3,0)=$G(^TMP("PSJPROSV",$J,SUB3,0))
S X=$G(^TMP("PSJISV",$J,0)) I X]"" S ^TMP("PSJI",$J,0)=X D
. F SUB3=0:0 S SUB3=$O(^TMP("PSJISV",$J,SUB3)) Q:'SUB3 S ^TMP("PSJI",$J,SUB3,0)=$G(^TMP("PSJISV",$J,SUB3,0))
K ^TMP("PSIVSV",$J),^TMP("PSJPROSV",$J),^TMP("PSJISV",$J)
Q
;
DEQ1 ;
D:PSIVSCR PAUSE Q:$D(PSJDNE)
N PSIVAC S PSIVAC="PRO",KEY="",PSJORD=ON D @$S(ON["V":"GT55^PSIVORFB",1:"GT531^PSIVORFA("_DFN_","""_ON_""")"),ENNH^PSIVORV2(ON)
D:PSIVSCR PAUSE Q:$D(PSJDNE) D:PSIVLOG=1 ENLOG^PSIVVW1
;* I ($Y#IOSL)>22,PSIVSCR D PAUSE Q:$D(PSJDNE)
I PSIVLAB=1 D DATA^PSIVLTR1(DFN,+ON),PAUSE:PSIVSCR
Q
;
DISPLAY ;Display the patient's profile.
W:$E(IOST)="C" @IOF
D ENTRY^PSJHEAD(DFN,"IV",0,1,0)
NEW PSIVX F PSIVX=0:0 S PSIVX=$O(^TMP("PSJPRO",$J,PSIVX)) Q:'PSIVX D Q:$D(DUOUT)!$D(DTOUT)
. I +$E(^TMP("PSJPRO",$J,PSIVX,0),1,2),(($Y+4)>IOSL) D
.. I $E(IOST)="C" N DIR,X,Y S DIR(0)="E" D ^DIR W @IOF Q
.. D ENTRY^PSJHEAD(DFN,"IV",0,1,0) W !,!,^TMP("PSJPRO",$J,1,0),!
. W !,^TMP("PSJPRO",$J,PSIVX,0)
Q
;
WD X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2) Q
;
ENOR S DFN=+ORVP
ENLM ;* S PSIVOEDF=1 D ENCV^PSGSETU,EN1 K PSIVOEDF,J,N2,ORIFN,P17 D READ^PSJUTL
S PSIVOEDF=1 D ENCV^PSGSETU,EN1 K PSIVOEDF,J,N2,ORIFN,P17
Q
PAUSE ;
K DIR S DIR(0)="E" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S PSJDNE=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVPR 4382 printed Sep 23, 2025@19:40:59 Page 2
PSIVPR ;BIR/PR,CML3-PRINT PROFILE REPORT ;16 JUL 97 / 9:49 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;**38**;16 DEC 97
+2 KILL ^TMP("PSIV",$JOB)
NEW PSJNEW,PSGPTMP,PPAGE
SET PSJNEW=1
EN ; Entry from option.
+1 NEW XQUIT
DO ^PSIVXU
if $DATA(XQUIT)
QUIT
EN1 ; Start here if from OE/RR.
+1 SET (PSIVLAB,PSIVLOG,PSIVPR1,PSIVPPR)=0
SET PSJOL="L"
BEG ;Ask for order view.
+1 FOR Q=0:0
WRITE !,"View each order in the profile"
SET %=1
DO YN^DICN
if %
QUIT
SET HELP="PRORPT"
DO ^PSIVHLP
+2 if %<1
GOTO Q
IF %=2
SET NOLOG=1
GOTO PAT
+3 SET PSIVPR1=1
+4 ;
BEG1 ;Ask for activity log.
+1 FOR Q=0:0
WRITE !,"View each activity log in the profile"
SET %=1
DO YN^DICN
if %
QUIT
SET HELP="PRORPT1"
DO ^PSIVHLP1
+2 if %<1
GOTO Q
SET PSIVLOG=%
+3 ;
BEG2 ;
+1 FOR Q=0:0
WRITE !,"View the label log in the profile"
SET %=1
DO YN^DICN
if %
QUIT
SET HELP="LABLOG"
DO ^PSIVHLP2
+2 if %<1
GOTO Q
SET PSIVLAB=%
+3 ;
PAT ;Get patient
+1 IF '$DATA(PSIVOEDF)
DO ENGETP^PSIV
GOTO @$SELECT(DFN<0:"Q",PSIVPR=ION:"DEQ",1:"QUEUE")
+2 WRITE !
KILL IO("Q"),%ZIS,IOP
SET %ZIS="QM"
SET %ZIS("A")="Select PRINT DEVICE: "
DO ^%ZIS
IF POP
WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED"
QUIT
+3 if '$DATA(IO("Q"))
GOTO DEQ
+4 ;
QUEUE ;Queue logic.
+1 SET ZTIO=$SELECT($DATA(PSIVOEDF):ION,1:PSIVPR)
SET ZTDESC="IV PATIENT PROFILE REPORT"
SET ZTRTN="DEQ^PSIVPR"
FOR X="NOLOG","PSIVLOG","PSIVLAB","PSIVSN","PSIVSITE","DFN"
SET ZTSAVE(X)=""
+2 FOR X="PSIVPR1","PSJSYSW0","PSJSYSU","PSJSYSP","PSJSYSP0","PSGPTMP","PPAGE"
SET ZTSAVE(X)=""
+3 DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !,"Queued."
GOTO Q
DEQ ;
+1 ;*
+2 NEW SUB3,SUB4,X
+3 SET SUB3=""
FOR
SET SUB3=$ORDER(^TMP("PSIV",$JOB,SUB3))
if SUB3=""
QUIT
FOR SUB4=0:0
SET SUB4=$ORDER(^TMP("PSIV",$JOB,SUB3,SUB4))
if 'SUB4
QUIT
SET ^TMP("PSIVSV",$JOB,SUB3,SUB4)=^TMP("PSIV",$JOB,SUB3,SUB4)
+4 SET X=$GET(^TMP("PSJPRO",$JOB,0))
IF X]""
SET ^TMP("PSJPROSV",$JOB,0)=X
Begin DoDot:1
+5 FOR SUB3=0:0
SET SUB3=$ORDER(^TMP("PSJPRO",$JOB,SUB3))
if 'SUB3
QUIT
SET ^TMP("PSJPROSV",$JOB,SUB3,0)=$GET(^TMP("PSJPRO",$JOB,SUB3,0))
End DoDot:1
+6 SET X=$GET(^TMP("PSJI",$JOB,0))
IF X]""
SET ^TMP("PSJISV",$JOB,0)=X
Begin DoDot:1
+7 FOR SUB3=0:0
SET SUB3=$ORDER(^TMP("PSJI",$JOB,SUB3))
if 'SUB3
QUIT
SET ^TMP("PSJISV",$JOB,SUB3,0)=$GET(^TMP("PSJI",$JOB,SUB3,0))
End DoDot:1
+8 KILL PSJDNE
if '$DATA(VAIN)
DO ENIV^PSJAC
SET PSGP(0)=VADM(1)
DO ENNA^PSIVACT
DO ^PSIVPRO
if X="^"
GOTO Q
+9 DO DISPLAY
+10 ;* D:PSIVSCR PAUSE G:X="^" Q
SET PSIVSCR=$EXTRACT(IOST)="C"
+11 ;* I $D(PSIVPR),PS>0,'$D(PSIVPPR) S PSIVBR="Q" D ASK^PSIV K PSIVBR
+12 IF 'PSIVSCR&('$GET(NOLOG))
DO NOW^%DTC
SET Y=%
if $Y
WRITE @IOF
WRITE !!,"PATIENT PROFILE REPORT on "
DO WD
+13 IF PSIVPR1
FOR PRX="AB","NB","XB"
FOR ON1=0:0
SET ON1=$ORDER(^TMP("PSIV",$JOB,PRX,ON1))
if 'ON1!$DATA(PSJDNE)
QUIT
SET (ON,ON55,P("PON"))=9999999999-^TMP("PSIV",$JOB,PRX,ON1)_$SELECT(PRX="NB":"P",1:"V")
DO DEQ1
+14 ;
Q if '$GET(PSIVSCR)&($Y)
WRITE @IOF
DO ^%ZISC
DO ENIVKV^PSGSETU
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+1 KILL %,%I,J,JJ,OG,COU,L,USER,A,D,DA,DFN,DIC,I,N,NOLOG,N2,ON,P1,KEY,P,P17,PRX,PSQ,Y,PRY,PS,PSIV,PSIVLAB,PSIVLOG,PSIVPR,PSIVPR1,PSIVPPR,PSIVREA,PSIVSCR,PSJDNE,PSJOPC,VAERR
+2 KILL X,X1,X2,Y,Z,Z1,Z2,ZTSK,ZZ,^TMP("PSIV",$JOB),^TMP("PSJPRO",$JOB),^TMP("PSJI",$JOB)
+3 NEW SUB3,SUB4,X
+4 SET SUB3=""
FOR
SET SUB3=$ORDER(^TMP("PSIVSV",$JOB,SUB3))
if SUB3=""
QUIT
FOR SUB4=0:0
SET SUB4=$ORDER(^TMP("PSIVSV",$JOB,SUB3,SUB4))
if 'SUB4
QUIT
SET ^TMP("PSIV",$JOB,SUB3,SUB4)=$GET(^TMP("PSIVSV",$JOB,SUB3,SUB4))
+5 SET X=$GET(^TMP("PSJPROSV",$JOB,0))
IF X]""
SET ^TMP("PSJPRO",$JOB,0)=X
Begin DoDot:1
+6 FOR SUB3=0:0
SET SUB3=$ORDER(^TMP("PSJPROSV",$JOB,SUB3))
if 'SUB3
QUIT
SET ^TMP("PSJPRO",$JOB,SUB3,0)=$GET(^TMP("PSJPROSV",$JOB,SUB3,0))
End DoDot:1
+7 SET X=$GET(^TMP("PSJISV",$JOB,0))
IF X]""
SET ^TMP("PSJI",$JOB,0)=X
Begin DoDot:1
+8 FOR SUB3=0:0
SET SUB3=$ORDER(^TMP("PSJISV",$JOB,SUB3))
if 'SUB3
QUIT
SET ^TMP("PSJI",$JOB,SUB3,0)=$GET(^TMP("PSJISV",$JOB,SUB3,0))
End DoDot:1
+9 KILL ^TMP("PSIVSV",$JOB),^TMP("PSJPROSV",$JOB),^TMP("PSJISV",$JOB)
+10 QUIT
+11 ;
DEQ1 ;
+1 if PSIVSCR
DO PAUSE
if $DATA(PSJDNE)
QUIT
+2 NEW PSIVAC
SET PSIVAC="PRO"
SET KEY=""
SET PSJORD=ON
DO @$SELECT(ON["V":"GT55^PSIVORFB",1:"GT531^PSIVORFA("_DFN_","""_ON_""")")
DO ENNH^PSIVORV2(ON)
+3 if PSIVSCR
DO PAUSE
if $DATA(PSJDNE)
QUIT
if PSIVLOG=1
DO ENLOG^PSIVVW1
+4 ;* I ($Y#IOSL)>22,PSIVSCR D PAUSE Q:$D(PSJDNE)
+5 IF PSIVLAB=1
DO DATA^PSIVLTR1(DFN,+ON)
if PSIVSCR
DO PAUSE
+6 QUIT
+7 ;
DISPLAY ;Display the patient's profile.
+1 if $EXTRACT(IOST)="C"
WRITE @IOF
+2 DO ENTRY^PSJHEAD(DFN,"IV",0,1,0)
+3 NEW PSIVX
FOR PSIVX=0:0
SET PSIVX=$ORDER(^TMP("PSJPRO",$JOB,PSIVX))
if 'PSIVX
QUIT
Begin DoDot:1
+4 IF +$EXTRACT(^TMP("PSJPRO",$JOB,PSIVX,0),1,2)
IF (($Y+4)>IOSL)
Begin DoDot:2
+5 IF $EXTRACT(IOST)="C"
NEW DIR,X,Y
SET DIR(0)="E"
DO ^DIR
WRITE @IOF
QUIT
+6 DO ENTRY^PSJHEAD(DFN,"IV",0,1,0)
WRITE !,!,^TMP("PSJPRO",$JOB,1,0),!
End DoDot:2
+7 WRITE !,^TMP("PSJPRO",$JOB,PSIVX,0)
End DoDot:1
if $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+8 QUIT
+9 ;
WD XECUTE ^DD("DD")
WRITE $PIECE(Y,"@")," ",$PIECE(Y,"@",2)
QUIT
+1 ;
ENOR SET DFN=+ORVP
ENLM ;* S PSIVOEDF=1 D ENCV^PSGSETU,EN1 K PSIVOEDF,J,N2,ORIFN,P17 D READ^PSJUTL
+1 SET PSIVOEDF=1
DO ENCV^PSGSETU
DO EN1
KILL PSIVOEDF,J,N2,ORIFN,P17
+2 QUIT
PAUSE ;
+1 KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET PSJDNE=1
+2 QUIT
