| [613] | 1 | DGPREBJ1 ;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 | ;
|
|---|
| 5 | EN ; 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)
|
|---|
| 29 | ENQ K DIRUT,DUOUT,DTOUT,DIROUT,DGARRAY,SCDNT,^TMP($J,"SDAMA301")
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
| 32 | ADDNEW(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(" ")
|
|---|
| 130 | EXIT ;
|
|---|
| 131 | Q
|
|---|
| 132 | SDAMAPI(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 | ;
|
|---|
| 157 | FIELDS ;;.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 | ;
|
|---|
| 159 | MSG1 ;;The 'DAYS TO PULL' is not filled in, unable to determine appoinment date.
|
|---|
| 160 | MSG2 ;;The call list is currently not being generated for weekends.
|
|---|
