source: FOIAVistA/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASUER.m@ 847

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

initial load of FOIAVistA 6/30/08 version
File size: 6.2 KB
Line 
1EASUER ;ALB/CKN - GEOGRAPHIC MEANS TEST PHASE II ; 03-MAR-2003
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**25,37,50,55**;Mar 15, 2001
3 ;This routine contains several APIs that will be called from
4 ;different packages like Scheduling, PCE and Fee basis to notify
5 ;Enrollment package whenever any inpatient/outpatient encounter occurs,
6 ;or any appointment made or any changes made to fee basis authorization.
7 Q
8SCHED ;This API will be called from SDAM APPOINTMENT EVENTS via EAS UE SCHED
9 ;EVENT protocol whenever any changes made to veteran's appointment.
10 ;Input variables used in this api:
11 ; SDATA - piece 1 - ien of multiple entry of the
12 ; APPOINTMENTS multiple of the
13 ; HOSPITAL LOCATION file.
14 ; piece 2 - ien of PATIENT file (DFN)
15 ; piece 3 - internal Date/time of appt.
16 ; piece 4 - ien of clinic in the HOSPITAL
17 ; LOCATION file.
18 ; SDAMEVT - ien pointing to an entry in the APPOINTMENT
19 ; TRANSACTION file (#409.66).
20 ;
21 N DFN,APT,APTDT
22 S DFN=$P($G(SDATA),"^",2) Q:DFN="" ;Veteran's IEN
23 I $G(SDAMEVT)=1 D ;if new appointment is made
24 . S APTDT=$P($G(SDATA),"^",3),APTDT=$$FY(APTDT)
25 . ;check current User Enrollee data and update it if necessary.
26 . I $$UPDCHK(DFN,APTDT) D FILE(DFN,APTDT)
27 Q
28ENC ;This API will be called from PXK VISIT DATA EVENT via EAS UE PCE EVENT
29 ;whenever any inpatient/outpatient encounter occurs.
30 ;Input:
31 ;^TMP("PXKCO",$J,VISIT,"V FILE STRING",V FILE RECORD,DDSUBSCRIPT,"AFTER/BEFORE")=DATA
32 ;where: subscript piece 1 - string notation representing package "PXKCO"
33 ; subscript piece 2 - Job number ($J)
34 ; subscript piece 3 - ien of VISIT file
35 ; subscript piece 4 - string representing the VISIT or V file
36 ; data category
37 ; subscript piece 5 - ien of the entry in the file represented in
38 ; subscript #4
39 ; subscript piece 6 - subscript or DD node on which the data is stored.
40 ; subscript piece 7 - string designating whether or not the data
41 ; is an "after" or "before" reflection of data.
42 ;
43 N VSIT,NODE,DFN,VDT
44 I '$D(^TMP("PXKCO",$J)) Q
45 S VSIT=$O(^TMP("PXKCO",$J,"")) Q:VSIT="" ;ien of VISIT file
46 S NODE=$G(^AUPNVSIT(VSIT,0))
47 ;get Veteran's IEN and encounter date
48 S DFN=$P($G(NODE),"^",5),VDT=$P($G(NODE),"^",1)
49 S VDT=$$FY(VDT)
50 ;check current User Enrollee data and update if necessary
51 I $$UPDCHK(DFN,VDT) D FILE(DFN,VDT)
52 Q
53FBAUTH(FBDFN,FBTODT) ;This Enrollment api will be called from Fee basis
54 ;applications at the time of any fee basis authorization changes.
55 ;Input: FBDFN - Veteran's ien
56 ; FBTODT - Latest date of authorization.
57 ;
58 N XDT
59 S XDT=$$FY(FBTODT)
60 I $$UPDCHK(FBDFN,XDT) D FILE(FBDFN,XDT)
61 Q
62INP ;This Enrollment api will be called from DGPM MOVEMENT EVENT via
63 ;EAS UE INP EVENT protocol whenever inpatient veteran is admitted,
64 ;transfered,discharged or any movement.
65 ;supported variables of this event:
66 ; DFN - Pointer to patient in PATIENT file (#2)
67 ; DGPMDA - Pointer to primary movement in PATIENT MOVEMENT file.
68 ; DGPMP - Zero node of primary movement prior to add/edit/del
69 ; DGPMA - Zero node of primary movement after add/edit/delete
70 ;
71 N XDT
72 I '$G(DFN)!'$G(DGPMDA) Q
73 S XDT=$P($G(^DGPM(DGPMDA,0)),"^") ;Date of movement
74 S XDT=$$FY(XDT) I $$UPDCHK(DFN,XDT) D FILE(DFN,XDT)
75 Q
76UESTAT(DFN) ;This api will be called at the time of Annual MT renewal
77 ;process to check if veteran has UE status for current FY.
78 N UESTAT,UESITE,UESTN,CURSTN,PRNT,CHILD,CIEN
79 I '$G(DFN) Q 0 ;No DFN
80 S UESTAT=$P($G(^DPT(DFN,.361)),"^",7)
81 I UESTAT="" Q 0 ;Not User Enrollee
82 I UESTAT<$$FY(DT) Q 0 ;Not User Enrollee for current FY
83 S UESITE=$P($G(^DPT(DFN,.361)),"^",8) Q:+UESITE=0 0
84 ; *** Modifications for patch 55 to handle VISN or HCS UE Sites
85 S UESTN=$$STA^XUAF4(UESITE)
86 S CURSTN=$P($$SITE^VASITE,"^",3)
87 ;
88 I UESTN']"" D
89 . D CHILDREN^XUAF4("CHILD","`"_UESITE,"PARENT FACILITY")
90 . S CIEN=0 F S CIEN=$O(CHILD("C",CIEN)) Q:'CIEN I CIEN=CURSTN S UESTN=$$STA^XUAF4(CIEN) Q
91 . I UESTN']"" D
92 . . D CHILDREN^XUAF4("CHILD","`"_UESITE,"VISN")
93 . . S CIEN=0 F S CIEN=$O(CHILD("C",CIEN)) Q:'CIEN I CIEN=CURSTN S UESTN=$$STA^XUAF4(CIEN) Q
94 ;
95 S PRNT=$$PSITE(CURSTN),CURSTN=$$STA^XUAF4(PRNT)
96 I UESTN'=CURSTN Q 2 ;Not same site
97 Q 1
98UPDCHK(DFN,APTDT) ;This api will determine whether to update User Enrollee data.
99 I '$G(DFN) Q 0 ;No DFN
100 I $P($G(^DPT(DFN,"VET")),"^")="N" Q 0 ;Quit if Non veteran
101 I APTDT<3030000 Q 0 ;Quit if APTDT is less than FY 2003
102 N CURSTAT
103 S CURSTAT=$P($G(^DPT(DFN,.361)),"^",7)
104 I APTDT>CURSTAT Q 1
105 Q 0
106FY(XDATE) ;Returns a fiscal year for the date
107 N ENFY S ENFY=""
108 I $G(XDATE)?7N.E S ENFY=$S($E(XDATE,4,5)<10:$E(XDATE,1,3),1:$E(XDATE,1,3)+1)
109 Q ENFY_"0000"
110 ;
111PSITE(STA) ;Get parent site IEN
112 N PRNT,PRNTYP
113 ;
114 S PRNT=0
115 ; First pass, get the parent facility, then get the facility type for the parent
116 ; If the parent is a VAMC, then quit returning parent
117 ; If the parent is either a VISN or HCS type, then return the current station, not the parent
118 ;
119 S PRNT=+$$PRNT^XUAF4(STA)
120 I PRNT>0 D
121 . S PRNTYP=$$GET1^DIQ(4,PRNT,13)
122 . I PRNTYP="VAMC" Q
123 . I "HCS,VISN"[PRNTYP S PRNT=STA Q
124 E D
125 . I $$GET1^DIQ(4,STA,13)="VAMC" S PRNT=STA Q
126 . E S REVSTA=$E(STA,1,3),PRNT=+$$PRNT^XUAF4(REVSTA) D
127 . . I $$GET1^DIQ(4,PRNT,13)="VAMC" Q
128 . . S PRNT=+$O(^DIC(4,"D",REVSTA,""))
129 Q PRNT
130 ;
131CHKPRNT(PRNT) ; Check if parent is a VISN entity, removed with Patch 50
132 Q 0
133 ;
134FILE(XIEN,XDT) ;Update User Enrollee fields and queue Z07
135 N DATA,FILEUPD,SITE,PRNT,EVENT,IYR
136 S SITE=$$SITE^VASITE,SITE=$P($G(SITE),"^",3)
137 S PRNT=$$PSITE(SITE) Q:'+$G(PRNT)
138 S DATA(.3617)=XDT,DATA(.3618)=PRNT
139 I '$$UPD^DGENDBS(2,.XIEN,.DATA) Q
140 S IYR=$$INCYR(XIEN)
141 S EVENT("ENROLL")=1 I $$LOG^IVMPLOG(XIEN,IYR,.EVENT)
142 Q
143INCYR(XIEN) ;Get valid income year
144 ;N INCYR,LMT,R3015,I,TEMP
145 I $D(^IVM(301.5,"APT",XIEN)) D Q INCYR
146 . S INCYR=$O(^IVM(301.5,"APT",XIEN,""),-1)
147 F I=1,2,4 D
148 . S LMT=$$LST^DGMTU(XIEN,,I)
149 . I +$G(LMT) S TEMP($P(LMT,"^",2))=""
150 I $D(TEMP) S LMT=$O(TEMP(""),-1),INCYR=($E(LMT,1,3)-1)_"0000" Q INCYR
151 S INCYR=($E(DT,1,3)-1)_"0000"
152 Q INCYR
Note: See TracBrowser for help on using the repository browser.