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
Q
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
