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

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

initial load of FOIAVistA 6/30/08 version
File size: 6.9 KB
Line 
1DGPREBJ1 ;ALB/SCK/EG - PreRegistration Background job cont. ; 1/21/05 7:03am
2 ;;5.3;Registration;**109,568,585**;Aug 13, 1993
3 Q
4 ;
5EN ; Interactive entry (from option)
6 ; Variables
7 ; DGPTOD - Todays date from DT
8 ; DGPNL - No. of lines in message array
9 ; DGPTXT - Message array from ADDNEW procedure
10 ; DGPP - Default date to look for appointments
11 ; I1,X1-2 - Local variables for counters and date manipulation
12 ;
13 I '$D(^XUSEC("DGPRE SUPV",DUZ)) D G ENQ
14 . W !!,"You do not have the DG PREREGISTRATION Key allocated, contact your MAS ADPAC."
15 ;
16 N DGPDT,DGPTOD,DGPNL,DGPTXT,DGPP,I1,X,X1,X2,Y
17 S X1=$P($$NOW^XLFDT,"."),X2=$P($G(^DG(43,1,"DGPRE")),U,5) S:X2']"" X2=14
18 S DGPP=$$FMADD^XLFDT(X1,X2)
19 S DIR("B")=$$FMTE^XLFDT(DGPP,1)
20 S DIR(0)="DA^::EX",DIR("A")="Enter Appointment date to search: "
21 D ^DIR K DIR
22 G:$D(DIRUT) ENQ
23 S DGPNL=0,DGPTOD=DT,DGPDT1=Y
24 D WAIT^DICD
25 D SDAMAPI(1,DGPDT1)
26 D ADDNEW(1,DGPDT1)
27 I $D(DGPTXT) W !!,"Results of updating the Call List with new entries",!
28 S I1=0 F S I1=$O(DGPTXT(I1)) Q:'I1 W !,DGPTXT(I1)
29ENQ K DIRUT,DUOUT,DTOUT,DIROUT,DGARRAY,SCDNT,^TMP($J,"SDAMA301")
30 Q
31 ;
32ADDNEW(DGPREI,DGPDT1) ; Searches for appointments to add to the Call List
33 ; Variables
34 ; Input:
35 ; DGPREI - Flag indicating how the procedure was called.
36 ; 0 - called by background job
37 ; 1 - called by option (interactive)
38 ; DGPDT1 - Date to look for appointments, Required when
39 ; DGPREI = 1
40 ;
41 ; DGPDW - Day of the week
42 ; DGPNDY - Number of days ahead to look for appt.
43 ; DGPDT - Date to look for appt. ( DT + DGPNDY)
44 ; DGPTOT - Counter, total records scanned
45 ; DGPPT - Pointer to patient file, #2
46 ; DGPTDTH - Counter for patient alias's found
47 ; DGPEXCL - Exclude flag
48 ; DGPTCE - Counter of appts. excluded because of clinic
49 ; DGPTPE - Counter of appts. excluded because of eligibility
50 ; DGPINP - counter of appts. excluded because of inpatient
51 ; DGPTNC - Counter of appts. excluded because next appt. is within
52 ; DAYS BETWEEN CALLS entry in the MAS PARAMETER File
53 ; DGPADD - Counter, entries added to call list
54 ; DGPAPT - Date and time off appointment
55 ; DGPPRDT - Date pre-registration audit file last updated for patient
56 ; DGPNDTW - DAYS BETWEEN CALLS value
57 ; DGPSV - Medical Service code
58 ; DGPPN - Patients Name
59 ; DGPPH - Patients Phone number
60 ; DGPSN - Patients last four
61 ; DGPN1-5 - Temporary variables for $O
62 ;
63 ; Check for Appointment Database Availability
64 ;if there is no lower level data from the 101 subscript, then it
65 ;really is a valid error, otherwise, it could be a patient
66 ;or clinic eg 01/20/2005
67 I $D(^TMP($J,"SDAMA301")) I $D(^TMP($J,"SDAMA301",101))=1 D SETTEXT^DGPREBJ("SDAMAPI - Appointment Database is Unavailable."),SETTEXT^DGPREBJ("Unable to update Call List.") Q
68 ;
69 N DGPADD,DGPTOT,DGPTCE,DGPTPE,DGPTNC,DGPTDTH,DGPINP,DGPUPD,DGPN1,DGPAPT
70 N DGPPH,DGPDW,DGPPT,DGPPRDT,DGPNDTW,DGPN5,DGPEXCL,CKAPDT
71 S (DGPADD,DGPTOT,DGPTCE,DGPTPE,DGPTNC,DGPTDTH,DGPINP,DGPUPD)=0
72 S DGPN1=0 F S DGPN1=$O(^TMP($J,"SDAMA301",DGPN1)) Q:'DGPN1 D
73 .S DGPPT=0 F S DGPPT=$O(^TMP($J,"SDAMA301",DGPN1,DGPPT)) Q:'DGPPT D
74 ..S CKAPDT=+$O(^TMP($J,"SDAMA301",DGPN1,DGPPT,DGPDT1))
75 ..Q:('CKAPDT!(CKAPDT>$$FMADD^XLFDT(DGPDT1,1)))
76 ..S DGPTOT=DGPTOT+1
77 ..I $P($G(^DPT(DGPPT,.35)),U)]"" S DGPTDTH=DGPTDTH+1 Q
78 ..; *** Check for clinic exclusions in MAS PARAMETER File
79 ..S (DGPN5,DGPEXCL)=0
80 ..F S DGPN5=$O(^DG(43,1,"DGPREC",DGPN5)) Q:'DGPN5!(DGPEXCL) D
81 ...S:$P(^DG(43,1,"DGPREC",DGPN5,0),U)=DGPN1 DGPEXCL=1
82 ..I DGPEXCL S DGPTCE=DGPTCE+1 Q
83 ..; *** Check for eligibility exclusions inthe MAS PARAMETER File
84 ..N DGPAELG S (DGPN5,DGPEXCL)=0
85 ..F S DGPN5=$O(^DG(43,1,"DGPREE",DGPN5)) Q:'DGPN5!(DGPEXCL) D
86 ...S DGPAELG=$P($G(^DPT(DGPPT,.36)),U)
87 ...S:$P(^DG(43,1,"DGPREE",DGPN5,0),U)=DGPAELG DGPEXCL=1
88 ..I DGPEXCL S DGPTPE=DGPTPE+1 Q
89 ..; *** Check for inpatient status
90 ..K DFN S DFN=DGPPT D INP^VADPT
91 ..I $G(VAIN(1))]"" S DGPINP=DGPINP+1 Q
92 ..; *** Check for last update in Pre-Registration Audit file
93 ..S DGPPRDT=DGPTOD+.9999,DGPPRDT=$O(^DGS(41.41,"ADC",DGPPT,DGPPRDT),-1)
94 ..S DGPNDTW=$P($G(^DG(43,1,"DGPRE")),U,2)
95 ..I DGPPRDT]""&(DGPNDTW]"") I $$FMDIFF^XLFDT(DGPDT,DGPPRDT,1)<DGPNDTW S DGPTNC=DGPTNC+1 Q
96 ..; *** Set up entries for adding to Pre-Registration Call List file
97 ..K DFN S DFN=DGPPT D DEM^VADPT
98 ..S DGPPH=$P($P($G(^DPT(DGPPT,.13)),U),"~")
99 ..I DGPPH=""!(DGPPH["NO") D
100 ...S DGPPH=$P($G(^DPT(DGPPT,.33)),U,9)
101 ...I DGPPH]"" S DGPPH=$P(DGPPH,"~")_"(E)"
102 ... E S DGPPH="NO PHONE"
103 ..;
104 ..I '$D(^DGS(41.42,"B",DFN)) D
105 ...K DD,DO S DIC="^DGS(41.42,",DIC(0)="ML"
106 ...S X=DFN,DGPAPT=$O(^TMP($J,"SDAMA301",DGPN1,X,DGPDT1))
107 ...S DIC("DR")=$P($T(FIELDS),";;",2)
108 ...D FILE^DICN
109 ...S DGPADD=DGPADD+1
110 ..E D
111 ...S DA="",DA=$O(^DGS(41.42,"B",DFN,DA),-1)
112 ...Q:$P($G(^DGS(41.42,DA,0)),U,6)="Y"
113 ...S DIE="^DGS(41.42,"
114 ...S DGPAPT=$O(^TMP($J,"SDAMA301",DGPN1,DGPPT,DGPDT1))
115 ...S DR=$P($T(FIELDS),";;",2)
116 ...D ^DIE
117 ...S DGPUPD=DGPUPD+1
118 ..K DA,DR,DIE,DIC,VADM,VA,DFN,VAERR,VAIN
119 ;
120 D SETTEXT^DGPREBJ(" Total Entries Scanned: "_DGPTOT)
121 D SETTEXT^DGPREBJ(" Called within Time Window: "_DGPTNC)
122 D SETTEXT^DGPREBJ(" Inpatients: "_DGPINP)
123 D SETTEXT^DGPREBJ(" Exclusions by Clinic: "_DGPTCE)
124 D SETTEXT^DGPREBJ(" Exclusions by Eligibility: "_DGPTPE)
125 D SETTEXT^DGPREBJ(" Exclusion for Death: "_DGPTDTH)
126 D SETTEXT^DGPREBJ(" ")
127 D SETTEXT^DGPREBJ(" Total Entries Added to Call List: "_DGPADD)
128 D SETTEXT^DGPREBJ("Total Entries Updated with New Appt.: "_DGPUPD)
129 D SETTEXT^DGPREBJ(" ")
130EXIT ;
131 Q
132SDAMAPI(DGPREI,DGPDT1) ;
133 ; Input: DGPDT1 - Date to look for appointments
134 ;
135 N DGPNDY S DGPNDY=$P($G(^DG(43,1,"DGPRE")),U,5)
136 I DGPNDY']"" D G EXIT
137 . W:DGPREI !!,$P($T(MSG1),";;",2)
138 . D:'DGPREI SETTEXT^DGPREBJ($P($T(MSG1),";;",2)),SETTEXT^DGPREBJ(" ")
139 ;
140 I DGPREI S DGPDT=DGPDT1
141 E S DGPDT=$$FMADD^XLFDT(DT,DGPNDY)
142 ;eg 01/18/2005 if coming from night job tax ('DGPREI)
143 ;and end date (DGPDT) is on a weekend, and the parameter
144 ;says to not run on weekend, it will never go find appointments
145 S DGPDW=$S(DGPREI:$$DOW^XLFDT(DGPDT),1:$$DOW^XLFDT(DT))
146 I $P($G(^DG(43,1,"DGPRE")),U,6)'=1&((DGPDW=6)!(DGPDW=0)) D G EXIT
147 . W:DGPREI !!,$P($T(MSG2),";;",2)
148 . D:'DGPREI SETTEXT^DGPREBJ($P($T(MSG2),";;",2)),SETTEXT^DGPREBJ(" ")
149 D SETTEXT^DGPREBJ("Running: Add New Patients to Call List for "_$$FMTE^XLFDT(DGPDT,2)),SETTEXT^DGPREBJ(" ")
150 ;
151 N DGARRAY,SDCNT
152 S:DGPREI DGARRAY(1)=DGPDT1_";"_DGPDT1
153 S:'DGPREI DGARRAY(1)=DT_";"_DGPDT
154 S DGARRAY("FLDS")=3,SDCNT=$$SDAPI^SDAMA301(.DGARRAY)
155 Q
156 ;
157FIELDS ;;.1///^S X=$P($G(^SC(DGPN1,0)),U,15);1///^S X=$E(VADM(1))_VA("BID");2///^S X=DGPPH;3///^S X=$G(DGPPRDT);5////^S X=DGPN1;6///^S X=DGPAPT;7///^S X=$P(^SC(DGPN1,0),U,8)
158 ;
159MSG1 ;;The 'DAYS TO PULL' is not filled in, unable to determine appoinment date.
160MSG2 ;;The call list is currently not being generated for weekends.
Note: See TracBrowser for help on using the repository browser.