source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGVBWP.m@ 691

PSGVBWP ;BIR/CML3-INPATIENT MEDICATIONS PROFILE FROM NON-VERIFIED/PENDING ;25 SEP 97 / 7:42 AM

 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97

 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) DONE S:$D(PSJEXTP) PSJSEL("SELECT")="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 ;

 K PSJSEL S PSJSEL("SELECT")="P" F X=0:0 S X=$O(^TMP("PSJSELECT",$J,X)) Q:'X  D

 .S Y=$G(^TMP("PSJSELECT",$J,X)) I $P(Y,U)=""!($P(Y,U,2)="") Q

 .S PSJSEL("P",$P(Y,U),$P(Y,U,2))=""

 S PSJPRP="P",PSJOS=$P(PSJSYSP0,"^",11)

 K ZTSAVE S PSGTIR="ENQ^PSGVBWP",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

 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

 ;

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

 ;.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)=""

 ;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",(PSGORD["U") 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 S (PSGP,DFN)=+ORVP,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