Routine: DGENUPL8

DGENUPL8 ;ISA/KWP,RTK,PHH,ERC - PROCESS INCOMING (Z11 EVENT TYPE) HL7 MESSAGES ; 8/15/08 12:41pm

 ;;5.3;PIMS;**232,266,327,314,365,417,514,1015,1016**;JUN 30, 2012;Build 20

 ;Moved ENRUPLD from DGENUPL3

ENRUPLD(DGENR,DGPAT) ;

 ;Description: uploads an enrollment receieved from HEC. The consistency

 ;checks are assumed to have been done, the other patient and eligibility

 ;data filed already.

 ;Inputs:

 ;  DGENR - enrollment array (pass by reference)

 ;  DGPAT - patient array (pass by reference)

 ;Output: none

 ;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)

 ; PENDING-ELIGIBILITY UNVERIFIED(17),PENDING MEANS TEST REQUIRED(16),PENDING-OTHER(18),NOT ELIGIBLE; REFUSED TO PAY COPAY(19)

 ; 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)

 N CURIEN,CURENR

 ;source should not be VAMC, since it is not a local enrollment

 I DGENR("SOURCE")=1 S DGENR("SOURCE")=2

 ;is there a local enrollment?

 S CURIEN=$$FINDCUR^DGENA(DGENR("DFN"))

 ;if there is no current enrollment, store HEC enrollment and quit

 I 'CURIEN D  G EXIT

 .;Phase II (SRS 6.5.1.2 f)

 .I "^1^2^6^7^11^12^13^14^15^16^17^18^19^20^21^22^23^"[("^"_DGENR("STATUS")_"^") I $$STORECUR^DGENA1(.DGENR,1)

 I '$$GET^DGENA(CURIEN,.CURENR) D  G EXIT

 .;Phase II (SRS 6.5.1.2 f)

 .I "^1^2^6^7^11^12^13^14^15^16^17^18^19^20^21^22^23^"[("^"_DGENR("STATUS")_"^") I $$STORECUR^DGENA1(.DGENR,1)

 ;check for duplicate

 Q:$$DUP(.DGENR,.CURENR)

 ;if there is no local enrollment, HEC enrollment becomes current

 I CURENR("SOURCE")'=1 D  G EXIT

 .;Phase II (SRS 6.5.1.2 f)

 .I "^1^2^6^7^11^12^13^14^15^16^17^18^19^20^21^22^23^"[("^"_DGENR("STATUS")_"^") I $$STORECUR^DGENA1(.DGENR,1)

 ;********************************************************************

 ;check for exceptions to making HEC enrollment the patient's current enrollment,i.e.,cases in which local enrollment remains the current enrollment

 ;********************************************************************

 ;if local enrollment has status of Deceased, if the patient is dead and HEC's enrollment doesn't have status of Deceased reject upload

 I (CURENR("STATUS")=6),DGENR("STATUS")'=6,DGPAT("DEATH") D  G EXIT

 .D ADDERROR^DGENUPL(MSGID,DGPAT("SSN"),"LOCAL SITE REQUESTED TO VERIFY PATIENT DEATH",.ERRCOUNT)

 .D ADDMSG^DGENUPL3(.MSGS,"ELIBILITY UPLOAD DOESN'T CONTAINED DATE OF DEATH AND WAS REJECTED, PLEASE VERIFY PATIENT DEATH",1)

 .D NOTIFY^DGENUPL3(.DGPAT,.MSGS)

 .S ERROR=1

 ;Phase II if local enrollment has status UNVERIFIED(1),REJECTED-INITIAL APPLICATION BY VAMC(14),PENDING(9)

 ;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

 ;PENDING-ELIGIBILITY UNVERIFIED(17),PENDING-MEANS TEST REQUIRED(16),PENDING-OTHER(18)

 ;CANCELED/DECLINED(7) accept upload (SRS 6.5.1.2 h)

 I "^1^9^14^"[("^"_CURENR("STATUS")_"^"),"^7^11^12^13^15^16^17^18^19^20^21^22^23^"[("^"_DGENR("STATUS")_"^") D  G EXIT

 .I $$STORECUR^DGENA1(.DGENR,1)

 ;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

 I (CURENR("STATUS")=7),"^1^2^"[("^"_DGENR("STATUS")_"^"),(CURENR("EFFDATE")'<DGENR("EFFDATE")) D  G EXIT

 .I $$STORECUR^DGENA1(.DGENR,1)

 ;If local enrollment has a status of Unverified(1) and the HEC enrollment

 ; status is Verified(2), Deceased(6), Cancelled/declined(7) or Pending; Means(16)

 ; Test Required accept upload

 I "^1^"[("^"_CURENR("STATUS")_"^"),"^2^6^7^16^19^20^21^"[("^"_DGENR("STATUS")_"^") D  G EXIT

 .I $$STORECUR^DGENA1(.DGENR,1)

 ;********************************************************

 ;end of exceptions

 ;********************************************************

 ;none of the exceptions apply, so make the HEC enrollment current

 ;Phase II (SRS 6.5.1.2 f)

 I "^1^2^6^7^11^12^13^14^15^16^17^18^19^20^21^22^"[("^"_DGENR("STATUS")_"^") I $$STORECUR^DGENA1(.DGENR,1)

EXIT Q

DUP(DGENR1,DGENR2) ;

 ;Descripition: returns 1 if the enrollments are dupliates (other than

 ;audit information), 0 otherwise

 ;Inputs:

 ;  DGENR1, DGENR2 are arrays containing enrollments (pass by reference)

 ;Outputs:

 ;  Function Value: 1 if identical, 0 otherwise

 N SUB,SAME

 S SAME=1

 S SUB=""

 F  S SUB=$O(DGENR1(SUB)) Q:SUB=""  D

 .Q:(SUB="ELIG")

 .Q:(SUB="DATETIME")

 .Q:(SUB="USER")

 .Q:(SUB="PRIORREC")

 .I DGENR1(SUB)'=DGENR2(SUB) S SAME=0

 I SAME D

 .S SUB=""

 .F  S SUB=$O(DGENR1("ELIG",SUB)) Q:SUB=""  I DGENR1("ELIG",SUB)'=DGENR2("ELIG",SUB) S SAME=0

 Q SAME

STOREHIS(DGENR,PRIORTO) ;

 ;Description: Stores the enrollment contained in the DGENR array

 ; before the enrollment pointed to by PRIORTO.

 ;Inputs:

 ;  DGENR - an array containing an enrollment to be stored

 ;  PRIORTO - ien of the enrollment where the new enrollment should be

 ;            stored.  DGENR will be stored as its prior enrollment.

 Q:'$G(PRIORTO)

 N DGENRIEN,OK

 S OK=1

 ;the new record should point to the record prior to PRIORTO

 S DGENR("PRIORREC")=$$FINDPRI^DGENA(PRIORTO)

 ;store the record

 S DGENRIEN=$$STORE^DGENA1(.DGENR,1)

 I 'DGENRIEN S OK=0

 ;now point the record=PRIORTO to the new record

 D:OK

 .N DATA

 .S DATA(.09)=DGENRIEN

 .I $$UPD^DGENDBS(27.11,PRIORTO,.DATA) ;then success

DGENUPL8  ;ISA/KWP,RTK,PHH,ERC - PROCESS INCOMING (Z11 EVENT TYPE) HL7 MESSAGES ; 8/15/08 12:41pm

 +1       ;;5.3;PIMS;**232,266,327,314,365,417,514,1015,1016**;JUN 30, 2012;Build 20

 +2       ;Moved ENRUPLD from DGENUPL3

 +3       ;

ENRUPLD(DGENR,DGPAT) ;

 +1       ;Description: uploads an enrollment receieved from HEC. The consistency

 +2       ;checks are assumed to have been done, the other patient and eligibility

 +3       ;data filed already.

 +4       ;

 +5       ;Inputs:

 +6       ;  DGENR - enrollment array (pass by reference)

 +7       ;  DGPAT - patient array (pass by reference)

 +8       ;

 +9       ;Output: none

 +10      ;

 +11      ;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)

 +12      ; PENDING-ELIGIBILITY UNVERIFIED(17),PENDING MEANS TEST REQUIRED(16),PENDING-OTHER(18),NOT ELIGIBLE; REFUSED TO PAY COPAY(19)

 +13      ; 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)

 +14      ;

 +15       NEW CURIEN,CURENR

 +16      ;

 +17      ;source should not be VAMC, since it is not a local enrollment

 +18       IF DGENR("SOURCE")=1

               SET DGENR("SOURCE")=2

 +19      ;

 +20      ;is there a local enrollment?

 +21       SET CURIEN=$$FINDCUR^DGENA(DGENR("DFN"))

 +22      ;

 +23      ;if there is no current enrollment, store HEC enrollment and quit

 +24       IF 'CURIEN

               Begin DoDot:1

 +25      ;Phase II (SRS 6.5.1.2 f)

 +26               IF "^1^2^6^7^11^12^13^14^15^16^17^18^19^20^21^22^23^"[("^"_DGENR("STATUS")_"^")

                       IF $$STORECUR^DGENA1(.DGENR,1)

               End DoDot:1

               GOTO EXIT

 +27       IF '$$GET^DGENA(CURIEN,.CURENR)

               Begin DoDot:1

 +28      ;Phase II (SRS 6.5.1.2 f)

 +29               IF "^1^2^6^7^11^12^13^14^15^16^17^18^19^20^21^22^23^"[("^"_DGENR("STATUS")_"^")

                       IF $$STORECUR^DGENA1(.DGENR,1)

               End DoDot:1

               GOTO EXIT

 +30      ;

 +31      ;check for duplicate

 +32       IF $$DUP(.DGENR,.CURENR)

               QUIT

 +33      ;

 +34      ;if there is no local enrollment, HEC enrollment becomes current

 +35       IF CURENR("SOURCE")'=1

               Begin DoDot:1

 +36      ;Phase II (SRS 6.5.1.2 f)

 +37               IF "^1^2^6^7^11^12^13^14^15^16^17^18^19^20^21^22^23^"[("^"_DGENR("STATUS")_"^")

                       IF $$STORECUR^DGENA1(.DGENR,1)

               End DoDot:1

               GOTO EXIT

 +38      ;********************************************************************

 +39      ;check for exceptions to making HEC enrollment the patient's current enrollment,i.e.,cases in which local enrollment remains the current enrollment

 +40      ;********************************************************************

 +41      ;

 +42      ;if local enrollment has status of Deceased, if the patient is dead and HEC's enrollment doesn't have status of Deceased reject upload

 +43       IF (CURENR("STATUS")=6)

               IF DGENR("STATUS")'=6

                   IF DGPAT("DEATH")

                       Begin DoDot:1

 +44                       DO ADDERROR^DGENUPL(MSGID,DGPAT("SSN"),"LOCAL SITE REQUESTED TO VERIFY PATIENT DEATH",.ERRCOUNT)

 +45                       DO ADDMSG^DGENUPL3(.MSGS,"ELIBILITY UPLOAD DOESN'T CONTAINED DATE OF DEATH AND WAS REJECTED, PLEASE VERIFY PATIENT DEATH",1)

 +46                       DO NOTIFY^DGENUPL3(.DGPAT,.MSGS)

 +47                       SET ERROR=1

                       End DoDot:1

                       GOTO EXIT

 +48      ;

 +49      ;Phase II if local enrollment has status UNVERIFIED(1),REJECTED-INITIAL APPLICATION BY VAMC(14),PENDING(9)

 +50      ;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

 +51      ;PENDING-ELIGIBILITY UNVERIFIED(17),PENDING-MEANS TEST REQUIRED(16),PENDING-OTHER(18)

 +52      ;CANCELED/DECLINED(7) accept upload (SRS 6.5.1.2 h)

 +53       IF "^1^9^14^"[("^"_CURENR("STATUS")_"^")

               IF "^7^11^12^13^15^16^17^18^19^20^21^22^23^"[("^"_DGENR("STATUS")_"^")

                   Begin DoDot:1

 +54                   IF $$STORECUR^DGENA1(.DGENR,1)

                   End DoDot:1

                   GOTO EXIT

 +55      ;

 +56      ;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

 +57       IF (CURENR("STATUS")=7)

               IF "^1^2^"[("^"_DGENR("STATUS")_"^")

                   IF (CURENR("EFFDATE")'<DGENR("EFFDATE"))

                       Begin DoDot:1

 +58                       IF $$STORECUR^DGENA1(.DGENR,1)

                       End DoDot:1

                       GOTO EXIT

 +59      ;

 +60      ;If local enrollment has a status of Unverified(1) and the HEC enrollment

 +61      ; status is Verified(2), Deceased(6), Cancelled/declined(7) or Pending; Means(16)

 +62      ; Test Required accept upload

 +63       IF "^1^"[("^"_CURENR("STATUS")_"^")

               IF "^2^6^7^16^19^20^21^"[("^"_DGENR("STATUS")_"^")

                   Begin DoDot:1

 +64                   IF $$STORECUR^DGENA1(.DGENR,1)

                   End DoDot:1

                   GOTO EXIT

 +65      ;

 +66      ;********************************************************

 +67      ;end of exceptions

 +68      ;********************************************************

 +69      ;

 +70      ;none of the exceptions apply, so make the HEC enrollment current

 +71      ;Phase II (SRS 6.5.1.2 f)

 +72       IF "^1^2^6^7^11^12^13^14^15^16^17^18^19^20^21^22^"[("^"_DGENR("STATUS")_"^")

               IF $$STORECUR^DGENA1(.DGENR,1)

EXIT       QUIT

 +1       ;

DUP(DGENR1,DGENR2) ;

 +1       ;Descripition: returns 1 if the enrollments are dupliates (other than

 +2       ;audit information), 0 otherwise

 +3       ;

 +4       ;Inputs:

 +5       ;  DGENR1, DGENR2 are arrays containing enrollments (pass by reference)

 +6       ;

 +7       ;Outputs:

 +8       ;  Function Value: 1 if identical, 0 otherwise

 +9       ;

 +10       NEW SUB,SAME

 +11       SET SAME=1

 +12       SET SUB=""

 +13       FOR

               SET SUB=$ORDER(DGENR1(SUB))

               IF SUB=""

                   QUIT

               Begin DoDot:1

 +14               IF (SUB="ELIG")

                       QUIT

 +15               IF (SUB="DATETIME")

                       QUIT

 +16               IF (SUB="USER")

                       QUIT

 +17               IF (SUB="PRIORREC")

                       QUIT

 +18               IF DGENR1(SUB)'=DGENR2(SUB)

                       SET SAME=0

               End DoDot:1

 +19       IF SAME

               Begin DoDot:1

 +20               SET SUB=""

 +21               FOR

                       SET SUB=$ORDER(DGENR1("ELIG",SUB))

                       IF SUB=""

                           QUIT

                       IF DGENR1("ELIG",SUB)'=DGENR2("ELIG",SUB)

                           SET SAME=0

               End DoDot:1

 +22       QUIT SAME

 +23      ;

STOREHIS(DGENR,PRIORTO) ;

 +1       ;Description: Stores the enrollment contained in the DGENR array

 +2       ; before the enrollment pointed to by PRIORTO.

 +3       ;

 +4       ;Inputs:

 +5       ;  DGENR - an array containing an enrollment to be stored

 +6       ;  PRIORTO - ien of the enrollment where the new enrollment should be

 +7       ;            stored.  DGENR will be stored as its prior enrollment.

 +8       ;

 +9        IF '$GET(PRIORTO)

               QUIT

 +10      ;

 +11       NEW DGENRIEN,OK

 +12       SET OK=1

 +13      ;

 +14      ;the new record should point to the record prior to PRIORTO

 +15       SET DGENR("PRIORREC")=$$FINDPRI^DGENA(PRIORTO)

 +16      ;

 +17      ;store the record

 +18       SET DGENRIEN=$$STORE^DGENA1(.DGENR,1)

 +19       IF 'DGENRIEN

               SET OK=0

 +20      ;

 +21      ;now point the record=PRIORTO to the new record

 +22       IF OK

               Begin DoDot:1

 +23               NEW DATA

 +24               SET DATA(.09)=DGENRIEN

 +25      ;then success

                   IF $$UPD^DGENDBS(27.11,PRIORTO,.DATA)

               End DoDot:1

 +26       QUIT

DGENUPL8.m