DGPREBJ ;Boise/WRL/ALB/SCK/EG-PreRegistration Night Task Job ; 1/20/05 1:08pm
;;5.3;Registration;**109,581,568,585**;Aug 13, 1993
Q
;
EN ; Main entry point for the Pre-Registration Background Job.
; Variables
; DGPTOD - Current date
; DGPNL - Message line count for mail message
; DGPFNC - Job function
; DGPNDAY - Number of days to keep entries in the call list
; DGPTXT - Message array
; DGPDT - Last date to keep entries in call list for, uses DGPNDAY
; DGPN1-2 - Temporary Var's for $ORDER
; DGPCLD - Count of call log entries purged
;
N DGPTXT,DGPTOD,DGPFNC,DGPNL,DGPCLD,DGPDT,DGPN1,DGPN2,DGPNDAY
;
S DGPTOD=$$DT^XLFDT()
;
S DGPNL=1
;
S DGPFNC=$P($G(^DG(43,1,"DGPRE")),U,3)
I DGPFNC']""!(DGPFNC="N") D MES("MES1") G EXIT
;
; Get Appointment Information
D SDAMAPI^DGPREBJ1(0)
;
; Check for Appointment Database Availability
;if there is no lower level data from the 101 subscript, then it is
;an error, otherwise it could be a valid patient or clinic
;eg 01/20/2005
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
;
; DG/581 - delete certain entries in DGS(41.42
N DGTDAY,DGIEN,DGOLD,DGZERO,DGDFN,DGAPDT,DGKFLAG,DGCLN,DGSTAT
D NOW^%DTC S DGTDAY=%
S (DGIEN,DGOLD)=0
F S DGIEN=$O(^DGS(41.42,DGIEN)) Q:'DGIEN D
.S DGZERO=$G(^DGS(41.42,DGIEN,0)) Q:DGZERO=""
.S DGDFN=$P(DGZERO,U),DGAPDT=$P(DGZERO,U,8),DGCLN=$P(DGZERO,U,7)
.Q:('DGDFN)!('DGAPDT)
.S DGKFLAG=0
.; delete if appt date less than NOW
.I DGAPDT<DGTDAY S DGKFLAG=1
.; check status of appt - delete if no-show, cancelled...
.S DGSTAT=$P($P($G(^TMP($J,"SDAMA301",DGCLN,DGDFN,DGAPDT)),U,3),";")
.I DGSTAT'="",DGSTAT'="R" S DGKFLAG=1
.I DGKFLAG S DIK="^DGS(41.42,",DA=DGIEN D ^DIK K DIK S DGOLD=DGOLD+1
D SETTEXT("Number of old or cancelled records deleted from the Call List: "_DGOLD)
D SETTEXT("")
;
I DGPFNC="D" D KILLALL
I DGPFNC="P" D PURGECP
I DGPFNC="DA" D KILLALL,ADDNEW^DGPREBJ1(0,DGPDT)
I DGPFNC="PA" D ADDNEW^DGPREBJ1(0,DGPDT),PURGECP
I DGPFNC="AO" D ADDNEW^DGPREBJ1(0,DGPDT)
;
; Purge call log entries beyond Days to Keep limit
S DGPNDAY=$P($G(^DG(43,1,"DGPRE")),U,4)
G:DGPNDAY']"" EXIT
;
D SETTEXT("Running: Purge Call Log.")
;
S DGPDT=$$FMADD^XLFDT(DGPTOD,-DGPNDAY)
S DGPCLD=0
S DGPN1=0 F S DGPN1=$O(^DGS(41.43,"B",DGPN1)) Q:'DGPN1!(DGPN1>DGPDT) D
. S DGPN2=0 F S DGPN2=$O(^DGS(41.43,"B",DGPN1,DGPN2)) Q:'DGPN2 D
.. S DGPCLD=DGPCLD+1
.. S DIK="^DGS(41.43,"
.. S DA=DGPN2
.. D ^DIK K DIC
;
D SETTEXT("Number of Entries Deleted From Call History: "_DGPCLD)
D SETTEXT(" ")
;
EXIT ;
D SEND
Q
;
SEND ; Send notification of actions taken to mailgroup
S XMY("G.DGPRE PRE-REG STAFF")=""
S XMDUZ=$S($G(DUZ)>0:DUZ,1:.5)
S XMTEXT="DGPTXT("
S XMSUB="PRE-REGISTRATION NIGHTLY JOB REPORT"
D XMZ^XMA2
D:XMZ>0 ^XMD
K XMY,XMDUZ,XMTEXT,XMSUB
Q
;
SETTEXT(DGLINE) ; Add text line to message array
S DGPTXT(DGPNL)=DGLINE
S DGPNL=DGPNL+1
Q
;
PURGECP ; Purge called patients from the Pre-registration call list
; Variables
; DGPDEL - Counter of records deleted
;
N DGPDEL
S DGPDEL=0
;
D PRGLST^DGPREP4(0,.DGPDEL)
;
D SETTEXT(DGPDEL_" Called Patients Purged.")
D SETTEXT(" ")
Q
;
KILLALL ; Clear all entries from the pre-registration call list.
; Variables
; DGPTOT - Counter if entries deleted
;
N DGPTOT
S DGPTOT=0
;
D CLRLST^DGPREP4(0,.DGPTOT)
;
D SETTEXT(DGPTOT_" Entries Deleted from the Call List.")
D SETTEXT(" ")
Q
;
MES(TAG) ; Build message for missing parameters
N DGMES,I
;
F I=1:1 S DGMES=$P($T(@TAG+I),";;",2,99) Q:DGMES="$$END" D SETTEXT(DGMES)
D SETTEXT(" ")
Q
;
MES1 ;
;;There is either no entry or a 'No Action' entry in the 'CALL LIST NIGHT JOB
;;FUNCTION' field in the site parameter file. No action will be taken on the
;;Call List.
;;$$END
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPREBJ 4090 printed Nov 22, 2024@18:01:01 Page 2
DGPREBJ ;Boise/WRL/ALB/SCK/EG-PreRegistration Night Task Job ; 1/20/05 1:08pm
+1 ;;5.3;Registration;**109,581,568,585**;Aug 13, 1993
+2 QUIT
+3 ;
EN ; Main entry point for the Pre-Registration Background Job.
+1 ; Variables
+2 ; DGPTOD - Current date
+3 ; DGPNL - Message line count for mail message
+4 ; DGPFNC - Job function
+5 ; DGPNDAY - Number of days to keep entries in the call list
+6 ; DGPTXT - Message array
+7 ; DGPDT - Last date to keep entries in call list for, uses DGPNDAY
+8 ; DGPN1-2 - Temporary Var's for $ORDER
+9 ; DGPCLD - Count of call log entries purged
+10 ;
+11 NEW DGPTXT,DGPTOD,DGPFNC,DGPNL,DGPCLD,DGPDT,DGPN1,DGPN2,DGPNDAY
+12 ;
+13 SET DGPTOD=$$DT^XLFDT()
+14 ;
+15 SET DGPNL=1
+16 ;
+17 SET DGPFNC=$PIECE($GET(^DG(43,1,"DGPRE")),U,3)
+18 IF DGPFNC']""!(DGPFNC="N")
DO MES("MES1")
GOTO EXIT
+19 ;
+20 ; Get Appointment Information
+21 DO SDAMAPI^DGPREBJ1(0)
+22 ;
+23 ; Check for Appointment Database Availability
+24 ;if there is no lower level data from the 101 subscript, then it is
+25 ;an error, otherwise it could be a valid patient or clinic
+26 ;eg 01/20/2005
+27 IF $DATA(^TMP($JOB,"SDAMA301"))
IF $DATA(^TMP($JOB,"SDAMA301",101))=1
DO SETTEXT^DGPREBJ("SDAMAPI - Appointment Database is Unavailable.")
DO SETTEXT^DGPREBJ("Unable to update Call List.")
DO SEND
KILL ^TMP($JOB,"SDAMA301")
QUIT
+28 ;
+29 ; DG/581 - delete certain entries in DGS(41.42
+30 NEW DGTDAY,DGIEN,DGOLD,DGZERO,DGDFN,DGAPDT,DGKFLAG,DGCLN,DGSTAT
+31 DO NOW^%DTC
SET DGTDAY=%
+32 SET (DGIEN,DGOLD)=0
+33 FOR
SET DGIEN=$ORDER(^DGS(41.42,DGIEN))
if 'DGIEN
QUIT
Begin DoDot:1
+34 SET DGZERO=$GET(^DGS(41.42,DGIEN,0))
if DGZERO=""
QUIT
+35 SET DGDFN=$PIECE(DGZERO,U)
SET DGAPDT=$PIECE(DGZERO,U,8)
SET DGCLN=$PIECE(DGZERO,U,7)
+36 if ('DGDFN)!('DGAPDT)
QUIT
+37 SET DGKFLAG=0
+38 ; delete if appt date less than NOW
+39 IF DGAPDT<DGTDAY
SET DGKFLAG=1
+40 ; check status of appt - delete if no-show, cancelled...
+41 SET DGSTAT=$PIECE($PIECE($GET(^TMP($JOB,"SDAMA301",DGCLN,DGDFN,DGAPDT)),U,3),";")
+42 IF DGSTAT'=""
IF DGSTAT'="R"
SET DGKFLAG=1
+43 IF DGKFLAG
SET DIK="^DGS(41.42,"
SET DA=DGIEN
DO ^DIK
KILL DIK
SET DGOLD=DGOLD+1
End DoDot:1
+44 DO SETTEXT("Number of old or cancelled records deleted from the Call List: "_DGOLD)
+45 DO SETTEXT("")
+46 ;
+47 IF DGPFNC="D"
DO KILLALL
+48 IF DGPFNC="P"
DO PURGECP
+49 IF DGPFNC="DA"
DO KILLALL
DO ADDNEW^DGPREBJ1(0,DGPDT)
+50 IF DGPFNC="PA"
DO ADDNEW^DGPREBJ1(0,DGPDT)
DO PURGECP
+51 IF DGPFNC="AO"
DO ADDNEW^DGPREBJ1(0,DGPDT)
+52 ;
+53 ; Purge call log entries beyond Days to Keep limit
+54 SET DGPNDAY=$PIECE($GET(^DG(43,1,"DGPRE")),U,4)
+55 if DGPNDAY']""
GOTO EXIT
+56 ;
+57 DO SETTEXT("Running: Purge Call Log.")
+58 ;
+59 SET DGPDT=$$FMADD^XLFDT(DGPTOD,-DGPNDAY)
+60 SET DGPCLD=0
+61 SET DGPN1=0
FOR
SET DGPN1=$ORDER(^DGS(41.43,"B",DGPN1))
if 'DGPN1!(DGPN1>DGPDT)
QUIT
Begin DoDot:1
+62 SET DGPN2=0
FOR
SET DGPN2=$ORDER(^DGS(41.43,"B",DGPN1,DGPN2))
if 'DGPN2
QUIT
Begin DoDot:2
+63 SET DGPCLD=DGPCLD+1
+64 SET DIK="^DGS(41.43,"
+65 SET DA=DGPN2
+66 DO ^DIK
KILL DIC
End DoDot:2
End DoDot:1
+67 ;
+68 DO SETTEXT("Number of Entries Deleted From Call History: "_DGPCLD)
+69 DO SETTEXT(" ")
+70 ;
EXIT ;
+1 DO SEND
+2 QUIT
+3 ;
SEND ; Send notification of actions taken to mailgroup
+1 SET XMY("G.DGPRE PRE-REG STAFF")=""
+2 SET XMDUZ=$SELECT($GET(DUZ)>0:DUZ,1:.5)
+3 SET XMTEXT="DGPTXT("
+4 SET XMSUB="PRE-REGISTRATION NIGHTLY JOB REPORT"
+5 DO XMZ^XMA2
+6 if XMZ>0
DO ^XMD
+7 KILL XMY,XMDUZ,XMTEXT,XMSUB
+8 QUIT
+9 ;
SETTEXT(DGLINE) ; Add text line to message array
+1 SET DGPTXT(DGPNL)=DGLINE
+2 SET DGPNL=DGPNL+1
+3 QUIT
+4 ;
PURGECP ; Purge called patients from the Pre-registration call list
+1 ; Variables
+2 ; DGPDEL - Counter of records deleted
+3 ;
+4 NEW DGPDEL
+5 SET DGPDEL=0
+6 ;
+7 DO PRGLST^DGPREP4(0,.DGPDEL)
+8 ;
+9 DO SETTEXT(DGPDEL_" Called Patients Purged.")
+10 DO SETTEXT(" ")
+11 QUIT
+12 ;
KILLALL ; Clear all entries from the pre-registration call list.
+1 ; Variables
+2 ; DGPTOT - Counter if entries deleted
+3 ;
+4 NEW DGPTOT
+5 SET DGPTOT=0
+6 ;
+7 DO CLRLST^DGPREP4(0,.DGPTOT)
+8 ;
+9 DO SETTEXT(DGPTOT_" Entries Deleted from the Call List.")
+10 DO SETTEXT(" ")
+11 QUIT
+12 ;
MES(TAG) ; Build message for missing parameters
+1 NEW DGMES,I
+2 ;
+3 FOR I=1:1
SET DGMES=$PIECE($TEXT(@TAG+I),";;",2,99)
if DGMES="$$END"
QUIT
DO SETTEXT(DGMES)
+4 DO SETTEXT(" ")
+5 QUIT
+6 ;
MES1 ;
+1 ;;There is either no entry or a 'No Action' entry in the 'CALL LIST NIGHT JOB
+2 ;;FUNCTION' field in the site parameter file. No action will be taken on the
+3 ;;Call List.
+4 ;;$$END
