source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGENUPL8.m@ 724

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

initial load of WorldVistAEHR

File size: 5.5 KB
Line 
1DGENUPL8 ;ISA/KWP,RTK,PHH - PROCESS INCOMING (Z11 EVENT TYPE) HL7 MESSAGES ; 4/25/03 9:21am
2 ;;5.3;REGISTRATION;**232,266,327,314,365,417,514**;Aug 13,1993
3 ;Moved ENRUPLD from DGENUPL3
4 ;
5ENRUPLD(DGENR,DGPAT) ;
6 ;Description: uploads an enrollment receieved from HEC. The consistency
7 ;checks are assumed to have been done, the other patient and eligibility
8 ;data filed already.
9 ;
10 ;Inputs:
11 ; DGENR - enrollment array (pass by reference)
12 ; DGPAT - patient array (pass by reference)
13 ;
14 ;Output: none
15 ;
16 ;Phase II if HEC sends enrollment statuses VERIFIED(2),UNVERIFIED(1),REJECTED-FISCAL YEAR(11),REJECTED-MID-CYCLE(12),REJECTED-STOP ENROLLING NEW APPLiCANTS(13),PENDING-NO ELIGIBILITY CODE IN VIVA(15)
17 ; PENDING-ELIGIBILITY UNVERIFIED(17),PENDING MEANS TEST REQUIRED(16),PENDING-OTHER(18),NOT ELIGIBLE; REFUSED TO PAY COPAY(19)
18 ; NOT ELIGIBLE; INELIGIBLE DATE(20),PENDING PURPLE HEART UNCONFIRMED(21),DECEASED(6),CANCELED/DECLINED(7),REJECTED-INITIAL APPLICATION BY VAMC(14),REJECTED BELOW EGT THRESHOLD(22) then store enrollment (SRS6.5.1.2 f)
19 ;
20 N CURIEN,CURENR
21 ;
22 ;source should not be VAMC, since it is not a local enrollment
23 I DGENR("SOURCE")=1 S DGENR("SOURCE")=2
24 ;
25 ;is there a local enrollment?
26 S CURIEN=$$FINDCUR^DGENA(DGENR("DFN"))
27 ;
28 ;if there is no current enrollment, store HEC enrollment and quit
29 I 'CURIEN D G EXIT
30 .;Phase II (SRS 6.5.1.2 f)
31 .I "^1^2^6^7^11^12^13^14^15^16^17^18^19^20^21^22^"[("^"_DGENR("STATUS")_"^") I $$STORECUR^DGENA1(.DGENR,1)
32 I '$$GET^DGENA(CURIEN,.CURENR) D G EXIT
33 .;Phase II (SRS 6.5.1.2 f)
34 .I "^1^2^6^7^11^12^13^14^15^16^17^18^19^20^21^22^"[("^"_DGENR("STATUS")_"^") I $$STORECUR^DGENA1(.DGENR,1)
35 ;
36 ;check for duplicate
37 Q:$$DUP(.DGENR,.CURENR)
38 ;
39 ;if there is no local enrollment, HEC enrollment becomes current
40 I CURENR("SOURCE")'=1 D G EXIT
41 .;Phase II (SRS 6.5.1.2 f)
42 .I "^1^2^6^7^11^12^13^14^15^16^17^18^19^20^21^22^"[("^"_DGENR("STATUS")_"^") I $$STORECUR^DGENA1(.DGENR,1)
43 ;********************************************************************
44 ;check for exceptions to making HEC enrollment the patient's current enrollment,i.e.,cases in which local enrollment remains the current enrollment
45 ;********************************************************************
46 ;
47 ;if local enrollment has status of Deceased, if the patient is dead and HEC's enrollment doesn't have status of Deceased reject upload
48 I (CURENR("STATUS")=6),DGENR("STATUS")'=6,DGPAT("DEATH") D G EXIT
49 .D ADDERROR^DGENUPL(MSGID,DGPAT("SSN"),"LOCAL SITE REQUESTED TO VERIFY PATIENT DEATH",.ERRCOUNT)
50 .D ADDMSG^DGENUPL3(.MSGS,"ELIBILITY UPLOAD DOESN'T CONTAINED DATE OF DEATH AND WAS REJECTED, PLEASE VERIFY PATIENT DEATH",1)
51 .D NOTIFY^DGENUPL3(.DGPAT,.MSGS)
52 .S ERROR=1
53 ;
54 ;Phase II if local enrollment has status UNVERIFIED(1),REJECTED-INITIAL APPLICATION BY VAMC(14),PENDING(9)
55 ;and HEC sends status of REJECTED-FISCAL YEAR(11),REJECTED-MID-CYCLE(12),REJECTED-STOP ENROLLING APPLICATIONS(13),PENDING-NO ELIGIBILITY CODE in VIVA(15),REJECTED BELOW EGT THRESHOLD
56 ;PENDING-ELIGIBILITY UNVERIFIED(17),PENDING-MEANS TEST REQUIRED(16),PENDING-OTHER(18)
57 ;CANCELED/DECLINED(7) accept upload (SRS 6.5.1.2 h)
58 I "^1^9^14^"[("^"_CURENR("STATUS")_"^"),"^7^11^12^13^15^16^17^18^19^20^21^22^"[("^"_DGENR("STATUS")_"^") D G EXIT
59 .I $$STORECUR^DGENA1(.DGENR,1)
60 ;
61 ;if local enrollment has status of Canceled/Declined, HEC enrollment has status of Verified or Unverified, HEC enrollment has an earlier or same effective date accept upload
62 I (CURENR("STATUS")=7),"^1^2^"[("^"_DGENR("STATUS")_"^"),(CURENR("EFFDATE")'<DGENR("EFFDATE")) D G EXIT
63 .I $$STORECUR^DGENA1(.DGENR,1)
64 ;
65 ;If local enrollment has a status of Unverified(1) and the HEC enrollment
66 ; status is Verified(2), Deceased(6), Cancelled/declined(7) or Pending; Means(16)
67 ; Test Required accept upload
68 I "^1^"[("^"_CURENR("STATUS")_"^"),"^2^6^7^16^19^20^21^"[("^"_DGENR("STATUS")_"^") D G EXIT
69 .I $$STORECUR^DGENA1(.DGENR,1)
70 ;
71 ;********************************************************
72 ;end of exceptions
73 ;********************************************************
74 ;
75 ;none of the exceptions apply, so make the HEC enrollment current
76 ;Phase II (SRS 6.5.1.2 f)
77 I "^1^2^6^7^11^12^13^14^15^16^17^18^19^20^21^22^"[("^"_DGENR("STATUS")_"^") I $$STORECUR^DGENA1(.DGENR,1)
78EXIT Q
79 ;
80DUP(DGENR1,DGENR2) ;
81 ;Descripition: returns 1 if the enrollments are dupliates (other than
82 ;audit information), 0 otherwise
83 ;
84 ;Inputs:
85 ; DGENR1, DGENR2 are arrays containing enrollments (pass by reference)
86 ;
87 ;Outputs:
88 ; Function Value: 1 if identical, 0 otherwise
89 ;
90 N SUB,SAME
91 S SAME=1
92 S SUB=""
93 F S SUB=$O(DGENR1(SUB)) Q:SUB="" D
94 .Q:(SUB="ELIG")
95 .Q:(SUB="DATETIME")
96 .Q:(SUB="USER")
97 .Q:(SUB="PRIORREC")
98 .I DGENR1(SUB)'=DGENR2(SUB) S SAME=0
99 I SAME D
100 .S SUB=""
101 .F S SUB=$O(DGENR1("ELIG",SUB)) Q:SUB="" I DGENR1("ELIG",SUB)'=DGENR2("ELIG",SUB) S SAME=0
102 Q SAME
103 ;
104STOREHIS(DGENR,PRIORTO) ;
105 ;Description: Stores the enrollment contained in the DGENR array
106 ; before the enrollment pointed to by PRIORTO.
107 ;
108 ;Inputs:
109 ; DGENR - an array containing an enrollment to be stored
110 ; PRIORTO - ien of the enrollment where the new enrollment should be
111 ; stored. DGENR will be stored as its prior enrollment.
112 ;
113 Q:'$G(PRIORTO)
114 ;
115 N DGENRIEN,OK
116 S OK=1
117 ;
118 ;the new record should point to the record prior to PRIORTO
119 S DGENR("PRIORREC")=$$FINDPRI^DGENA(PRIORTO)
120 ;
121 ;store the record
122 S DGENRIEN=$$STORE^DGENA1(.DGENR,1)
123 I 'DGENRIEN S OK=0
124 ;
125 ;now point the record=PRIORTO to the new record
126 D:OK
127 .N DATA
128 .S DATA(.09)=DGENRIEN
129 .I $$UPD^DGENDBS(27.11,PRIORTO,.DATA) ;then success
130 Q
Note: See TracBrowser for help on using the repository browser.