Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSIVPR

PSIVPR.m

Go to the documentation of this file.
  1. PSIVPR ;BIR/PR,CML3-PRINT PROFILE REPORT ;16 JUL 97 / 9:49 AM
  1. ;;5.0; INPATIENT MEDICATIONS ;**38**;16 DEC 97
  1. K ^TMP("PSIV",$J) N PSJNEW,PSGPTMP,PPAGE S PSJNEW=1
  1. EN ; Entry from option.
  1. N XQUIT D ^PSIVXU Q:$D(XQUIT)
  1. EN1 ; Start here if from OE/RR.
  1. S (PSIVLAB,PSIVLOG,PSIVPR1,PSIVPPR)=0,PSJOL="L"
  1. BEG ;Ask for order view.
  1. F Q=0:0 W !,"View each order in the profile" S %=1 D YN^DICN Q:% S HELP="PRORPT" D ^PSIVHLP
  1. G:%<1 Q I %=2 S NOLOG=1 G PAT
  1. S PSIVPR1=1
  1. ;
  1. BEG1 ;Ask for activity log.
  1. F Q=0:0 W !,"View each activity log in the profile" S %=1 D YN^DICN Q:% S HELP="PRORPT1" D ^PSIVHLP1
  1. G:%<1 Q S PSIVLOG=%
  1. ;
  1. BEG2 ;
  1. F Q=0:0 W !,"View the label log in the profile" S %=1 D YN^DICN Q:% S HELP="LABLOG" D ^PSIVHLP2
  1. G:%<1 Q S PSIVLAB=%
  1. ;
  1. PAT ;Get patient
  1. I '$D(PSIVOEDF) D ENGETP^PSIV G @$S(DFN<0:"Q",PSIVPR=ION:"DEQ",1:"QUEUE")
  1. 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
  1. G:'$D(IO("Q")) DEQ
  1. ;
  1. QUEUE ;Queue logic.
  1. 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)=""
  1. F X="PSIVPR1","PSJSYSW0","PSJSYSU","PSJSYSP","PSJSYSP0","PSGPTMP","PPAGE" S ZTSAVE(X)=""
  1. D ^%ZTLOAD W:$D(ZTSK) !,"Queued." G Q
  1. DEQ ;
  1. ;*
  1. NEW SUB3,SUB4,X
  1. 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)
  1. S X=$G(^TMP("PSJPRO",$J,0)) I X]"" S ^TMP("PSJPROSV",$J,0)=X D
  1. . 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))
  1. S X=$G(^TMP("PSJI",$J,0)) I X]"" S ^TMP("PSJISV",$J,0)=X D
  1. . 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))
  1. K PSJDNE D:'$D(VAIN) ENIV^PSJAC S PSGP(0)=VADM(1) D ENNA^PSIVACT,^PSIVPRO G:X="^" Q
  1. D DISPLAY
  1. S PSIVSCR=$E(IOST)="C" ;* D:PSIVSCR PAUSE G:X="^" Q
  1. ;* I $D(PSIVPR),PS>0,'$D(PSIVPPR) S PSIVBR="Q" D ASK^PSIV K PSIVBR
  1. I 'PSIVSCR&('$G(NOLOG)) D NOW^%DTC S Y=% W:$Y @IOF W !!,"PATIENT PROFILE REPORT on " D WD
  1. 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
  1. ;
  1. Q W:'$G(PSIVSCR)&($Y) @IOF D ^%ZISC,ENIVKV^PSGSETU S:$D(ZTQUEUED) ZTREQ="@"
  1. 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
  1. K X,X1,X2,Y,Z,Z1,Z2,ZTSK,ZZ,^TMP("PSIV",$J),^TMP("PSJPRO",$J),^TMP("PSJI",$J)
  1. NEW SUB3,SUB4,X
  1. 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))
  1. S X=$G(^TMP("PSJPROSV",$J,0)) I X]"" S ^TMP("PSJPRO",$J,0)=X D
  1. . 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))
  1. S X=$G(^TMP("PSJISV",$J,0)) I X]"" S ^TMP("PSJI",$J,0)=X D
  1. . 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))
  1. K ^TMP("PSIVSV",$J),^TMP("PSJPROSV",$J),^TMP("PSJISV",$J)
  1. Q
  1. ;
  1. DEQ1 ;
  1. D:PSIVSCR PAUSE Q:$D(PSJDNE)
  1. N PSIVAC S PSIVAC="PRO",KEY="",PSJORD=ON D @$S(ON["V":"GT55^PSIVORFB",1:"GT531^PSIVORFA("_DFN_","""_ON_""")"),ENNH^PSIVORV2(ON)
  1. D:PSIVSCR PAUSE Q:$D(PSJDNE) D:PSIVLOG=1 ENLOG^PSIVVW1
  1. ;* I ($Y#IOSL)>22,PSIVSCR D PAUSE Q:$D(PSJDNE)
  1. I PSIVLAB=1 D DATA^PSIVLTR1(DFN,+ON),PAUSE:PSIVSCR
  1. Q
  1. ;
  1. DISPLAY ;Display the patient's profile.
  1. W:$E(IOST)="C" @IOF
  1. D ENTRY^PSJHEAD(DFN,"IV",0,1,0)
  1. NEW PSIVX F PSIVX=0:0 S PSIVX=$O(^TMP("PSJPRO",$J,PSIVX)) Q:'PSIVX D Q:$D(DUOUT)!$D(DTOUT)
  1. . I +$E(^TMP("PSJPRO",$J,PSIVX,0),1,2),(($Y+4)>IOSL) D
  1. .. I $E(IOST)="C" N DIR,X,Y S DIR(0)="E" D ^DIR W @IOF Q
  1. .. D ENTRY^PSJHEAD(DFN,"IV",0,1,0) W !,!,^TMP("PSJPRO",$J,1,0),!
  1. . W !,^TMP("PSJPRO",$J,PSIVX,0)
  1. Q
  1. ;
  1. WD X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2) Q
  1. ;
  1. ENOR S DFN=+ORVP
  1. ENLM ;* S PSIVOEDF=1 D ENCV^PSGSETU,EN1 K PSIVOEDF,J,N2,ORIFN,P17 D READ^PSJUTL
  1. S PSIVOEDF=1 D ENCV^PSGSETU,EN1 K PSIVOEDF,J,N2,ORIFN,P17
  1. Q
  1. PAUSE ;
  1. K DIR S DIR(0)="E" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S PSJDNE=1
  1. Q