source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGENA2.m@ 1569

Last change on this file since 1569 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.5 KB
Line 
1DGENA2 ;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 ;
4AUTOUPD(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
59MTUPD ;
60 ;Description - entry point for Means Test Event Driver for Enrollment
61 ;
62 D AUTOUPD($G(DFN))
63 Q
64 ;
65SDDIS ;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 ;
93ENROLL ;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 TracBrowser for help on using the repository browser.