- 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
