| 1 | DG53672R ;ALB/BRM;Clean-up Other EC of Reimbursable Insurance ; 9/6/05 7:39am
|
|---|
| 2 | ;;5.3;Registration;**672**;Aug 13,1993
|
|---|
| 3 | ;;
|
|---|
| 4 | ;
|
|---|
| 5 | ; Called from inside Patient File (#2) loop in DG53672C.
|
|---|
| 6 | ;
|
|---|
| 7 | RSETUP(ELIG) ; entry point
|
|---|
| 8 | N EC81,EC8
|
|---|
| 9 | ; get local codes assigned to the national Reimbursable code
|
|---|
| 10 | S EC81=$O(^DIC(8.1,"B","REIMBURSABLE INSURANCE",""))
|
|---|
| 11 | S EC8=""
|
|---|
| 12 | F S EC8=$O(^DIC(8,"D",EC81,EC8)) Q:'EC8 S ELIG(EC8)=""
|
|---|
| 13 | Q
|
|---|
| 14 | ;
|
|---|
| 15 | REIM(DFN,RIELIG) ;check for Eligibility Code of Reimbursable Insurance
|
|---|
| 16 | N EC8,IEN,QFLG,PRIMEC,DOD
|
|---|
| 17 | S DOD=$P($G(^DPT(DFN,.35)),"^") ;Date of Death
|
|---|
| 18 | S PRIMEC=$P($G(^DPT(DFN,.36)),"^"),EC8=""
|
|---|
| 19 | F S EC8=$O(RIELIG(EC8)) Q:'EC8 D
|
|---|
| 20 | .Q:'$D(^DPT(DFN,"E","B",EC8))
|
|---|
| 21 | .S IEN="",QFLG=0
|
|---|
| 22 | .F S IEN=$O(^DPT(DFN,"E","B",EC8,IEN)) Q:'IEN D
|
|---|
| 23 | ..I PRIMEC=EC8,'$G(QFLG) S QFLG=1 S:'DOD ^XTMP("DG53672C","DG53672R","PRIMCNT")=$G(^XTMP("DG53672C","DG53672R","PRIMCNT"))+1 Q
|
|---|
| 24 | ..S ^XTMP("DG53672C","DG53672R","CNT")=$G(^XTMP("DG53672C","DG53672R","CNT"))+1
|
|---|
| 25 | ..S ^XTMP("DG53672C","DG53672R","DATA",DFN)=EC8_"^"_$$EXTERNAL^DILFD(2.0361,.01,"",EC8)
|
|---|
| 26 | ..D KILL(DFN,IEN)
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | KILL(DFN,IEN) ;
|
|---|
| 30 | ; Delete Reimbursable Insurance entry.
|
|---|
| 31 | N DA,DATA,DIK
|
|---|
| 32 | S DA(1)=DFN,DA=IEN,DIK="^DPT("_DA(1)_",""E"","
|
|---|
| 33 | D ^DIK
|
|---|
| 34 | Q
|
|---|
| 35 | SNDMSG ; Send Mailman bulletin when process completes
|
|---|
| 36 | N DIFROM,SITE,STATN,SITENM,XMDUZ,XMSUB,XMY,XMTEXT,MSG
|
|---|
| 37 | S SITE=$$SITE^VASITE,STATN=$P($G(SITE),U,3),SITENM=$P($G(SITE),U,2)
|
|---|
| 38 | S:$$GET1^DIQ(869.3,"1,",.03,"I")'="P" STATN=STATN_" [TEST]"
|
|---|
| 39 | S XMDUZ="REIMBURSABLE INS OTHER EC CLEANUP",XMSUB=XMDUZ_" - "_STATN
|
|---|
| 40 | S (XMY(DUZ),XMY("HECDQSUPPORT@med.va.gov"))=""
|
|---|
| 41 | S XMTEXT="MSG("
|
|---|
| 42 | S MSG(1)="The Reimbursable Insurance Other Eligibility clean-up process has completed successfully."
|
|---|
| 43 | S MSG(2)="This process searched for patient records with an other eligibility code of"
|
|---|
| 44 | S MSG(3)="Reimbursable Insurance, and deleted it as the code is no longer active."
|
|---|
| 45 | S MSG(4)=""
|
|---|
| 46 | S MSG(5)="Task: "_$G(^XTMP("DG53672C",0,"TASK"))
|
|---|
| 47 | S MSG(6)="Site Station Number: "_STATN
|
|---|
| 48 | S MSG(7)="Site Name: "_SITENM
|
|---|
| 49 | S MSG(8)=""
|
|---|
| 50 | S MSG(9)="Process started : "_$$FMTE^XLFDT($P($G(^XTMP("DG53672C",0)),U,2))
|
|---|
| 51 | S MSG(10)="Process completed : "_$$FMTE^XLFDT($P($G(^XTMP("DG53672C",0)),"^",4))
|
|---|
| 52 | S MSG(10.5)=""
|
|---|
| 53 | S MSG(11)="Total Patients processed : "_+$G(^XTMP("DG53672C","TCNT"))
|
|---|
| 54 | S MSG(12)="Total non-Primary Reimbursable ECs Removed : "_+$G(^XTMP("DG53672C","DG53672R","CNT"))
|
|---|
| 55 | S MSG(12.1)="Total Reimbursable Primary ECs* : "_+$G(^XTMP("DG53672C","DG53672R","PRIMCNT"))
|
|---|
| 56 | S MSG(12.2)=" *Primary Reimbursable ECs were not removed, and sites must review"
|
|---|
| 57 | S MSG(12.3)=" and fix manually by assigning a new Primary EC."
|
|---|
| 58 | S MSG(12.5)=""
|
|---|
| 59 | S MSG(13)="To identify patients at the site for whom the non-Primary Reimbursable"
|
|---|
| 60 | S MSG(14)=" Insurance Eligibility Code was removed, the IRM or person(s) responsible"
|
|---|
| 61 | S MSG(14.5)=" for installing the patch can review the following global:"
|
|---|
| 62 | S MSG(15)=" ^XTMP(""DG53672C"",""DG536572R"",""DATA"",DFN)"
|
|---|
| 63 | S MSG(16)=" DFN = internal entry number of the Patient file (#2)."
|
|---|
| 64 | D ^XMD
|
|---|
| 65 | Q
|
|---|
