PSJPR ;BIR/CML3-INPATIENT MEDICATIONS PROFILE ;29-May-2012 14:39;PLS
;;5.0; INPATIENT MEDICATIONS ;**31,1011,111,122,1015**;16 DEC 97;Build 62
;
; Reference to ^PS(55 is supported by DBIA# 2191
; Modified - IHS/MSC/PLS - 03/28/2011 - Line PP+1
N PFLG,PSJNEW,PSGPTMP,PPAGE,QFLG S PSJNEW=1
N PSGLI,PSGWD,PSJAT,PSJPNRB,PSJPWDO,PSJSTOP,PSJTEAM
;
EN ;
G:$D(XQUIT) DONE
D @$S('$D(PSJEXTP):"^PSIVXU",1:"ENCV^PSGSETU")
G:$D(XQUIT) DONE S PSGPTMP=0,PPAGE=1 K PSJSEL D @$S($D(PSJEXTP):"P^PSJPDIR",1:"GWP^PSJPDIR") G:$G(PSJSTOP)=1 DONE S:$D(PSJEXTP) PSJSEL("SELECT")="P"
I $G(PSJSEL("WG"))="^OTHER",PSJSEL("SELECT")="G",PSJSTOP=2 S PSJSEL("SELECT")="C",PSJSEL("RBP")="P"
D ENL^PSJO3 G:"^N"[PSJOL EN D GO
;
DONE ;
K ^TMP("PSJON",$J),^TMP("PSJ",$J)
D ENIVKV^PSGSETU K AND,AT,C,CA,DDH,DFN,DN,DOB,DRGI,DRGN,DRGT,FIL,FQC,HDR,I1,J,JJ,MF,NF,O,OD,ON,ON55,P,P1,PDRG,PG,PPN,PRI,PRIV,PSGLMT,PSGOE,PSGONC,PSGONR,PSGONV,PSGORD,PSGSS,PSGSSH,PSGON,PSGPR,PSGPRP
K PSIVAC,PSIVCT,PSIVREA,PSIVSCR,PSIVUP,PSIVX
K PSJACNWP,PSJACOK,PSJDEV,PSJDBL,PSJION,PSJOL,PSJON,PSJOS,PSJP,PSJSEL,PSJSS,PSJSSH,PSJPRW,PSJPRWN,PSJPRWG,PSJPRWGN
K PSJOPC,PSJORD,PSJQ,PSJIVOF,PSJOCNT,PSJPR,PSJPRA,PSJPRF,PSJPRP,PSJON,PSJS1,PSJS2,PSJS3,PSJS4,PSJPR,PX,HDT,PSGODT,RF,SD,SLS,SSN,TF,UD,WD,WDP,WT,PSJORIFN,RB,RCT,SUB,XQUIT,ZTOUT
;*
;* K PSGLI,PSGWD,PSJAT,PSJPNRB,PSJPWDO,PSJSTOP,PSJTEAM
Q
;
GO ;
S PSJPRP="P",PSJPRA="" G:PSJSEL("SELECT")'="P" DEV
N DIR S DIR(0)="SAO^P:PROFILE;E:EXPANDED VIEWS;B:BOTH",DIR("A")="Show PROFILE only, EXPANDED VIEWS only, or BOTH: ",DIR("B")="PROFILE",DIR("?")="^D PH^PSJPR" W ! D ^DIR G:"^"[Y EN S PSJPRP=Y
I "EB"[PSJPRP F R !!,"Show SHORT, LONG, or NO activity log? NO// ",AT:DTIME D ALC^PSGVW0 I Q S PSJPRA=AT Q
G:PSJPRA="^" EN
DEV ;
S PSJOS=$P(PSJSYSP0,"^",11)
K ZTSAVE S PSGTIR="ENQ^PSJPR",ZTDESC="INPATIENT PATIENT PROFILE" F X="DFN","PSJSEL(","PSJOL","PSJOS","PSJPRA","PSJPRP","PSGPTMP","PPAGE","PSJEXTP","PSJHDATE" S ZTSAVE(X)=""
D ENDEV^PSGTI Q:POP D:'$D(IO("Q")) ENQ G EN
Q
;
ENQ ;
S Y="PSJPR" F X="W","WG" S:$D(PSJSEL(X)) @(Y_X)=+PSJSEL(X),@(Y_X_"N")=$P(PSJSEL(X),U,2)
S PSJACNWP=1 K ^TMP("PSJAT",$J) S PSJPR=IO'=IO(0)!($E(IOST)'="C"),PSGPRP=PSJPRP
I PSJSEL("SELECT")="P" S PPN="" F S PPN=$O(PSJSEL("P",PPN)) Q:PPN="" D Q:$G(X)?1"^"."^"
.F DFN=0:0 S (PSGP,DFN)=$O(PSJSEL("P",PPN,DFN)) Q:'DFN D ENBOTH^PSJAC,PP Q:$G(X)?1"^"."^"
D:PSJSEL("SELECT")'="P" @("P"_PSJSEL("SELECT")) I PSJPR W:$Y @IOF D ^%ZISC,DONE
Q
PC ;
K ^TMP("PSJPR",$J,"OUTPAT")
S (STDTE,CLINIC,JDFN)=0
F S STDTE=$O(^PS(55,"AIVC",STDTE)) Q:STDTE="" F S CLINIC=$O(^PS(55,"AIVC",STDTE,CLINIC)) Q:CLINIC="" D
. F S JDFN=$O(^PS(55,"AIVC",STDTE,CLINIC,JDFN)) Q:JDFN="" I '$D(^TMP("PSJPR",$J,"OUTPAT",JDFN)) S DFN=JDFN K ^TMP("PSJAT",$J) D PAT,PAT1,PJ
S (STDTE,CLINIC,JDFN)=0
F S STDTE=$O(^PS(55,"AUDC",STDTE)) Q:STDTE="" F S CLINIC=$O(^PS(55,"AIVC",STDTE,CLINIC)) Q:CLINIC="" D
. F S JDFN=$O(^PS(55,"AUDC",STDTE,CLINIC,JDFN)) Q:JDFN="" I '$D(^TMP("PSJPR",$J,"OUTPAT",JDFN)) S DFN=JDFN K ^TMP("PSJAT",$J) D PAT,PAT1,PJ
Q
;
PJ ;
S ^TMP("PSJPR",$J,"OUTPAT",JDFN)=""
;
PG ;
F PSJPRW=0:0 S PSJPRW=$O(^PS(57.5,"AC",PSJPRWG,PSJPRW)) Q:'PSJPRW S PSJPRWN=$P($G(^DIC(42,+PSJPRW,0)),"^") I PSJPRWN]"" D PW Q:$G(X)="^"
Q
;
PW ;
K ^TMP("PSJAT",$J) F DFN=0:0 S (DFN,PSGP)=$O(^DPT("CN",PSJPRWN,DFN)) Q:'DFN D PAT
D PAT1
;
Q
;
PAT ;
S RB=$P($G(^DPT(DFN,.101)),U),PPN=$P($G(^(0)),U),X=$S(PSJSEL("RBP")="R":RB,1:PPN),AT=""
I $D(PSJSEL("TM")) S:RB]"" AT=$O(^PS(57.7,"AWRT",PSJPRW,RB,0)) Q:$S($D(PSJSEL("TM","ALL")):0,AT="":1,1:'$D(PSJSEL("TM",AT)))
F Y="AT","RB","X" S:@Y="" @Y="ZZ"
S ^TMP("PSJAT",$J,AT,X,DFN)=""
Q
;
PAT1 ;
K PSJDBL S PSJAT="" F S PSJAT=$O(^TMP("PSJAT",$J,PSJAT)) Q:PSJAT=""!$G(PSJDBL) D
.S PSJPNRB="" F S PSJPNRB=$O(^TMP("PSJAT",$J,PSJAT,PSJPNRB)) Q:PSJPNRB="" S (DFN,PSGP)=+$O(^TMP("PSJAT",$J,PSJAT,PSJPNRB,0)) D ENBOTH^PSJAC,PP I $G(X)["^" S:X="^^" PSJDBL=1 Q
Q
;
PP ;
D SETPTCX^APSPFUNC(PSGP) ;IHS/MSC/PLS - 03/28/2011
I PSJPRP'="E" D ^PSJO I PSJPRP="P",'PSJPR D:'PSJON READ^PSJUTL Q:$G(X)?1"^"."^" I PSJON S PSJPRF=1 D ENVW^PSJOE0 K PSGPRF Q
Q:PSJPRP="P" I PSJPRP="E" U IO S PSJON=0,PSJDEV=PSJPR D @$S($D(PSJEXTP):"EN^PSJH1,ENGET^PSJO3",1:"EN^PSJO1(3),ENGET^PSJO3")
I 'PSJPR,PSJSEL("SELECT")'="P",'$D(^TMP("PSG",$J)) D READ^PSJUTL Q
I PSJPRP'="E",'PSJPR D PP3 Q:$D(DUOUT)!$D(DTOUT)
S (PSJS1,PSJS2,PSJS3,PSJS4,X)=""
F PSJQ=0:0 S PSJS1=$O(^TMP("PSJ",$J,PSJS1)) Q:PSJS1="" F PSJQ=0:0 S PSJS2=$O(^TMP("PSJ",$J,PSJS1,PSJS2)) Q:PSJS2="" F PSJQ=0:0 S PSJS3=$O(^TMP("PSJ",$J,PSJS1,PSJS2,PSJS3)) Q:PSJS3="" D PP1
D:X'["^"&PSJPR BOT^PSJO3 K ^TMP("PSJ",$J) Q
;
PP1 ;
F PSJQ=0:0 S PSJS4=$O(^TMP("PSJ",$J,PSJS1,PSJS2,PSJS3,PSJS4)) Q:PSJS4="" D PP2
Q
;
PP2 ; Display selected order.
N PSJPRF,PSJLM S PSJORD=PSJS4 I $S(PSJORD["V":1,PSJORD["P":$P($G(^PS(53.1,+PSJORD,0)),U,4)="F",1:0) D Q
.S PSJPRF=1 D ENINP^PSIVOPT(PSGP,PSJORD),PP3 Q:$D(DUOUT)!$D(DTOUT) I PSJPRA'="N" I PSJORD'["P" D ENLOG^PSIVVW1,PP3 Q
S PSGORD=PSJORD D EN2^PSGVW,PP3 Q:$D(DUOUT)!$D(DTOUT) I PSJPRA'="N",((PSJS1["A")!(PSJS1["O")) S AT=PSJPRA D ENA^PSGVW0 D PP3
Q
PP3 S X="" I 'PSJPR K DIR S DIR(0)="E" D ^DIR S:$D(DUOUT)!$D(DTOUT) X="^" I X["^" S (PSJS1,PSJS2,PSJS3,PSJS4)="~"
Q
;
PH ;
W !!?2,"Enter a 'P' to print ONLY the PROFILE of orders for this patient. Enter an",!,"'E' to print ONLY the EXPANDED VIEW of the orders for this patient. Enter a",!,"'B' to have BOTH the profile (first) and the expanded views print."
W " Enter an '^'to exit." Q
;
ENOR(PSGP) ;S (PSGP,DFN)=+ORVP,PSGP(0)=^DPT(PSGP,0)
S DFN=+PSGP,PSGP(0)=^DPT(PSGP,0)
ENLM N PSJNEW,PSGPTMP,PPAGE S PSJNEW=1
S PSGPTMP=0,PPAGE=1
D ENCV^PSGSETU
D ENBOTH^PSJAC D:$D(PSJEXTP) CNV^PSJP D ENL^PSJO3 I "^N"'[PSJOL S PSJSEL("SELECT")="P",PSJSEL("P",PSGP(0),PSGP)="",(PSJPRW,PSJPRWG)=0,(PSJPRWN,PSJPRWGN)="",XQUIT="YES" D GO
;* S PSJNKF=1 D READ^PSJUTL G DONE
S PSJNKF=1 G DONE
PSJPR ;BIR/CML3-INPATIENT MEDICATIONS PROFILE ;29-May-2012 14:39;PLS
+1 ;;5.0; INPATIENT MEDICATIONS ;**31,1011,111,122,1015**;16 DEC 97;Build 62
+2 ;
+3 ; Reference to ^PS(55 is supported by DBIA# 2191
+4 ; Modified - IHS/MSC/PLS - 03/28/2011 - Line PP+1
+5 NEW PFLG,PSJNEW,PSGPTMP,PPAGE,QFLG
SET PSJNEW=1
+6 NEW PSGLI,PSGWD,PSJAT,PSJPNRB,PSJPWDO,PSJSTOP,PSJTEAM
+7 ;
EN ;
+1 IF $DATA(XQUIT)
GOTO DONE
+2 DO @$SELECT('$DATA(PSJEXTP):"^PSIVXU",1:"ENCV^PSGSETU")
+3 IF $DATA(XQUIT)
GOTO DONE
SET PSGPTMP=0
SET PPAGE=1
KILL PSJSEL
DO @$SELECT($DATA(PSJEXTP):"P^PSJPDIR",1:"GWP^PSJPDIR")
IF $GET(PSJSTOP)=1
GOTO DONE
IF $DATA(PSJEXTP)
SET PSJSEL("SELECT")="P"
+4 IF $GET(PSJSEL("WG"))="^OTHER"
IF PSJSEL("SELECT")="G"
IF PSJSTOP=2
SET PSJSEL("SELECT")="C"
SET PSJSEL("RBP")="P"
+5 DO ENL^PSJO3
IF "^N"[PSJOL
GOTO EN
DO GO
+6 ;
DONE ;
+1 KILL ^TMP("PSJON",$JOB),^TMP("PSJ",$JOB)
+2 DO ENIVKV^PSGSETU
KILL AND,AT,C,CA,DDH,DFN,DN,DOB,DRGI,DRGN,DRGT,FIL,FQC,HDR,I1,J,JJ,MF,NF,O,OD,ON,ON55,P,P1,PDRG,PG,PPN,PRI,PRIV,PSGLMT,PSGOE,PSGONC,PSGONR,PSGONV,PSGORD,PSGSS,PSGSSH,PSGON,PSGPR,PSGPRP
+3 KILL PSIVAC,PSIVCT,PSIVREA,PSIVSCR,PSIVUP,PSIVX
+4 KILL PSJACNWP,PSJACOK,PSJDEV,PSJDBL,PSJION,PSJOL,PSJON,PSJOS,PSJP,PSJSEL,PSJSS,PSJSSH,PSJPRW,PSJPRWN,PSJPRWG,PSJPRWGN
+5 KILL PSJOPC,PSJORD,PSJQ,PSJIVOF,PSJOCNT,PSJPR,PSJPRA,PSJPRF,PSJPRP,PSJON,PSJS1,PSJS2,PSJS3,PSJS4,PSJPR,PX,HDT,PSGODT,RF,SD,SLS,SSN,TF,UD,WD,WDP,WT,PSJORIFN,RB,RCT,SUB,XQUIT,ZTOUT
+6 ;*
+7 ;* K PSGLI,PSGWD,PSJAT,PSJPNRB,PSJPWDO,PSJSTOP,PSJTEAM
+8 QUIT
+9 ;
GO ;
+1 SET PSJPRP="P"
SET PSJPRA=""
IF PSJSEL("SELECT")'="P"
GOTO DEV
+2 NEW DIR
SET DIR(0)="SAO^P:PROFILE;E:EXPANDED VIEWS;B:BOTH"
SET DIR("A")="Show PROFILE only, EXPANDED VIEWS only, or BOTH: "
SET DIR("B")="PROFILE"
SET DIR("?")="^D PH^PSJPR"
WRITE !
DO ^DIR
IF "^"[Y
GOTO EN
SET PSJPRP=Y
+3 IF "EB"[PSJPRP
FOR
READ !!,"Show SHORT, LONG, or NO activity log? NO// ",AT:DTIME
DO ALC^PSGVW0
IF Q
SET PSJPRA=AT
QUIT
+4 IF PSJPRA="^"
GOTO EN
DEV ;
+1 SET PSJOS=$PIECE(PSJSYSP0,"^",11)
+2 KILL ZTSAVE
SET PSGTIR="ENQ^PSJPR"
SET ZTDESC="INPATIENT PATIENT PROFILE"
FOR X="DFN","PSJSEL(","PSJOL","PSJOS","PSJPRA","PSJPRP","PSGPTMP","PPAGE","PSJEXTP","PSJHDATE"
SET ZTSAVE(X)=""
+3 DO ENDEV^PSGTI
IF POP
QUIT
IF '$DATA(IO("Q"))
DO ENQ
GOTO EN
+4 QUIT
+5 ;
ENQ ;
+1 SET Y="PSJPR"
FOR X="W","WG"
IF $DATA(PSJSEL(X))
SET @(Y_X)=+PSJSEL(X)
SET @(Y_X_"N")=$PIECE(PSJSEL(X),U,2)
+2 SET PSJACNWP=1
KILL ^TMP("PSJAT",$JOB)
SET PSJPR=IO'=IO(0)!($EXTRACT(IOST)'="C")
SET PSGPRP=PSJPRP
+3 IF PSJSEL("SELECT")="P"
SET PPN=""
FOR
SET PPN=$ORDER(PSJSEL("P",PPN))
IF PPN=""
QUIT
Begin DoDot:1
+4 FOR DFN=0:0
SET (PSGP,DFN)=$ORDER(PSJSEL("P",PPN,DFN))
IF 'DFN
QUIT
DO ENBOTH^PSJAC
DO PP
IF $GET(X)?1"^"."^"
QUIT
End DoDot:1
IF $GET(X)?1"^"."^"
QUIT
+5 IF PSJSEL("SELECT")'="P"
DO @("P"_PSJSEL("SELECT"))
IF PSJPR
IF $Y
WRITE @IOF
DO ^%ZISC
DO DONE
+6 QUIT
PC ;
+1 KILL ^TMP("PSJPR",$JOB,"OUTPAT")
+2 SET (STDTE,CLINIC,JDFN)=0
+3 FOR
SET STDTE=$ORDER(^PS(55,"AIVC",STDTE))
IF STDTE=""
QUIT
FOR
SET CLINIC=$ORDER(^PS(55,"AIVC",STDTE,CLINIC))
IF CLINIC=""
QUIT
Begin DoDot:1
+4 FOR
SET JDFN=$ORDER(^PS(55,"AIVC",STDTE,CLINIC,JDFN))
IF JDFN=""
QUIT
IF '$DATA(^TMP("PSJPR",$JOB,"OUTPAT",JDFN))
SET DFN=JDFN
KILL ^TMP("PSJAT",$JOB)
DO PAT
DO PAT1
DO PJ
End DoDot:1
+5 SET (STDTE,CLINIC,JDFN)=0
+6 FOR
SET STDTE=$ORDER(^PS(55,"AUDC",STDTE))
IF STDTE=""
QUIT
FOR
SET CLINIC=$ORDER(^PS(55,"AIVC",STDTE,CLINIC))
IF CLINIC=""
QUIT
Begin DoDot:1
+7 FOR
SET JDFN=$ORDER(^PS(55,"AUDC",STDTE,CLINIC,JDFN))
IF JDFN=""
QUIT
IF '$DATA(^TMP("PSJPR",$JOB,"OUTPAT",JDFN))
SET DFN=JDFN
KILL ^TMP("PSJAT",$JOB)
DO PAT
DO PAT1
DO PJ
End DoDot:1
+8 QUIT
+9 ;
PJ ;
+1 SET ^TMP("PSJPR",$JOB,"OUTPAT",JDFN)=""
+2 ;
PG ;
+1 FOR PSJPRW=0:0
SET PSJPRW=$ORDER(^PS(57.5,"AC",PSJPRWG,PSJPRW))
IF 'PSJPRW
QUIT
SET PSJPRWN=$PIECE($GET(^DIC(42,+PSJPRW,0)),"^")
IF PSJPRWN]""
DO PW
IF $GET(X)="^"
QUIT
+2 QUIT
+3 ;
PW ;
+1 KILL ^TMP("PSJAT",$JOB)
FOR DFN=0:0
SET (DFN,PSGP)=$ORDER(^DPT("CN",PSJPRWN,DFN))
IF 'DFN
QUIT
DO PAT
+2 DO PAT1
+3 ;
+4 QUIT
+5 ;
PAT ;
+1 SET RB=$PIECE($GET(^DPT(DFN,.101)),U)
SET PPN=$PIECE($GET(^(0)),U)
SET X=$SELECT(PSJSEL("RBP")="R":RB,1:PPN)
SET AT=""
+2 IF $DATA(PSJSEL("TM"))
IF RB]""
SET AT=$ORDER(^PS(57.7,"AWRT",PSJPRW,RB,0))
IF $SELECT($DATA(PSJSEL("TM","ALL"))
QUIT
+3 FOR Y="AT","RB","X"
IF @Y=""
SET @Y="ZZ"
+4 SET ^TMP("PSJAT",$JOB,AT,X,DFN)=""
+5 QUIT
+6 ;
PAT1 ;
+1 KILL PSJDBL
SET PSJAT=""
FOR
SET PSJAT=$ORDER(^TMP("PSJAT",$JOB,PSJAT))
IF PSJAT=""!$GET(PSJDBL)
QUIT
Begin DoDot:1
+2 SET PSJPNRB=""
FOR
SET PSJPNRB=$ORDER(^TMP("PSJAT",$JOB,PSJAT,PSJPNRB))
IF PSJPNRB=""
QUIT
SET (DFN,PSGP)=+$ORDER(^TMP("PSJAT",$JOB,PSJAT,PSJPNRB,0))
DO ENBOTH^PSJAC
DO PP
IF $GET(X)["^"
IF X="^^"
SET PSJDBL=1
QUIT
End DoDot:1
+3 QUIT
+4 ;
PP ;
+1 ;IHS/MSC/PLS - 03/28/2011
DO SETPTCX^APSPFUNC(PSGP)
+2 IF PSJPRP'="E"
DO ^PSJO
IF PSJPRP="P"
IF 'PSJPR
IF 'PSJON
DO READ^PSJUTL
IF $GET(X)?1"^"."^"
QUIT
IF PSJON
SET PSJPRF=1
DO ENVW^PSJOE0
KILL PSGPRF
QUIT
+3 IF PSJPRP="P"
QUIT
IF PSJPRP="E"
USE IO
SET PSJON=0
SET PSJDEV=PSJPR
DO @$SELECT($DATA(PSJEXTP):"EN^PSJH1,ENGET^PSJO3",1:"EN^PSJO1(3),ENGET^PSJO3")
+4 IF 'PSJPR
IF PSJSEL("SELECT")'="P"
IF '$DATA(^TMP("PSG",$JOB))
DO READ^PSJUTL
QUIT
+5 IF PSJPRP'="E"
IF 'PSJPR
DO PP3
IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+6 SET (PSJS1,PSJS2,PSJS3,PSJS4,X)=""
+7 FOR PSJQ=0:0
SET PSJS1=$ORDER(^TMP("PSJ",$JOB,PSJS1))
IF PSJS1=""
QUIT
FOR PSJQ=0:0
SET PSJS2=$ORDER(^TMP("PSJ",$JOB,PSJS1,PSJS2))
IF PSJS2=""
QUIT
FOR PSJQ=0:0
SET PSJS3=$ORDER(^TMP("PSJ",$JOB,PSJS1,PSJS2,PSJS3))
IF PSJS3=""
QUIT
DO PP1
+8 IF X'["^"&PSJPR
DO BOT^PSJO3
KILL ^TMP("PSJ",$JOB)
QUIT
+9 ;
PP1 ;
+1 FOR PSJQ=0:0
SET PSJS4=$ORDER(^TMP("PSJ",$JOB,PSJS1,PSJS2,PSJS3,PSJS4))
IF PSJS4=""
QUIT
DO PP2
+2 QUIT
+3 ;
PP2 ; Display selected order.
+1 NEW PSJPRF,PSJLM
SET PSJORD=PSJS4
IF $SELECT(PSJORD["V":1,PSJORD["P":$PIECE($GET(^PS(53.1,+PSJORD,0)),U,4)="F",1:0)
Begin DoDot:1
+2 SET PSJPRF=1
DO ENINP^PSIVOPT(PSGP,PSJORD)
DO PP3
IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
IF PSJPRA'="N"
IF PSJORD'["P"
DO ENLOG^PSIVVW1
DO PP3
QUIT
End DoDot:1
QUIT
+3 SET PSGORD=PSJORD
DO EN2^PSGVW
DO PP3
IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
IF PSJPRA'="N"
IF ((PSJS1["A")!(PSJS1["O"))
SET AT=PSJPRA
DO ENA^PSGVW0
DO PP3
+4 QUIT
PP3 SET X=""
IF 'PSJPR
KILL DIR
SET DIR(0)="E"
DO ^DIR
IF $DATA(DUOUT)!$DATA(DTOUT)
SET X="^"
IF X["^"
SET (PSJS1,PSJS2,PSJS3,PSJS4)="~"
+1 QUIT
+2 ;
PH ;
+1 WRITE !!?2,"Enter a 'P' to print ONLY the PROFILE of orders for this patient. Enter an",!,"'E' to print ONLY the EXPANDED VIEW of the orders for this patient. Enter a",!,"'B' to have BOTH the profile (first) and the expanded views print."
+2 WRITE " Enter an '^'to exit."
QUIT
+3 ;
ENOR(PSGP) ;S (PSGP,DFN)=+ORVP,PSGP(0)=^DPT(PSGP,0)
+1 SET DFN=+PSGP
SET PSGP(0)=^DPT(PSGP,0)
ENLM NEW PSJNEW,PSGPTMP,PPAGE
SET PSJNEW=1
+1 SET PSGPTMP=0
SET PPAGE=1
+2 DO ENCV^PSGSETU
+3 DO ENBOTH^PSJAC
IF $DATA(PSJEXTP)
DO CNV^PSJP
DO ENL^PSJO3
IF "^N"'[PSJOL
SET PSJSEL("SELECT")="P"
SET PSJSEL("P",PSGP(0),PSGP)=""
SET (PSJPRW,PSJPRWG)=0
SET (PSJPRWN,PSJPRWGN)=""
SET XQUIT="YES"
DO GO
+4 ;* S PSJNKF=1 D READ^PSJUTL G DONE
+5 SET PSJNKF=1
GOTO DONE
