Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGPREBJ1

DGPREBJ1.m

Go to the documentation of this file. 
  1. DGPREBJ1 ;ALB/SCK/EG/PC - PreRegistration Background job cont. ;Jul 25, 2019@14:53
  1.  ;;5.3;Registration;**109,568,585,980**;Aug 13, 1993;Build 4
  1.  Q
  1.  ;
  1. EN ; Interactive entry (from option)
  1.  ; Variables
  1.  ;    DGPTOD   - Todays date from DT  
  1.  ;    DGPNL    - No. of lines in message array
  1.  ;    DGPTXT   - Message array from ADDNEW procedure 
  1.  ;    DGPP     - Default date to look for appointments
  1.  ;    I1,X1-2  - Local variables  for counters and date manipulation
  1.  ;
  1.  I '$D(^XUSEC("DGPRE SUPV",DUZ)) D  G ENQ
  1.  . W !!,"You do not have the DG PREREGISTRATION Key allocated, contact your MAS ADPAC."
  1.  ;
  1.  N DGPDT,DGPTOD,DGPNL,DGPTXT,DGPP,I1,X,X1,X2,Y
  1.  S X1=$P($$NOW^XLFDT,"."),X2=$P($G(^DG(43,1,"DGPRE")),U,5) S:X2']"" X2=14
  1.  S DGPP=$$FMADD^XLFDT(X1,X2)
  1.  S DIR("B")=$$FMTE^XLFDT(DGPP,1)
  1.  S DIR(0)="DA^::EX",DIR("A")="Enter Appointment date to search: "
  1.  D ^DIR K DIR
  1.  G:$D(DIRUT) ENQ
  1.  S DGPNL=0,DGPTOD=DT,DGPDT1=Y
  1.  D WAIT^DICD
  1.  D SDAMAPI(1,DGPDT1)
  1.  D ADDNEW(1,DGPDT1)
  1.  I $D(DGPTXT) W !!,"Results of updating the Call List with new entries",!
  1.  S I1=0 F  S I1=$O(DGPTXT(I1)) Q:'I1  W !,DGPTXT(I1)
  1. ENQ K DIRUT,DUOUT,DTOUT,DIROUT,DGARRAY,SCDNT,^TMP($J,"SDAMA301")
  1.  Q
  1.  ;
  1. ADDNEW(DGPREI,DGPDT1) ;  Searches for appointments to add to the Call List
  1.  ;   Variables
  1.  ;     Input:
  1.  ;        DGPREI  -  Flag indicating how the procedure was called.
  1.  ;                   0 - called by background job
  1.  ;                   1 - called by option (interactive)
  1.  ;        DGPDT1  -  Date to look for appointments, Required when
  1.  ;                   DGPREI = 1
  1.  ;
  1.  ;     DGPDW   - Day of the week
  1.  ;     DGPNDY  - Number of days ahead to look for appt.
  1.  ;     DGPDT   - Date to look for appt. ( DT + DGPNDY)
  1.  ;     DGPTOT  - Counter, total records scanned
  1.  ;     DGPPT   - Pointer to patient file, #2
  1.  ;     DGPTDTH - Counter for patient alias's found
  1.  ;     DGPEXCL - Exclude flag
  1.  ;     DGPTCE  - Counter of appts. excluded because of clinic
  1.  ;     DGPTPE  - Counter of appts. excluded because of eligibility 
  1.  ;     DGPINP  - counter of appts. excluded because of inpatient
  1.  ;     DGPTNC  - Counter of appts. excluded because next appt. is within
  1.  ;               DAYS BETWEEN CALLS entry in the MAS PARAMETER File
  1.  ;     DGPADD  - Counter, entries added to call list
  1.  ;     DGPAPT  - Date and time off appointment
  1.  ;     DGPPRDT - Date pre-registration audit file last updated for patient
  1.  ;     DGPNDTW - DAYS BETWEEN CALLS value
  1.  ;     DGPSV   - Medical Service code
  1.  ;     DGPPN   - Patients Name
  1.  ;     DGPPH   - Patients Phone number
  1.  ;     DGPSN   - Patients last four
  1.  ;     DGPN1-5 - Temporary variables for $O
  1.  ;
  1.  ; Check for Appointment Database Availability
  1.  ;if there is no lower level data from the 101 subscript, then it
  1.  ;really is a valid error, otherwise, it could be a patient
  1.  ;or clinic eg 01/20/2005
  1.  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
  1.  ;
  1.  N DGPADD,DGPTOT,DGPTCE,DGPTPE,DGPTNC,DGPTDTH,DGPINP,DGPUPD,DGPN1,DGPAPT
  1.  N DGPPH,DGPDW,DGPPT,DGPPRDT,DGPNDTW,DGPN5,DGPEXCL,CKAPDT
  1.  S (DGPADD,DGPTOT,DGPTCE,DGPTPE,DGPTNC,DGPTDTH,DGPINP,DGPUPD)=0
  1.  S DGPN1=0 F  S DGPN1=$O(^TMP($J,"SDAMA301",DGPN1)) Q:'DGPN1  D
  1.  .S DGPPT=0 F  S DGPPT=$O(^TMP($J,"SDAMA301",DGPN1,DGPPT)) Q:'DGPPT  D
  1.  ..S CKAPDT=+$O(^TMP($J,"SDAMA301",DGPN1,DGPPT,DGPDT1))
  1.  ..Q:('CKAPDT!(CKAPDT>$$FMADD^XLFDT(DGPDT1,1)))
  1.  ..S DGPTOT=DGPTOT+1
  1.  ..I $P($G(^DPT(DGPPT,.35)),U)]"" S DGPTDTH=DGPTDTH+1 Q
  1.  ..; ***  Check for clinic exclusions in MAS PARAMETER File
  1.  ..S (DGPN5,DGPEXCL)=0
  1.  ..F  S DGPN5=$O(^DG(43,1,"DGPREC",DGPN5)) Q:'DGPN5!(DGPEXCL)  D
  1.  ...S:$P(^DG(43,1,"DGPREC",DGPN5,0),U)=DGPN1 DGPEXCL=1
  1.  ..I DGPEXCL S DGPTCE=DGPTCE+1 Q
  1.  ..; *** Check for eligibility exclusions inthe MAS PARAMETER File
  1.  ..N DGPAELG S (DGPN5,DGPEXCL)=0
  1.  ..F  S DGPN5=$O(^DG(43,1,"DGPREE",DGPN5)) Q:'DGPN5!(DGPEXCL)  D
  1.  ...S DGPAELG=$P($G(^DPT(DGPPT,.36)),U)
  1.  ...S:$P(^DG(43,1,"DGPREE",DGPN5,0),U)=DGPAELG DGPEXCL=1
  1.  ..I DGPEXCL S DGPTPE=DGPTPE+1 Q
  1.  ..; ***  Check for inpatient status
  1.  ..K DFN S DFN=DGPPT D INP^VADPT
  1.  ..I $G(VAIN(1))]"" S DGPINP=DGPINP+1 Q
  1.  ..; *** Check for last update in Pre-Registration Audit file
  1.  ..S DGPPRDT=DGPTOD+.9999,DGPPRDT=$O(^DGS(41.41,"ADC",DGPPT,DGPPRDT),-1)
  1.  ..S DGPNDTW=$P($G(^DG(43,1,"DGPRE")),U,2)
  1.  ..I DGPPRDT]""&(DGPNDTW]"") I $$FMDIFF^XLFDT(DGPDT,DGPPRDT,1)<DGPNDTW S DGPTNC=DGPTNC+1 Q 
  1.  ..; *** Set up entries for adding to Pre-Registration Call List file
  1.  ..K DFN S DFN=DGPPT D DEM^VADPT
  1.  ..S DGPPH=$P($P($G(^DPT(DGPPT,.13)),U),"~")
  1.  ..I DGPPH=""!(DGPPH["NO") D
  1.  ...S DGPPH=$P($G(^DPT(DGPPT,.33)),U,9)
  1.  ...I DGPPH]"" S DGPPH=$P(DGPPH,"~")_"(E)"
  1.  ... E  S DGPPH="NO PHONE"
  1.  ..;
  1.  ..I '$D(^DGS(41.42,"B",DFN)) D
  1.  ...K DD,DO S DIC="^DGS(41.42,",DIC(0)="ML"
  1.  ...S X=DFN,DGPAPT=$O(^TMP($J,"SDAMA301",DGPN1,X,DGPDT1))
  1.  ...S DIC("DR")=$P($T(FIELDS),";;",2)
  1.  ...D FILE^DICN
  1.  ...S DGPADD=DGPADD+1
  1.  ..E  D
  1.  ...S DA="",DA=$O(^DGS(41.42,"B",DFN,DA),-1)
  1.  ...Q:$P($G(^DGS(41.42,DA,0)),U,6)="Y"
  1.  ...S DIE="^DGS(41.42,"
  1.  ...S DGPAPT=$O(^TMP($J,"SDAMA301",DGPN1,DGPPT,DGPDT1))
  1.  ...S DR=$P($T(FIELDS),";;",2)
  1.  ...D ^DIE
  1.  ...S DGPUPD=DGPUPD+1
  1.  ..K DA,DR,DIE,DIC,VADM,VA,DFN,VAERR,VAIN
  1.  ;
  1.  D SETTEXT^DGPREBJ("      Total Entries Scanned: "_DGPTOT)
  1.  D SETTEXT^DGPREBJ("  Called within Time Window: "_DGPTNC)
  1.  D SETTEXT^DGPREBJ("                 Inpatients: "_DGPINP)
  1.  D SETTEXT^DGPREBJ("       Exclusions by Clinic: "_DGPTCE)
  1.  D SETTEXT^DGPREBJ("  Exclusions by Eligibility: "_DGPTPE)
  1.  D SETTEXT^DGPREBJ("        Exclusion for Death: "_DGPTDTH)
  1.  D SETTEXT^DGPREBJ(" ")
  1.  D SETTEXT^DGPREBJ("    Total Entries Added to Call List: "_DGPADD)
  1.  D SETTEXT^DGPREBJ("Total Entries Updated with New Appt.: "_DGPUPD)
  1.  D SETTEXT^DGPREBJ(" ")
  1. EXIT ;
  1.  Q
  1. SDAMAPI(DGPREI,DGPDT1) ;
  1.  ; Input: DGPDT1 - Date to look for appointments
  1.  ;
  1.  N DGPNDY S DGPNDY=$P($G(^DG(43,1,"DGPRE")),U,5)
  1.  I DGPNDY']"" D  G EXIT
  1.  . W:DGPREI !!,$P($T(MSG1),";;",2)
  1.  . D:'DGPREI SETTEXT^DGPREBJ($P($T(MSG1),";;",2)),SETTEXT^DGPREBJ("  ")
  1.  ;
  1.  I DGPREI S DGPDT=DGPDT1
  1.  E  S DGPDT=$$FMADD^XLFDT(DT,DGPNDY)
  1.  ;eg 01/18/2005 if coming from night job tax ('DGPREI)
  1.  ;and end date (DGPDT) is on a weekend, and the parameter
  1.  ;says to not run on weekend, it will never go find appointments
  1.  S DGPDW=$S(DGPREI:$$DOW^XLFDT(DGPDT),1:$$DOW^XLFDT(DT))
  1.  I $P($G(^DG(43,1,"DGPRE")),U,6)'=1&((DGPDW=6)!(DGPDW=0)) D  G EXIT
  1.  . W:DGPREI !!,$P($T(MSG2),";;",2)
  1.  . D:'DGPREI SETTEXT^DGPREBJ($P($T(MSG2),";;",2)),SETTEXT^DGPREBJ("  ")
  1.  D SETTEXT^DGPREBJ("Running: Add New Patients to Call List for "_$$FMTE^XLFDT(DGPDT,2)),SETTEXT^DGPREBJ(" ")
  1.  ;
  1.  N DGARRAY,SDCNT
  1.  S:DGPREI DGARRAY(1)=DGPDT1_";"_DGPDT1
  1.  S:'DGPREI DGARRAY(1)=DT_";"_DGPDT
  1.  S DGARRAY("FLDS")=3,SDCNT=$$SDAPI^SDAMA301(.DGARRAY)
  1.  Q
  1.  ; VSR patch DG*5.3.980 change four slashes to three slashes for validation.  Changed field 5
  1. 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)
  1.  ;
  1. MSG1 ;;The 'DAYS TO PULL' is not filled in, unable to determine appointment date.
  1. MSG2 ;;The call list is currently not being generated for weekends.