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

Last change on this file since 691 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 6.0 KB
Line 
1PSGPR ;BIR/CML3-PATIENT PROFILE ;19 SEP 96 / 3:59 PM
2 ;;5.0; INPATIENT MEDICATIONS ;**110,111,169**;16 DEC 97
3 ;* N PSJNEW,PSGPTMP,PPAGE,PSGOEPRF S PSJNEW=1
4 N PSGLI,PSGOE,PSGOEEWF,PSGOH,PSGWD,PSJPWDO,PSJSTOP,PSJTEAM
5 N ACTION,CONT,PAT,LD,LN2,PFLG,PSJNEW,PSGPTMP,PPAGE,PSGOEPRF S PSJNEW=1
6 ;
7 S PSJOPC="UD"
8 D ENCV^PSGSETU
9 ;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
10 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"))
11 .K PSJSEL,Y F K ^TMP("PSJSELECT",$J),PSJSEL D ^PSGSEL Q:"^"[PSGSS S PSJSEL("SELECT")=PSGSS,PSJSTOP="" D
12 ..D:(PSJSEL("SELECT")="P") P^PSJPDIR D:(PSJSEL("SELECT")="W") W^PSJPDIR D:(PSJSEL("SELECT")="G") G^PSJPDIR
13 ..; PSJ*5*169 Check PSJSTOP before continuing.
14 ..Q:$G(PSJSTOP)=1
15 ..I PSJSEL("SELECT")'="P",PSJSEL("SELECT")'="L" D RBPPN^PSJPDIR
16 ..Q:$G(PSJSTOP)=1
17 ..Q:(((PSGSS="W")!(PSGSS="G"))&($G(Y)<0)) Q:((PSGSS="P")&'$D(PSJSEL("P")))
18 ..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
19 ;
20DONE ;
21 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)
22 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
23 Q
24 ;
25GO ;
26 S PSGPRP="P",PSGPRA="" S PSGSS=PSJSEL("SELECT") G:PSGSS'="P" ENDEV
27 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
28 I "EB"[PSGPRP F R !!,"Show SHORT, LONG, or NO activity log? NO// ",AT:DTIME D ALC^PSGVW0 I Q S PSGPRA=AT Q
29 Q:PSGPRA="^"
30ENDEV ;
31 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)=""
32 D ENDEV^PSGTI I POP!$D(IO("Q")) G:$D(PSGOEPRF) DONE Q
33 ;
34ENQ ;
35 K ^TMP("PSGPR",$J)
36 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
37 G:$D(PSGOEPRF) DONE Q
38 ;
39G ; get ward group
40 S PSGPRWG=+PSJSEL("WG"),PSGPRWGN=$P(PSJSEL("WG"),"^",2) Q
41 ;
42W ; get ward
43 S PSGPRWD=+PSJSEL("W"),PSGPRWDN=$P(PSJSEL("W"),"^",2)
44 I $D(PSJSEL("TM")) S TM="" F S TM=$O(PSJSEL("TM",TM)) Q:TM="" S PSGAPTM(TM)=TM
45 Q
46 ;
47C ;
48 K DIR S DIR(0)="FAO",DIR("A")="Select CLINIC: "
49 S DIR("?")="^D CDIC^PSGVBW" W ! D ^DIR
50CDIC ;
51 K DIC S DIC="^SC(",DIC(0)="QEMIZ" D ^DIC K DIC S:+Y>0 CL=+Y
52 W:X["?" !!,"Enter the clinic you want to use to select patients for processing.",!
53 Q
54 ;
55P ; get patient
56 N PAT S PAT="" F S PAT=$O(PSJSEL("P",PAT)) Q:PAT="" S PSGP(PAT)=$O(PSJSEL("P",PAT,PSGP))
57 Q
58 ;
59PG ;
60 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
61 .F PSGP=0:0 S PSGP=$O(^DPT("CN",PSGPRWDN,PSGP)) Q:'PSGP D
62 ..I RBP="R" S RB=$G(^DPT(PSGP,.101)) S:RB="" RB="zz" S ^TMP("PSGPR",$J,RB,PSGPRWDN,RB)=PSGP
63 ..I RBP="P" D ^PSJAC S ^TMP("PSGPR",$J,PSGPRWDN,PSGP(0))=PSGP
64 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"^"."^"
65 Q
66 ;
67PW ;
68 I $D(PSJSEL("TM")) S TM="" F S TM=$O(PSJSEL("TM",TM)) Q:TM="" S PSGPATM(TM)=TM
69 F PSGP=0:0 S PSGP=$O(^DPT("CN",PSGPRWDN,PSGP)) Q:'PSGP S RB=$G(^DPT(PSGP,.101)),TM="zz" D
70 .I '$D(PSGPATM) D SET Q
71 .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
72 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"^"."^"
73 Q
74 ;
75L ;
76 D L^PSGVBW
77 Q
78 ;
79PL S CL="" F S CL=$O(^PS(57.8,"AD",CG,CL)) Q:CL="" D PC
80 Q
81 ;
82PC S WDN=$S($D(^SC(CL,0)):$P(^(0),"^"),1:"")
83 S PSGP="" F S PSGP=$O(^PS(53.1,"AD",CL,PSGP)) Q:'PSGP S RB=$G(^DPT(PSGP,.101)),TM="zz" D
84 .D SET Q
85 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"^"."^"
86 Q
87 ;
88SET ;
89 S:TM'["zz" TM=$G(^PS(57.7,$G(PSGPRWD),1,TM,0)) I RB="" S RB="z"
90 I RBP="P" D ^PSJAC S ^TMP("PSGPR",$J,TM,PSGP(0))=PSGP Q
91 I RBP="R" S ^TMP("PSGPR",$J,TM,RB)=PSGP
92 Q
93 ;
94PP ;
95 S PAT="" F S PAT=$O(PSGP(PAT)) Q:PAT="" S PSGP=PSGP(PAT) D PP0 Q:$G(X)?1"^"."^"
96 Q
97 ;
98PP0 ;
99 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
100 Q:PSGPRP="P" I PSGPRP="E" U IO D ENGORD^PSGOU,ENPR^PSGO
101 I 'PSGPR,PSGSS'="P",'$D(^TMP("PSG",$J)) D READ^PSJUTL Q
102 S (S1,S2,S3,X)=""
103 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
104 D:X'["^"&PSGPR BOT^PSGO K ^TMP("PSG",$J) Q
105 ;
106PP1 ;
107 ;* S PSGORD=$P(S3,"^",2)_S1 D EN2^PSGVW I PSGPRA'="N" S AT=PSGPRA D ENA^PSGVW0
108 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
109 S X="" I 'PSGPR S DIR(0)="E" W ! D ^DIR S:$D(DIRUT) X="^" I X["^" S (S1,S2,S3)="~"
110 Q
111 ;
112PH ;
113 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."
114 W " Enter an '^'to exit." Q
115 ;
116ENOR S (DFN,PSGP)=+ORVP
117ENLM N PSJNEW,PSGPTMP,PPAGE,PSGOEPRF S PSJNEW=1
118 S PSJOPC="UD",PSGPTMP=0,PPAGE=1
119 D ENCV^PSGSETU Q:$D(XQUIT)
120 S PSJSEL("SELECT")="P",PSJSEL("P",$P($G(^DPT(DFN,0)),U),DFN)="" D ^VADPT
121 D ^PSJAC,ENL^PSGOU I "^N"'[PSGOL D
122 .S PSGSS="P",(PSGPRWD,PSGPRWG)=0,(PSGPRWDN,PSGPRWGN)=""
123 .S PSGP(PSGP(0))=DFN K PSGP(0) D GO
124 S PSJNKF=1 D READ^PSJUTL G DONE
Note: See TracBrowser for help on using the repository browser.