source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSIVPR.m@ 1397

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