source: FOIAVistA/tag/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJPR.m@ 636

PSJPR ;BIR/CML3-INPATIENT MEDICATIONS PROFILE ;25 SEP 97 / 7:43 AM
 ;;5.0; INPATIENT MEDICATIONS ;**31,111,122**;16 DEC 97
 ;
 ; Reference to ^PS(55 is supported by DBIA# 2191
 ;
 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 ;
 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