Changeset 623 for WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGENA2.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGENA2.m
r613 r623 1 DGENA2 ;ALB/CJM,RTK,TDM - Enrollment API - Automatic Update; 9/19/2002 ; 1/31/03 11:54am 2 ;;5.3;Registration;**121,122,147,232,327,469,491,779**;Aug 13,1993;Build 11 3 ; 4 AUTOUPD(DFN,EVENT) ; 5 ;Description: If the patient meets the criteria for transmission to HEC, 6 ; he is entered to the IVM PATIENT file for future transmission. 7 ; This procedure checks for changes in enrollment priority, 8 ; status and fields in the eligibility sub-record. If any changes are 9 ; found, the current enrollment record is automatically updated. 10 ;Input: 11 ; DFN - Patient IEN 12 ; EVENT - Event Type (optional) 13 ; EVENT 1 : Date of Death Deleted 14 ; EVENT 2 : Ineligible Date Deleted 15 ;Output: None 16 ; 17 ;if the eligibility/enrollment upload is in progess, do not do anything 18 Q:($G(DGENUPLD)="ENROLLMENT/ELIGIBILITY UPLOAD IN PROGRESS") 19 ; 20 ; If the INCOME TEST DATA (Z10) upload is in progess, do not do anything 21 Q:($G(IVMZ10)="UPLOAD IN PROGRESS") 22 ; 23 N DGENRIEN,DGENR1,DGENR2,STATUS,EFFDATE,OK,DEATH 24 ; 25 ;try to prevent problems rsulting from calling FM within FM 26 N DS,D0,DO,D1,DA,DD,DS,DG,DIC,DICR,DIE,DIG,DIH,DIV,DIW,DIX,DQ,DR 27 ; 28 S EVENT=+$G(EVENT) 29 ; 30 D EVENT^IVMPLOG(DFN) 31 ; 32 D:$$LOCK^DGENA1($G(DFN)) ;may drop out of block 33 .S DGENRIEN=$$FINDCUR^DGENA(DFN) 34 .Q:'DGENRIEN 35 .Q:'$$GET^DGENA(DGENRIEN,.DGENR1) 36 .S STATUS=$$EXT^DGENU("STATUS",DGENR1("STATUS")) 37 .S (DEATH,EFFDATE)=$$DEATH^DGENPTA(DFN) 38 .I STATUS'="VERIFIED",STATUS'="UNVERIFIED",STATUS'="DECEASED",STATUS'["NOT ELIGIBLE",STATUS'["PENDING",STATUS'["REJECTED" Q 39 .I STATUS="DECEASED",((EVENT'=1)!(DEATH)) Q 40 .I STATUS["NOT ELIGIBLE",((EVENT'=2)!('$$VET^DGENPTA(DFN))) Q 41 .S:'EFFDATE EFFDATE=DT 42 .Q:'$$CREATE^DGENA6(DFN,DGENR1("APP"),EFFDATE,DGENR1("REASON"),DGENR1("REMARKS"),.DGENR2,DGENR1("DATE"),DGENR1("END")) 43 .S OK=1 44 .S:(DGENR1("PRIORITY")'=DGENR2("PRIORITY"))!(DGENR2("STATUS")'=DGENR1("STATUS")) OK=0 45 .I OK D 46 ..N SUB 47 ..S SUB="" 48 ..F S SUB=$O(DGENR2("ELIG",SUB)) Q:SUB="" S:(DGENR1("ELIG",SUB)'=DGENR2("ELIG",SUB)) OK=0 49 .I 'OK D 50 ..I (DGENR1("EFFDATE")=DGENR2("EFFDATE")),(DGENR1("SOURCE")=DGENR2("SOURCE")),(DGENR1("USER")=DGENR2("USER")),(DGENR1("DATETIME")\1)=(DGENR2("DATETIME")\1) D 51 ...;in this case it's an overlay 52 ...S DGENR2("PRIORREC")=DGENR1("PRIORREC") 53 ...I $$EDITCUR^DGENA1(.DGENR2) 54 ..E D 55 ...;in this case create a new record, to preserve the audit trail 56 ...I $$STORECUR^DGENA1(.DGENR2) 57 D UNLOCK^DGENA1($G(DFN)) 58 Q 59 MTUPD ; 60 ;Description - entry point for Means Test Event Driver for Enrollment 61 ; 62 D AUTOUPD($G(DFN)) 63 Q 64 ; 65 SDDIS ;Entry point for the DGEN SD DISPLAY CURRENT ENROLLMENT protocol, 66 ;which hangs of the Scheduling Event Driver 67 ; 68 N DFN S DFN=$P($G(SDATA),"^",2) 69 ; 70 ;don't display if running in the background 71 Q:$D(ZTQUEUED) 72 ; 73 ;don't want to display enrollment for non-vets with no enrollment status 74 Q:('$$VET^DGENPTA(DFN))&('$$STATUS^DGENA(DFN)) 75 ; 76 ;if making an appt., & in interactive mode, display enrollment status 77 I ($G(SDAMEVT)=1),$G(SDMODE)=0 D 78 .D DISPLAY^DGENU($P($G(SDATA),"^",2)) 79 .D PAUSE^VALM1 80 ; 81 ;want to do the same thing for check-in, unless appt just made 82 I ($G(SDAMEVT)=4),$G(SDMODE)=0 D 83 .;want to try avoiding giving display if it was done already 84 .;so, if it is an unscheduled appt made today, skip 85 .N PTNODE,SCNODE 86 .S SCNODE=$G(^TMP("SDAMEVT",$J,"AFTER","SC")) 87 .S PTNODE=$G(^TMP("SDAMEVT",$J,"AFTER","DPT")) 88 .I +$P(SCNODE,"^",7)=$G(DT),$P(PTNODE,"^",7)=4 Q ;unscheduled appt made today 89 .D DISPLAY^DGENU($P($G(SDATA),"^",2)) 90 .D PAUSE^VALM1 91 Q 92 ; 93 ENROLL ;Entry point for the DGEN SD ENROLL PATIENT protocol, which hangs of 94 ;the Scheduling Event Driver. This event enrolls patients upon check-out 95 ;if there is no prior enrollment record. 96 ; 97 ; Input -- SDATA & SDAMEVT defined by the scheduling event driver 98 ; Output -- none 99 ; 100 N DGENR,DFN 101 ; 102 ;NOTE - it appears from testing that means test status REQUIRED is set 103 ;within scheduling, obviating the need to do it here. This is why 104 ;several lines are commented out. 105 ; 106 ;N DGENR,DGOKF,DGREQF,DFN,DGMSGF,DG,DGMT,DGMTCOR,DGMTE,DGRGAUTO,DGWRT,XMZ,DIG,DIH 107 ; 108 ;appointment made, check if enrollment appointment request needs reset. 109 I $G(SDAMEVT)=1 D REQUST(SDAMEVT,SDATA) 110 ;check-out? 111 Q:($G(SDAMEVT)'=5) 112 ; 113 S DFN=$P($G(SDATA),"^",2) 114 ; 115 ;don't enroll if the patient has an enrollment record 116 I $$FINDCUR^DGENA(DFN) D REQUST(SDAMEVT,SDATA) Q 117 ; 118 ;non-vet? 119 Q:'$$VET^DGENPTA(DFN) 120 ; 121 ;dead? 122 Q:$$DEATH^DGENPTA(DFN) 123 ; 124 ;Does patient require a Means Test? 125 ;S DGMSGF=1 126 ;D EN^DGMTR 127 ; 128 ;Create local enrollment array 129 I $$CREATE^DGENA6(DFN,DT,,,,.DGENR) D 130 . ; 131 . ;Store local enrollment as current 132 . I $$STORECUR^DGENA1(.DGENR) D 133 . . D REQUST(SDAMEVT,SDATA) 134 . . ; 135 . . ;If patient's means test status is required, send bulletin 136 . . ;I $$MTREQ^DGEN(DFN) D MTBULL^DGEN(DFN,.DGENR) 137 Q 138 ; 139 REQUST(SDAMEVT,SDATA) ; 140 ;Automatic collection of Appointment Request Date and Appointment 141 ;Request Response 142 ;- Set when Enrollment Application Date >= 8/1/2005 AND 143 ;- Appointment Request Date is null. 144 ; 145 ; Input -- SDATA and SDAMEVT defined by scheduling event driver 146 ; Output -- none 147 ; 148 N DGENRIEN,DGENR,DPTERR,DGCOM 149 ;apointment made or checked out? 150 Q:(($G(SDAMEVT)'=1)&($G(SDAMEVT)'=5)) 151 ; 152 S DFN=$P($G(SDATA),"^",2) 153 ;get enrollment ien 154 S DGENRIEN=$$FINDCUR^DGENA(DFN) 155 I DGENRIEN,$$GET^DGENA(DGENRIEN,.DGENR) ;set-up enrollment array 156 I $G(DGENR("APP"))>3050731 D 157 . ;and, no appointment request date. Set request="yes", request date 158 . I '$$GET1^DIQ(2,DFN,1010.1511,"I") D 159 . . ;set fields 160 . . N FDATA 161 . . S FDATA(2,DFN_",",1010.159)=1 162 . . S FDATA(2,DFN_",",1010.1511)=DT 163 . . D FILE^DIE("","FDATA","DPTERR") 164 . ;if appointment made (or checkout), appt. request="yes", request status'="filled" 165 . ;- set request status='filled' w comment 166 . I ($$GET1^DIQ(2,DFN,1010.159,"I")),($$GET1^DIQ(2,DFN,1010.161,"I")'="F") D 167 . . ;set fields 168 . . N FDATA 169 . . S FDATA(2,DFN_",",1010.161)="F" 170 . . S DGCOM=$$GET1^DIQ(2,DFN,1010.163) 171 . . S DGCOM=DGCOM_$S(DGCOM'="":"<>",1:"")_"AutoComm:"_$S($$GET1^DIQ(2,DFN,1010.161,"I")="":"null",1:$S($$GET1^DIQ(2,DFN,1010.161,"I")="I":"IN PROGRESS",1:$$GET1^DIQ(2,DFN,1010.161)))_"|FILLED by Scheduling" 172 . . S FDATA(2,DFN_",",1010.163)=DGCOM 173 . . D FILE^DIE("","FDATA","DPTERR") 174 Q 1 DGENA2 ;ALB/CJM,RTK,TDM - Enrollment API - Automatic Update; 9/19/2002 ; 1/31/03 11:54am 2 ;;5.3;Registration;**121,122,147,232,327,469,491**;Aug 13,1993 3 ; 4 AUTOUPD(DFN,EVENT) ; 5 ;Description: If the patient meets the criteria for transmission to HEC, 6 ; he is entered to the IVM PATIENT file for future transmission. 7 ; This procedure checks for changes in enrollment priority, 8 ; status and fields in the eligibility sub-record. If any changes are 9 ; found, the current enrollment record is automatically updated. 10 ;Input: 11 ; DFN - Patient IEN 12 ; EVENT - Event Type (optional) 13 ; EVENT 1 : Date of Death Deleted 14 ; EVENT 2 : Ineligible Date Deleted 15 ;Output: None 16 ; 17 ;if the eligibility/enrollment upload is in progess, do not do anything 18 Q:($G(DGENUPLD)="ENROLLMENT/ELIGIBILITY UPLOAD IN PROGRESS") 19 ; 20 ; If the INCOME TEST DATA (Z10) upload is in progess, do not do anything 21 Q:($G(IVMZ10)="UPLOAD IN PROGRESS") 22 ; 23 N DGENRIEN,DGENR1,DGENR2,STATUS,EFFDATE,OK,DEATH 24 ; 25 ;try to prevent problems rsulting from calling FM within FM 26 N DS,D0,DO,D1,DA,DD,DS,DG,DIC,DICR,DIE,DIG,DIH,DIV,DIW,DIX,DQ,DR 27 ; 28 S EVENT=+$G(EVENT) 29 ; 30 D EVENT^IVMPLOG(DFN) 31 ; 32 D:$$LOCK^DGENA1($G(DFN)) ;may drop out of block 33 .S DGENRIEN=$$FINDCUR^DGENA(DFN) 34 .Q:'DGENRIEN 35 .Q:'$$GET^DGENA(DGENRIEN,.DGENR1) 36 .S STATUS=$$EXT^DGENU("STATUS",DGENR1("STATUS")) 37 .S (DEATH,EFFDATE)=$$DEATH^DGENPTA(DFN) 38 .I STATUS'="VERIFIED",STATUS'="UNVERIFIED",STATUS'="DECEASED",STATUS'["NOT ELIGIBLE",STATUS'["PENDING",STATUS'["REJECTED" Q 39 .I STATUS="DECEASED",((EVENT'=1)!(DEATH)) Q 40 .I STATUS["NOT ELIGIBLE",((EVENT'=2)!('$$VET^DGENPTA(DFN))) Q 41 .S:'EFFDATE EFFDATE=DT 42 .Q:'$$CREATE^DGENA6(DFN,DGENR1("APP"),EFFDATE,DGENR1("REASON"),DGENR1("REMARKS"),.DGENR2,DGENR1("DATE"),DGENR1("END")) 43 .S OK=1 44 .S:(DGENR1("PRIORITY")'=DGENR2("PRIORITY"))!(DGENR2("STATUS")'=DGENR1("STATUS")) OK=0 45 .I OK D 46 ..N SUB 47 ..S SUB="" 48 ..F S SUB=$O(DGENR2("ELIG",SUB)) Q:SUB="" S:(DGENR1("ELIG",SUB)'=DGENR2("ELIG",SUB)) OK=0 49 .I 'OK D 50 ..I (DGENR1("EFFDATE")=DGENR2("EFFDATE")),(DGENR1("SOURCE")=DGENR2("SOURCE")),(DGENR1("USER")=DGENR2("USER")),(DGENR1("DATETIME")\1)=(DGENR2("DATETIME")\1) D 51 ...;in this case it's an overlay 52 ...S DGENR2("PRIORREC")=DGENR1("PRIORREC") 53 ...I $$EDITCUR^DGENA1(.DGENR2) 54 ..E D 55 ...;in this case create a new record, to preserve the audit trail 56 ...I $$STORECUR^DGENA1(.DGENR2) 57 D UNLOCK^DGENA1($G(DFN)) 58 Q 59 MTUPD ; 60 ;Description - entry point for Means Test Event Driver for Enrollment 61 ; 62 D AUTOUPD($G(DFN)) 63 Q 64 ; 65 SDDIS ;Entry point for the DGEN SD DISPLAY CURRENT ENROLLMENT protocol, 66 ;which hangs of the Scheduling Event Driver 67 ; 68 N DFN S DFN=$P($G(SDATA),"^",2) 69 ; 70 ;don't display if running in the background 71 Q:$D(ZTQUEUED) 72 ; 73 ;don't want to display enrollment for non-vets with no enrollment status 74 Q:('$$VET^DGENPTA(DFN))&('$$STATUS^DGENA(DFN)) 75 ; 76 ;if making an appt., & in interactive mode, display enrollment status 77 I ($G(SDAMEVT)=1),$G(SDMODE)=0 D 78 .D DISPLAY^DGENU($P($G(SDATA),"^",2)) 79 .D PAUSE^VALM1 80 ; 81 ;want to do the same thing for check-in, unless appt just made 82 I ($G(SDAMEVT)=4),$G(SDMODE)=0 D 83 .;want to try avoiding giving display if it was done already 84 .;so, if it is an unscheduled appt made today, skip 85 .N PTNODE,SCNODE 86 .S SCNODE=$G(^TMP("SDAMEVT",$J,"AFTER","SC")) 87 .S PTNODE=$G(^TMP("SDAMEVT",$J,"AFTER","DPT")) 88 .I +$P(SCNODE,"^",7)=$G(DT),$P(PTNODE,"^",7)=4 Q ;unscheduled appt made today 89 .D DISPLAY^DGENU($P($G(SDATA),"^",2)) 90 .D PAUSE^VALM1 91 Q 92 ; 93 ENROLL ;Entry point for the DGEN SD ENROLL PATIENT protocol, which hangs of 94 ;the Scheduling Event Driver. This event enrolls patients upon check-out 95 ;if there is no prior enrollment record. 96 ; 97 ; Input -- SDATA & SDAMEVT defined by the scheduling event driver 98 ; Output -- none 99 ; 100 N DGENR,DFN 101 ; 102 ;NOTE - it appears from testing that means test status REQUIRED is set 103 ;within scheduling, obviating the need to do it here. This is why 104 ;several lines are commented out. 105 ; 106 ;N DGENR,DGOKF,DGREQF,DFN,DGMSGF,DG,DGMT,DGMTCOR,DGMTE,DGRGAUTO,DGWRT,XMZ,DIG,DIH 107 ; 108 ;check-out? 109 Q:($G(SDAMEVT)'=5) 110 ; 111 S DFN=$P($G(SDATA),"^",2) 112 ; 113 ;don't enroll if the patient has an enrollment record 114 Q:$$FINDCUR^DGENA(DFN) 115 ; 116 ;non-vet? 117 Q:'$$VET^DGENPTA(DFN) 118 ; 119 ;dead? 120 Q:$$DEATH^DGENPTA(DFN) 121 ; 122 ;Does patient require a Means Test? 123 ;S DGMSGF=1 124 ;D EN^DGMTR 125 ; 126 ;Create local enrollment array 127 I $$CREATE^DGENA6(DFN,DT,,,,.DGENR) D 128 . ; 129 . ;Store local enrollment as current 130 . I $$STORECUR^DGENA1(.DGENR) D 131 . . ; 132 . . ;If patient's means test status is required, send bulletin 133 . . ;I $$MTREQ^DGEN(DFN) D MTBULL^DGEN(DFN,.DGENR) 134 Q
Note:
See TracChangeset
for help on using the changeset viewer.
