source: FOIAVistA/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXCE.m@ 1704

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

initial load of FOIAVistA 6/30/08 version
File size: 7.6 KB
Line 
1PXCE ;ISL/dee - Main routine for PCE's user interface ; 3/27/01 12:17pm
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**25,47,52,64,75,78,147,151,161**;Aug 12, 1996
3 ;
4 ;PXCEKEYS is a set of letters that enable the user
5 ; to enter certain fields
6 ; "P" is included if the user holds the AK.PROVIDER key.
7 ; "C" should be included by the option if the user should be
8 ; asked for the Provider Narrative Categories on V CPT, V POV,
9 ; and V TREATMENT files. As well as for other fields that are
10 ; not ask of the normal user.
11 ; "S" is for the superviser. If they have "S" then they will be
12 ; given "C" and "D" by the program.
13 ; "V" is for view only
14 ; And if it:
15 ; includes "D" to delete any V-File
16 ; includes "d" to only delete V-File entries this user created
17 ;
18 I '$D(PXCEKEYS)#2 N PXCEKEYS S PXCEKEYS=""
19 S:PXCEKEYS'["D" PXCEKEYS=PXCEKEYS_"D"
20 G START
21 ; -- main entry point for PCE's user interface
22EN1(PXCEKEYS) ;Does not checks for provider
23 G START1
24EN(PXCEKEYS) ;Checks for provider
25 ;
26START ;
27 ;Key for provider (P)
28 I PXCEKEYS'["P",$O(^VA(200,"AK.PROVIDER",$P(^VA(200,DUZ,0),"^"),""))=DUZ S PXCEKEYS=PXCEKEYS_"P"
29START1 ;
30 ;If they have the Key for superviser (S) make sure that they also
31 ; have C and D.
32 I PXCEKEYS["S" S:PXCEKEYS'["C" PXCEKEYS=PXCEKEYS_"C" S:PXCEKEYS'["D" PXCEKEYS=PXCEKEYS_"D"
33 ;
34 K I,X,SDB,XQORNOD,SDFN,SDCLN,DA,DR,DIE,DNM,DQ,%B
35 N PXCEVIEW,SDAMTYP
36 N PXCEPAT,PXCEHLOC
37 N PXCEDBEG,PXCEDEND,PXCE9BEG,PXCE9END,SDBEG,SDEND
38 N PXCEDBP,PXCEDBHL,PXCEDEP,PXCEDEHL
39 N PXCECONT
40 N PXCESOR,PXCEPKG
41 I $G(DFN)'>0 N DFN
42 ;
43 S PXCEVIEW="^"_$S("~V~A~"["~"_$P(^PX(815,1,"LM"),"^",2)_"~":$P(^PX(815,1,"LM"),"^",2),1:"V")_"^"
44 S PXCESOR=$$SOURCE^PXAPIUTL("PXCE DATA ENTRY")
45 S PXCEPKG=$$PKG2IEN^VSIT("PX")
46 ;
47 K DIRUT
48 D SETUP Q:$D(DIRUT)
49 ;
50 F D Q:$D(PXCEVIEW)'=1!'$D(PXCECONT)
51 . K PXCECONT
52 . I PXCEKEYS["V" D
53 .. I PXCEVIEW["A" D
54 ... D EN^VALM("PXCE SDAM VIEW ONLY")
55 .. E D EN^VALM("PXCE VIEW ONLY")
56 . E I PXCEVIEW["A" D
57 .. D EN^VALM("PXCE SDAM MENU")
58 . E D EN^VALM("PXCE MAIN MENU")
59 D FULL^VALM1
60 D EXITALL
61 Q
62 ;
63SETUP ;
64 N DIR,DA,X,Y,PXRES
65 N PXCEUSEL,X1,X2
66 I $G(DFN)>0 S PXCEUSEL=DFN_"^DPT("
67 E S DIR(0)="815,201",DIR("A")="Select Patient or Clinic name" D ^DIR K DIR,DA Q:$D(DIRUT) S PXCEUSEL=Y
68 S X1=DT,X2=$S($P(^PX(815,1,"LM"),"^",3)]"":$P(^PX(815,1,"LM"),"^",3),1:-30) D C^%DTC
69 S PXCEDBP=X
70 S X1=DT,X2=$S($P(^PX(815,1,"LM"),"^",4)]"":$P(^PX(815,1,"LM"),"^",4),1:0) D C^%DTC
71 S PXCEDEP=X
72 S X1=DT,X2=$S($P(^PX(815,1,"LM"),"^",5)]"":$P(^PX(815,1,"LM"),"^",5),1:-7) D C^%DTC
73 S PXCEDBHL=X
74 S X1=DT,X2=$S($P(^PX(815,1,"LM"),"^",6)]"":$P(^PX(815,1,"LM"),"^",6),1:0) D C^%DTC
75 S PXCEDEHL=X
76 I PXCEUSEL["DPT(" S $P(PXCEVIEW,"^",1)="P" S SDAMTYP="P"
77 I PXCEUSEL["SC(" S $P(PXCEVIEW,"^",1)="H" S SDAMTYP="C" D I 'PXRES G SETUP
78 .S PXRES=$$CLNCK^SDUTL2(+PXCEUSEL,1)
79 .I 'PXRES W !,?5,"Clinic MUST be corrected before continuing."
80 D SETDATES
81 I PXCEUSEL["DPT(" S PXCEPAT=+PXCEUSEL,FSEL=1 D NEWPAT1^PXCEPAT K FSEL G:$D(DIRUT) SETUP
82 I PXCEUSEL["SC(" S PXCEHLOC=+PXCEUSEL D NEWHOSL1^PXCENEW
83 Q
84 ;
85SETDATES ;
86 I PXCEVIEW["H" D
87 . S PXCEDBEG=PXCEDBHL
88 . S PXCEDEND=PXCEDEHL
89 E D
90 . S PXCEDBEG=PXCEDBP
91 . S PXCEDEND=PXCEDEP
92 D DATE9S^PXCEDATE
93 Q
94 ;
95HDR ; -- header code
96 K VALMHDR,PXLNX,PXPCP
97 S PXLNX=1,PXPCP=""
98 ;
99 ;PATIENT
100 I PXCEVIEW["P" D
101 . S PXPCP=$$PCLINE^SDPPTEM(PXCEPAT,DT)
102 . S VALMHDR(PXLNX)=$E(PXCEPAT("NAME"),1,26)
103 . S VALMHDR(PXLNX)=$E(VALMHDR(PXLNX)_$E(" ",1,(27-$L(VALMHDR(PXLNX))))_PXCEPAT("SSN")_" ",1,40)
104 E S VALMHDR(PXLNX)=" "
105 ;LOCATION
106 S VALMHDR(PXLNX)=VALMHDR(PXLNX)_"Clinic: "_$S($G(PXCEHLOC)&(PXCEVIEW'["P^A"):$P(^SC(PXCEHLOC,0),"^"),1:"All")
107 S PXLNX=PXLNX+1
108 I $L(PXPCP) S VALMHDR(PXLNX)=PXPCP,PXLNX=PXLNX+1
109 ;
110 ;DATE
111 S VALMHDR(PXLNX)=$E("Date range: "_$$FMTE^XLFDT(PXCEDBEG,5)_" to "_$$FMTE^XLFDT(PXCEDEND,5)_$J("",40),1,40)
112 ;
113 ;Credit Stop
114 S:PXCEVIEW["A" VALMHDR(PXLNX)=VALMHDR(PXLNX)_$P($G(SDAMLIST),"^",2)
115 S PXLNX=PXLNX+1
116 ;
117 ;CHECK IF GAF NEEDED
118 I PXCEVIEW'["P",$$MHCLIN^SDUTL2(PXCEHLOC) S VALMHDR(PXLNX)=$$SETSTR^VALM1("* - New GAF Score Required","",25,80)
119 I PXCEVIEW["P" D
120 .S VALMHDR(PXLNX)=$$SETSTR^VALM1("* - New GAF Score Required","",25,80)
121 .N PXCEHLC,PXCESTA
122 .K PXCEHIT
123 .S PXCESTA=$$ELSTAT^SDUTL2(PXCEPAT)
124 .S PXCEZZ=0
125 .F S PXCEZZ=$O(^TMP("PXCEIDX",$J,PXCEZZ)) Q:PXCEZZ'>0 D Q:$D(PXCEHIT)
126 ..S PXCEHLC=+$P($G(^AUPNVSIT(^TMP("PXCEIDX",$J,PXCEZZ),0)),"^",22)
127 ..I $$MHCLIN^SDUTL2(PXCEHLC),'$$COLLAT^SDUTL2(PXCESTA) D
128 ...S PXCEGAF=$$NEWGAF^SDUTL2($S($D(SDFN):SDFN,$D(PXCEPAT):PXCEPAT,1:""))
129 ...S PXCEGST=$P(PXCEGAF,"^")
130 ...I PXCEGST D
131 ....S PXCEGDT=$$FMTE^XLFDT($P(PXCEGAF,"^",3),"5M"),PXCEGSC=$P(PXCEGAF,"^",2),PXCEGPR=$P(PXCEGAF,"^",4)
132 ....S VALMHDR(PXLNX)="GAF Date: "_PXCEGDT_" GAF Score:"_PXCEGSC_" NEW REQ",PXCEHIT=1
133 ;
134 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
135 Q
136 ;
137INIT ; -- init variables and list array
138 D MAKELIST^PXCENEW
139 Q
140 ;
141EXIT ; -- exit code
142 D FULL^VALM1
143 D CLEAN^VALM10
144 K ^TMP("PXCE",$J)
145 K ^TMP("PXCEIDX",$J)
146 D FNL^PXCESDAM
147 Q
148 ;
149EXITALL ; Exit of whole program
150 D PATKILL^PXCEPAT
151 D KVA^VADPT
152 Q
153 ;
154DONE ; -- exit action for protocol
155 S:'$D(VALMBCK) VALMBCK="R"
156 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
157 Q
158 ;
159EXPND ; -- expand code
160 D EN^PXCEEXP
161 Q
162 ;
163SEL1(HELP,PXCEADD) ; Select 1 visit
164 ; If the $GET(PXCEADD) is non zero then will
165 ; add to the prompt "add a new encounter"
166 N X,Y,MAX
167 S MAX=+$G(^TMP("PXCEIDX",$J,0)) I MAX'>0 Q "^"
168 S Y=$P($P(XQORNOD(0),"^",4),"=",2)
169 I Y]"" D
170 . I (+Y'=Y)!(+Y>MAX)!(+Y<1)!(Y#1'=0) D
171 .. W !,$C(7),"Selection '",Y,"' is not a valid choice."
172 .. D PAUSE^PXCEHELP
173 .. S Y="^"
174 E I '$G(PXCEADD) D
175 . N DIR,DA
176 . S DIR(0)="NAO^1:"_MAX_":0",DIR("A")="Select Encounter"
177 . S:MAX>1 DIR("A")=DIR("A")_" (1-"_MAX_"): "
178 . S:MAX'>1 DIR("A")=DIR("A")_": ",DIR("B")=1
179 . S DIR("?")="Enter the number of the Encounter you wish to "
180 . S DIR("?")=DIR("?")_$S($L(HELP):HELP,1:"act on")
181 . D ^DIR I $D(DTOUT)!(X="") S Y="^"
182 E D
183 . N DIR,DA
184ASKLOOP . S DIR(0)="FAO^1:"_$L(MAX)
185 . S DIR("A")="Enter 1-"_MAX_" to Edit, or 'A' to Add: "
186 . S DIR("?")="Enter the number of the Encounter you wish "
187 . S DIR("?")=DIR("?")_$S($L(HELP):HELP,1:"act on")_" or A to "
188 . S DIR("?")=DIR("?")_$S($L(HELP):HELP,1:"act on")_" add a new Encounter"
189 . D ^DIR
190 . K DIR,DA
191 . I $D(DIRUT)!(X="") S Y="^" Q
192 . I "Aa"[Y S Y="A" Q
193 . G:Y<1!(Y>MAX) ASKLOOP
194 Q Y
195 ;
196GAF ;;
197 N PXCEVIEN,PXDFN,PXDSS,PXELIG,PXDATA
198 I $G(PXCEHLOC),'$$MHCLIN^SDUTL2(PXCEHLOC) D G SKIP
199 . S DIR(0)="FOA"
200 . S DIR("A",1)=" This is not a Mental Health Clinic, a GAF Score may not be entered."
201 . S DIR("A")=" Press any key to continue: "
202 . D ^DIR K DIR
203 ;
204 I $D(^TMP("PXCEIDX",$J)) D GETVIEN^PXCEAE
205 I $D(^TMP("SDAMIDX",$J)) S PXCEVIEN=$$SELAPPM^PXCESDAM
206 I '($G(PXCEVIEN)]"")!($G(PXCEVIEN)=-1) D S VALMBCK="R" Q
207 . S DIR(0)="FAO"
208 . I '($G(PXCEVIEN)]"") S DIR("A",1)="Nothing to select."
209 . I $G(PXCEVIEN)=-1 S DIR("A",1)="No selections made."
210 . S DIR("A")="Press any key to continue."
211 . D ^DIR K DIR
212 S PXDFN=$P($G(^AUPNVSIT(PXCEVIEN,0)),"^",5)
213 S PXDSS=$P($G(^AUPNVSIT(PXCEVIEN,0)),"^",8)
214 S PXDATA=$G(^DPT(PXDFN,"S",$P(^AUPNVSIT(PXCEVIEN,0),U),0))
215 S PXELIG=$$ELSTAT^SDUTL2(PXDFN)
216 I $$MHCLIN^SDUTL2("",PXDSS),'($$COLLAT^SDUTL2(PXELIG)!$P(PXDATA,U,11)) D
217 . S PXGAF=$$NEWGAF^SDUTL2(PXDFN)
218 . D FULL^VALM1
219 . W !
220 . I +$P(PXGAF,U,5)>0 W !,"Warning: Patient is deceased."
221 . W !,"Current GAF: "_+$P(PXGAF,U,2)
222 . W $S($P(PXGAF,U,3)>0:", from "_$$FMTE^XLFDT($P(PXGAF,U,3),"D"),1:", Date Unavailable")
223 . D EN^SDGAF(PXDFN)
224 E D
225 . S DIR(0)="FOA"
226 . S DIR("A",1)="A GAF Score is not required for this appointment!"
227 . S DIR("A")="Press any key to continue: "
228 . D ^DIR K DIR
229 ;
230SKIP S VALMBCK="R"
231GAFQ Q
232 ;
Note: See TracBrowser for help on using the repository browser.