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

DGPREBJ.m

Go to the documentation of this file. 
  1. DGPREBJ ;Boise/WRL/ALB/SCK/EG-PreRegistration Night Task Job ; 1/20/05 1:08pm
  1.  ;;5.3;Registration;**109,581,568,585,1015**;Aug 13, 1993;Build 21
  1.  Q
  1.  ;
  1. EN ;  Main entry point for the Pre-Registration Background Job.
  1.  ;  Variables
  1.  ;     DGPTOD  -  Current date
  1.  ;     DGPNL   -  Message line count for mail message 
  1.  ;     DGPFNC  -  Job function
  1.  ;     DGPNDAY -  Number of days to keep entries in the call list
  1.  ;     DGPTXT  -  Message array
  1.  ;     DGPDT   -  Last date to keep entries in call list for, uses DGPNDAY
  1.  ;     DGPN1-2 -  Temporary Var's for $ORDER
  1.  ;     DGPCLD  -  Count of call log entries purged 
  1.  ;
  1.  N DGPTXT,DGPTOD,DGPFNC,DGPNL,DGPCLD,DGPDT,DGPN1,DGPN2,DGPNDAY
  1.  ;
  1.  S DGPTOD=$$DT^XLFDT()
  1.  ;
  1.  S DGPNL=1
  1.  ;
  1.  S DGPFNC=$P($G(^DG(43,1,"DGPRE")),U,3)
  1.  I DGPFNC']""!(DGPFNC="N") D MES("MES1") G EXIT
  1.  ;
  1.  ; Get Appointment Information
  1.  D SDAMAPI^DGPREBJ1(0)
  1.  ;
  1.  ; Check for Appointment Database Availability
  1.  ;if there is no lower level data from the 101 subscript, then it is
  1.  ;an error, otherwise it could be a valid patient or clinic
  1.  ;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."),SEND K ^TMP($J,"SDAMA301") Q
  1.  ;
  1.  ; DG/581 - delete certain entries in DGS(41.42
  1.  N DGTDAY,DGIEN,DGOLD,DGZERO,DGDFN,DGAPDT,DGKFLAG,DGCLN,DGSTAT
  1.  D NOW^%DTC S DGTDAY=%
  1.  S (DGIEN,DGOLD)=0
  1.  F  S DGIEN=$O(^DGS(41.42,DGIEN)) Q:'DGIEN  D
  1.  .S DGZERO=$G(^DGS(41.42,DGIEN,0)) Q:DGZERO=""
  1.  .S DGDFN=$P(DGZERO,U),DGAPDT=$P(DGZERO,U,8),DGCLN=$P(DGZERO,U,7)
  1.  .Q:('DGDFN)!('DGAPDT)
  1.  .S DGKFLAG=0
  1.  .; delete if appt date less than NOW
  1.  .I DGAPDT<DGTDAY S DGKFLAG=1
  1.  .; check status of appt - delete if no-show, cancelled...
  1.  .S DGSTAT=$P($P($G(^TMP($J,"SDAMA301",DGCLN,DGDFN,DGAPDT)),U,3),";")
  1.  .I DGSTAT'="",DGSTAT'="R" S DGKFLAG=1
  1.  .I DGKFLAG S DIK="^DGS(41.42,",DA=DGIEN D ^DIK K DIK S DGOLD=DGOLD+1
  1.  D SETTEXT("Number of old or cancelled records deleted from the Call List: "_DGOLD)
  1.  D SETTEXT("")
  1.  ;
  1.  I DGPFNC="D" D KILLALL
  1.  I DGPFNC="P" D PURGECP
  1.  I DGPFNC="DA" D KILLALL,ADDNEW^DGPREBJ1(0,DGPDT)
  1.  I DGPFNC="PA" D ADDNEW^DGPREBJ1(0,DGPDT),PURGECP
  1.  I DGPFNC="AO" D ADDNEW^DGPREBJ1(0,DGPDT)
  1.  ;
  1.  ; Purge call log entries beyond Days to Keep limit
  1.  S DGPNDAY=$P($G(^DG(43,1,"DGPRE")),U,4)
  1.  G:DGPNDAY']"" EXIT
  1.  ;
  1.  D SETTEXT("Running: Purge Call Log.")
  1.  ;
  1.  S DGPDT=$$FMADD^XLFDT(DGPTOD,-DGPNDAY)
  1.  S DGPCLD=0
  1.  S DGPN1=0 F  S DGPN1=$O(^DGS(41.43,"B",DGPN1)) Q:'DGPN1!(DGPN1>DGPDT)  D
  1.  . S DGPN2=0 F  S DGPN2=$O(^DGS(41.43,"B",DGPN1,DGPN2)) Q:'DGPN2  D
  1.  .. S DGPCLD=DGPCLD+1
  1.  .. S DIK="^DGS(41.43,"
  1.  .. S DA=DGPN2
  1.  .. D ^DIK K DIC
  1.  ;
  1.  D SETTEXT("Number of Entries Deleted From Call History: "_DGPCLD)
  1.  D SETTEXT(" ")
  1.  ;
  1. EXIT ;
  1.  D SEND
  1.  Q
  1.  ;
  1. SEND ;  Send notification of actions taken to mailgroup
  1.  S XMY("G.DGPRE PRE-REG STAFF")=""
  1.  S XMDUZ=$S($G(DUZ)>0:DUZ,1:.5)
  1.  S XMTEXT="DGPTXT("
  1.  S XMSUB="PRE-REGISTRATION NIGHTLY JOB REPORT"
  1.  D XMZ^XMA2
  1.  D:XMZ>0 ^XMD
  1.  K XMY,XMDUZ,XMTEXT,XMSUB
  1.  Q
  1.  ;
  1. SETTEXT(DGLINE) ;  Add text line to message array
  1.  S DGPTXT(DGPNL)=DGLINE
  1.  S DGPNL=DGPNL+1
  1.  Q
  1.  ;
  1. PURGECP ;  Purge called patients from the Pre-registration call list
  1.  ;  Variables
  1.  ;     DGPDEL - Counter of records deleted
  1.  ;
  1.  N DGPDEL
  1.  S DGPDEL=0
  1.  ;
  1.  D PRGLST^DGPREP4(0,.DGPDEL)
  1.  ;
  1.  D SETTEXT(DGPDEL_" Called Patients Purged.")
  1.  D SETTEXT(" ")
  1.  Q
  1.  ;
  1. KILLALL ;  Clear all entries from the pre-registration call list.
  1.  ;   Variables
  1.  ;    DGPTOT  - Counter if entries deleted
  1.  ;
  1.  N DGPTOT
  1.  S DGPTOT=0
  1.  ;
  1.  D CLRLST^DGPREP4(0,.DGPTOT)
  1.  ;
  1.  D SETTEXT(DGPTOT_" Entries Deleted from the Call List.")
  1.  D SETTEXT(" ")
  1.  Q
  1.  ;
  1. MES(TAG) ; Build message for missing parameters
  1.  N DGMES,I
  1.  ;
  1.  F I=1:1 S DGMES=$P($T(@TAG+I),";;",2,99) Q:DGMES="$$END"  D SETTEXT(DGMES)
  1.  D SETTEXT(" ")
  1.  Q
  1.  ;
  1. MES1 ; 
  1.  ;;There is either no entry or a 'No Action' entry in the 'CALL LIST NIGHT JOB
  1.  ;;FUNCTION' field in the site parameter file. No action will be taken on the
  1.  ;;Call List.
  1.  ;;$$END