125 lines
6.0 KiB
Mathematica
125 lines
6.0 KiB
Mathematica
PSGPR ;BIR/CML3-PATIENT PROFILE ;19 SEP 96 / 3:59 PM
|
|
;;5.0; INPATIENT MEDICATIONS ;**110,111,169**;16 DEC 97
|
|
;* N PSJNEW,PSGPTMP,PPAGE,PSGOEPRF S PSJNEW=1
|
|
N PSGLI,PSGOE,PSGOEEWF,PSGOH,PSGWD,PSJPWDO,PSJSTOP,PSJTEAM
|
|
N ACTION,CONT,PAT,LD,LN2,PFLG,PSJNEW,PSGPTMP,PPAGE,PSGOEPRF S PSJNEW=1
|
|
;
|
|
S PSJOPC="UD"
|
|
D ENCV^PSGSETU
|
|
;I '$D(XQUIT) F PSGPR=0:0 S (PSGP,PSGPRWD,PSGPRWG)=0,(PSGPRWDN,PSGPRWGN)="",PSGSSH="PPR" S PSGPTMP=0,PPAGE=1 D GWP^PSJPDIR Q:'$D(PSJSEL) D @PSJSEL("SELECT") D ENL^PSGOU I "^N"'[PSGOL D GO
|
|
I '$D(XQUIT) F PSGPR=0:0 S (PSGP,PSGPRWD,PSGPRWG)=0,(PSGPRWDN,PSGPRWGN)="",PSGSSH="PPR" S PSGPTMP=0,PPAGE=1 D Q:'$D(PSJSEL("SELECT"))
|
|
.K PSJSEL,Y F K ^TMP("PSJSELECT",$J),PSJSEL D ^PSGSEL Q:"^"[PSGSS S PSJSEL("SELECT")=PSGSS,PSJSTOP="" D
|
|
..D:(PSJSEL("SELECT")="P") P^PSJPDIR D:(PSJSEL("SELECT")="W") W^PSJPDIR D:(PSJSEL("SELECT")="G") G^PSJPDIR
|
|
..; PSJ*5*169 Check PSJSTOP before continuing.
|
|
..Q:$G(PSJSTOP)=1
|
|
..I PSJSEL("SELECT")'="P",PSJSEL("SELECT")'="L" D RBPPN^PSJPDIR
|
|
..Q:$G(PSJSTOP)=1
|
|
..Q:(((PSGSS="W")!(PSGSS="G"))&($G(Y)<0)) Q:((PSGSS="P")&'$D(PSJSEL("P")))
|
|
..S (PSGP,WD,WG)=0 S PSGPTMP=0,PPAGE=1 D @PSGSS Q:(((PSGSS="L")!(PSGSS="C"))&($G(Y)<0)) D ENL^PSGOU I "^N"'[PSGOL D GO
|
|
;
|
|
DONE ;
|
|
D:'$D(PSGOEPRF) ENKV^PSGSETU K AND,AT,C,CA,DOB,DRGI,FQC,MF,ND,NF,O,ON,PG,PN,PSGON,PSGORD,PRI,PSGONC,PSGONR,PSGONV,PSGSEL,PX,^TMP("PSGPR",$J)
|
|
K RCT,PSGAPTM,PSGOL,PSGOS,PSGPR,PSGSS,PSGSSH,PSGPATM,PSGPRWD,PSGPRWDN,PSGPRWG,PSGPRWGN,PSGPRA,PSGPRP,PSJOPC,PSJSEL,S1,S2,S3,S4,HDT,PSGODT,QFLG,RF,SD,SLS,SSN,TF,TM,UD,UDU,WD,WDP,WT,ZTOUT,ZTSK,OD,PDRG
|
|
Q
|
|
;
|
|
GO ;
|
|
S PSGPRP="P",PSGPRA="" S PSGSS=PSJSEL("SELECT") G:PSGSS'="P" ENDEV
|
|
K 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^PSGPR" W ! D ^DIR K DIR Q:"^"[Y S PSGPRP=Y
|
|
I "EB"[PSGPRP F R !!,"Show SHORT, LONG, or NO activity log? NO// ",AT:DTIME D ALC^PSGVW0 I Q S PSGPRA=AT Q
|
|
Q:PSGPRA="^"
|
|
ENDEV ;
|
|
K ZTSAVE S PSGTIR="ENQ^PSGPR",ZTDESC="PATIENT PROFILE" F X="PSGP","PSGP(","PSGSS","PSGPRWD","PSGPRWG","PSGPRWDN","PSGPRWGN","PSGOL","PSGPRA","PSGPRP","PSGPTMP","PSJSEL(","PPAGE" S ZTSAVE(X)=""
|
|
D ENDEV^PSGTI I POP!$D(IO("Q")) G:$D(PSGOEPRF) DONE Q
|
|
;
|
|
ENQ ;
|
|
K ^TMP("PSGPR",$J)
|
|
K PSGVBY N RB,ATM S PSGPR=IO'=IO(0)!($E(IOST)'="C") N RBP S RBP=$S($D(PSJSEL("RBP")):PSJSEL("RBP"),1:"P") D @("P"_PSGSS) I PSGPR W:$Y @IOF D ^%ZISC
|
|
G:$D(PSGOEPRF) DONE Q
|
|
;
|
|
G ; get ward group
|
|
S PSGPRWG=+PSJSEL("WG"),PSGPRWGN=$P(PSJSEL("WG"),"^",2) Q
|
|
;
|
|
W ; get ward
|
|
S PSGPRWD=+PSJSEL("W"),PSGPRWDN=$P(PSJSEL("W"),"^",2)
|
|
I $D(PSJSEL("TM")) S TM="" F S TM=$O(PSJSEL("TM",TM)) Q:TM="" S PSGAPTM(TM)=TM
|
|
Q
|
|
;
|
|
C ;
|
|
K DIR S DIR(0)="FAO",DIR("A")="Select CLINIC: "
|
|
S DIR("?")="^D CDIC^PSGVBW" W ! D ^DIR
|
|
CDIC ;
|
|
K DIC S DIC="^SC(",DIC(0)="QEMIZ" D ^DIC K DIC S:+Y>0 CL=+Y
|
|
W:X["?" !!,"Enter the clinic you want to use to select patients for processing.",!
|
|
Q
|
|
;
|
|
P ; get patient
|
|
N PAT S PAT="" F S PAT=$O(PSJSEL("P",PAT)) Q:PAT="" S PSGP(PAT)=$O(PSJSEL("P",PAT,PSGP))
|
|
Q
|
|
;
|
|
PG ;
|
|
F PSGPRWD=0:0 S PSGPRWD=$O(^PS(57.5,"AC",PSGPRWG,PSGPRWD)) Q:'PSGPRWD I $D(^DIC(42,PSGPRWD,0)),$P(^(0),"^")]"" S PSGPRWDN=$P(^(0),"^") D
|
|
.F PSGP=0:0 S PSGP=$O(^DPT("CN",PSGPRWDN,PSGP)) Q:'PSGP D
|
|
..I RBP="R" S RB=$G(^DPT(PSGP,.101)) S:RB="" RB="zz" S ^TMP("PSGPR",$J,RB,PSGPRWDN,RB)=PSGP
|
|
..I RBP="P" D ^PSJAC S ^TMP("PSGPR",$J,PSGPRWDN,PSGP(0))=PSGP
|
|
I $D(^TMP("PSGPR",$J)) N PSGX S PSGX="^TMP(""PSGPR"",$J)" F S PSGX=$Q(@PSGX) Q:PSGX'[("""PSGPR"""_","_$J) S PSGP=$G(@PSGX) D PP0 Q:$G(X)?1"^"."^"
|
|
Q
|
|
;
|
|
PW ;
|
|
I $D(PSJSEL("TM")) S TM="" F S TM=$O(PSJSEL("TM",TM)) Q:TM="" S PSGPATM(TM)=TM
|
|
F PSGP=0:0 S PSGP=$O(^DPT("CN",PSGPRWDN,PSGP)) Q:'PSGP S RB=$G(^DPT(PSGP,.101)),TM="zz" D
|
|
.I '$D(PSGPATM) D SET Q
|
|
.S:RB]"" TM=$O(^PS(57.7,"AWRT",PSGPRWD,RB,0)) S:'TM TM="zz" I $D(PSGPATM("ALL"))!$D(PSGPATM(TM)) D SET Q
|
|
I $D(^TMP("PSGPR",$J)) N PSGX S PSGX="^TMP(""PSGPR"",$J)" F S PSGX=$Q(@PSGX) Q:PSGX'[("""PSGPR"""_","_$J) S PSGP=$G(@PSGX) D PP0 Q:$G(X)?1"^"."^"
|
|
Q
|
|
;
|
|
L ;
|
|
D L^PSGVBW
|
|
Q
|
|
;
|
|
PL S CL="" F S CL=$O(^PS(57.8,"AD",CG,CL)) Q:CL="" D PC
|
|
Q
|
|
;
|
|
PC S WDN=$S($D(^SC(CL,0)):$P(^(0),"^"),1:"")
|
|
S PSGP="" F S PSGP=$O(^PS(53.1,"AD",CL,PSGP)) Q:'PSGP S RB=$G(^DPT(PSGP,.101)),TM="zz" D
|
|
.D SET Q
|
|
I $D(^TMP("PSGPR",$J)) N PSGX S PSGX="^TMP(""PSGPR"",$J)" F S PSGX=$Q(@PSGX) Q:PSGX'[("""PSGPR"""_","_$J) S PSGP=$G(@PSGX) D PP0 Q:$G(X)?1"^"."^"
|
|
Q
|
|
;
|
|
SET ;
|
|
S:TM'["zz" TM=$G(^PS(57.7,$G(PSGPRWD),1,TM,0)) I RB="" S RB="z"
|
|
I RBP="P" D ^PSJAC S ^TMP("PSGPR",$J,TM,PSGP(0))=PSGP Q
|
|
I RBP="R" S ^TMP("PSGPR",$J,TM,RB)=PSGP
|
|
Q
|
|
;
|
|
PP ;
|
|
S PAT="" F S PAT=$O(PSGP(PAT)) Q:PAT="" S PSGP=PSGP(PAT) D PP0 Q:$G(X)?1"^"."^"
|
|
Q
|
|
;
|
|
PP0 ;
|
|
N PSJACNWP S PSJACNWP=1 D ^PSJAC I PSGPRP'="E" D ^PSGO I PSGPRP="P",'PSGPR D:'PSGON READ^PSJUTL Q:$G(X)?1"^"."^" I PSGON S (PSGONC,PSGONF,PSGONR,PSGONV,PSGPRF)=0 D ENVO^PSGOE0 K PSGPRF Q
|
|
Q:PSGPRP="P" I PSGPRP="E" U IO D ENGORD^PSGOU,ENPR^PSGO
|
|
I 'PSGPR,PSGSS'="P",'$D(^TMP("PSG",$J)) D READ^PSJUTL Q
|
|
S (S1,S2,S3,X)=""
|
|
F S S1=$O(^TMP("PSG",$J,S1)) Q:S1="" F S S2=$O(^TMP("PSG",$J,S1,S2)) Q:S2="" F S S3=$O(^TMP("PSG",$J,S1,S2,S3)) Q:S3="" D PP1
|
|
D:X'["^"&PSGPR BOT^PSGO K ^TMP("PSG",$J) Q
|
|
;
|
|
PP1 ;
|
|
;* S PSGORD=$P(S3,"^",2)_S1 D EN2^PSGVW I PSGPRA'="N" S AT=PSGPRA D ENA^PSGVW0
|
|
S PSGORD=$P(S3,"^",2)_$S(S1["BD":"",S1["B":"P",S1["CD":"",S1["C":"P",1:"U") D EN2^PSGVW I PSGPRA'="N" S AT=PSGPRA D ENA^PSGVW0
|
|
S X="" I 'PSGPR S DIR(0)="E" W ! D ^DIR S:$D(DIRUT) X="^" I X["^" S (S1,S2,S3)="~"
|
|
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 (DFN,PSGP)=+ORVP
|
|
ENLM N PSJNEW,PSGPTMP,PPAGE,PSGOEPRF S PSJNEW=1
|
|
S PSJOPC="UD",PSGPTMP=0,PPAGE=1
|
|
D ENCV^PSGSETU Q:$D(XQUIT)
|
|
S PSJSEL("SELECT")="P",PSJSEL("P",$P($G(^DPT(DFN,0)),U),DFN)="" D ^VADPT
|
|
D ^PSJAC,ENL^PSGOU I "^N"'[PSGOL D
|
|
.S PSGSS="P",(PSGPRWD,PSGPRWG)=0,(PSGPRWDN,PSGPRWGN)=""
|
|
.S PSGP(PSGP(0))=DFN K PSGP(0) D GO
|
|
S PSJNKF=1 D READ^PSJUTL G DONE
|