- 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 Feb 18, 2025@23:31:16 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