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