source: FOIAVistA/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECUTL0.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 4.8 KB
Line 
1ECUTL0 ;ALB/ESD - Event Capture Eligibility and In/Outpat Utilities ;4 May 98
2 ;;2.0; EVENT CAPTURE ;**10**;8 May 96
3 ;
4 ;
5CHKDSS(DSSU,INOUT) ; Determine if DSS Unit is sending data to PCE
6 ;
7 ; Input:
8 ; DSSU - DSS Unit IEN
9 ; INOUT - Inpatient or Outpatient
10 ;
11 ; Output:
12 ; Function Value - 0 if DSS Unit not sending to PCE or input
13 ; parameters not passed in
14 ; 1 if DSS Unit sending to PCE
15 ;
16 N ECDSS,ECSEND
17 ;
18 ;- Drops out if invalid condition
19 D
20 . I '$G(DSSU),($G(INOUT)="") S ECDSS=0 Q
21 .;
22 .;- Get 'Send to PCE' field
23 . S ECSEND=$P($G(^ECD(+DSSU,0)),"^",14)
24 . I ECSEND="A"!(ECSEND="O"&(INOUT="O")) S ECDSS=1
25 . E S ECDSS=0
26 Q ECDSS
27 ;
28 ;
29ELGLST() ; Display list of patient eligibilities and allow user to
30 ; select eligibility, given ELIG^VADPT has been previously called.
31 ;
32 ; Input:
33 ; None
34 ; Output:
35 ; Function value - IEN of eligibility from ELIGIBILITY CODE file
36 ; (#8) or 0 if unsuccessful
37 ;
38 N ECALLEL,ECELIEN,ECELIG,ECPRIMEL
39 S (ECELIEN,ECELIG)=0
40 ;
41 ;- If VAEL not previously called, exit with error condition
42 I '$D(VAEL)!('$G(VAEL(1))) G ELGLSTQ
43ELIG S ECALLEL=""
44 S ECPRIMEL=$P(VAEL(1),"^",2)
45 W !!,"THIS PATIENT HAS OTHER ENTITLED ELIGIBILITIES:"
46 ;
47 ;- Display all of patient's eligibilities
48 F ECELIEN=0:0 S ECELIEN=$O(VAEL(1,ECELIEN)) Q:'ECELIEN D
49 . W !?5,$P(VAEL(1,ECELIEN),"^",2)
50 . S ECALLEL=ECALLEL_"^"_$P(VAEL(1,ECELIEN),"^",2)
51 ;
52 ;- Use patient's primary elig as default
53CHOOSE W !!,"ENTER THE ELIGIBILITY FOR THIS APPOINTMENT: "_ECPRIMEL_"// "
54 ;
55 ;- If return, uparrow, or time out get prim elig w/o searching for match
56 R X:DTIME G PRIMELG:"^"[X!('$T) S X=$$UPPER^VALM1(X) G ELIG:X["?",CHOOSE:ECALLEL'[("^"_X)
57 S ECPRIMEL=X_$P($P(ECALLEL,"^"_X,2),"^")
58 W $P($P(ECALLEL,"^"_X,2),"^")
59 ;
60 ;- If match found, exit with eligibility IEN from file #8
61 F ECELIEN=0:0 S ECELIEN=$O(VAEL(1,ECELIEN)) Q:'ECELIEN I $P(VAEL(1,ECELIEN),"^",2)=ECPRIMEL S ECELIG=+ECELIEN G ELGLSTQ
62 ;
63 ;- If default or error cond exit with IEN of primary elig from file #8
64PRIMELG I ('$T)!(X["^") D ELIGERR^ECUTL0
65 I ('$T)!(X["^")!($P(VAEL(1),"^",2)=ECPRIMEL) S ECELIG=+$P(VAEL(1),"^")
66 ;
67ELGLSTQ Q ECELIG
68 ;
69 ;
70MULTELG(DFN) ; Determine if patient has multiple eligibilites (calls
71 ; ELIG^VADPT).
72 ;
73 ; Input:
74 ; DFN - IEN of Patient file (#2)
75 ; Output:
76 ; Function value - 0 if no additional eligibilities exist,
77 ; otherwise a number greater than 0 if addt'l eligibilities exist
78 ;
79 D ELIG^VADPT
80 Q +$O(VAEL(1,0))
81 ;
82 ;
83ASKIF(ELIGNM) ; Ask user whether to edit the eligibility during the edit
84 ; of an existing EC Patient file (#721) record
85 ;
86 ; Input:
87 ; ELIGNM - Eligibility Name
88 ;
89 ; Output:
90 ; Function value - 1 if user wants to edit eligibility
91 ; 0 if user does not want to edit eligibility
92 ; -1 if uparrow or time out
93 ;
94 N DIR
95 Q:$G(ELIGNM)="" 0
96 ;- Display patient's current eligibility
97 W !!,"The eligibility previously filed for this patient's procedure is:",!?5,ELIGNM,!!
98 ;- Ask user
99 S DIR(0)="YA"
100 S DIR("A")="Do you wish to edit the patient's eligibility? "
101 S DIR("B")="NO"
102 D ^DIR
103 Q $S($D(DIRUT):-1,'Y:0,1:Y)
104 ;
105 ;
106ELIGERR ; If user uparrows or times out while choosing eligibility, display
107 ; primary eligibility msg to screen
108 ;
109 ; Input:
110 ; None
111 ;
112 ; Output:
113 ; Display primary eligibility message to screen
114 ;
115 W !!?5,"No eligibility entered. The primary eligibility of the patient"
116 W !?5,"will be sent to PCE for workload reporting (if the patient's"
117 W !?5,"procedure data is complete).",!
118 Q
119 ;
120 ;
121INOUTPT(DFN,PROCDT) ; Determine inpatient/outpatient status
122 ;
123 ; Input:
124 ; DFN - IEN of Patient file (#2)
125 ; PROCDT - Procedure Date/Time
126 ;
127 ; Output:
128 ; Function value - I if inpatient, O if outpatient, null if error
129 ;
130 N ECPTSTAT
131 S ECPTSTAT=1
132 I '$G(DFN)!('$G(PROCDT)) S ECPTSTAT=0
133 ;
134 ;- Call inpat/outpat function if both input variables are present
135 I ECPTSTAT D
136 . S ECPTSTAT=$$INP^SDAM2(DFN,PROCDT)
137 . I $G(ECPTSTAT)="" S ECPTSTAT="O"
138 ;
139 ;- If either one of input variables are missing, return null (otherwise
140 ; return "I" or "O")
141 Q $S(ECPTSTAT=0:"",1:ECPTSTAT)
142 ;
143 ;
144DSPSTAT(ECSTAT) ; Display inpatient/outpatient status
145 ;
146 ; Input:
147 ; ECSTAT - Inpatient/Outpatient status (I=inpatient, O=outpatient)
148 ;
149 ; Output:
150 ; Display inpatient/outpatient status to screen
151 ;
152 N ECTXT
153 S ECTXT="This patient is an "
154 W !!,ECTXT_$S(ECSTAT="I":"Inpatient",1:"Outpatient"),!
155 Q
156 ;
157 ;
158INOUTERR ; Display inpat/outpat status error msg to screen and set exit
159 ; variable
160 ;
161 ; Input:
162 ; None
163 ;
164 ; Output:
165 ; Display error message to screen
166 ;
167 W !,"Patient record data or procedure date/time data is missing. No action taken."
168 S ECOUT=1
169 Q
Note: See TracBrowser for help on using the repository browser.