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

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1DGPREBJ ;Boise/WRL/ALB/SCK/EG-PreRegistration Night Task Job ; 1/20/05 1:08pm
2 ;;5.3;Registration;**109,581,568,585**;Aug 13, 1993
3 Q
4 ;
5EN ; Main entry point for the Pre-Registration Background Job.
6 ; Variables
7 ; DGPTOD - Current date
8 ; DGPNL - Message line count for mail message
9 ; DGPFNC - Job function
10 ; DGPNDAY - Number of days to keep entries in the call list
11 ; DGPTXT - Message array
12 ; DGPDT - Last date to keep entries in call list for, uses DGPNDAY
13 ; DGPN1-2 - Temporary Var's for $ORDER
14 ; DGPCLD - Count of call log entries purged
15 ;
16 N DGPTXT,DGPTOD,DGPFNC,DGPNL,DGPCLD,DGPDT,DGPN1,DGPN2,DGPNDAY
17 ;
18 S DGPTOD=$$DT^XLFDT()
19 ;
20 S DGPNL=1
21 ;
22 S DGPFNC=$P($G(^DG(43,1,"DGPRE")),U,3)
23 I DGPFNC']""!(DGPFNC="N") D MES("MES1") G EXIT
24 ;
25 ; Get Appointment Information
26 D SDAMAPI^DGPREBJ1(0)
27 ;
28 ; Check for Appointment Database Availability
29 ;if there is no lower level data from the 101 subscript, then it is
30 ;an error, otherwise it could be a valid patient or clinic
31 ;eg 01/20/2005
32 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
33 ;
34 ; DG/581 - delete certain entries in DGS(41.42
35 N DGTDAY,DGIEN,DGOLD,DGZERO,DGDFN,DGAPDT,DGKFLAG,DGCLN,DGSTAT
36 D NOW^%DTC S DGTDAY=%
37 S (DGIEN,DGOLD)=0
38 F S DGIEN=$O(^DGS(41.42,DGIEN)) Q:'DGIEN D
39 .S DGZERO=$G(^DGS(41.42,DGIEN,0)) Q:DGZERO=""
40 .S DGDFN=$P(DGZERO,U),DGAPDT=$P(DGZERO,U,8),DGCLN=$P(DGZERO,U,7)
41 .Q:('DGDFN)!('DGAPDT)
42 .S DGKFLAG=0
43 .; delete if appt date less than NOW
44 .I DGAPDT<DGTDAY S DGKFLAG=1
45 .; check status of appt - delete if no-show, cancelled...
46 .S DGSTAT=$P($P($G(^TMP($J,"SDAMA301",DGCLN,DGDFN,DGAPDT)),U,3),";")
47 .I DGSTAT'="",DGSTAT'="R" S DGKFLAG=1
48 .I DGKFLAG S DIK="^DGS(41.42,",DA=DGIEN D ^DIK K DIK S DGOLD=DGOLD+1
49 D SETTEXT("Number of old or cancelled records deleted from the Call List: "_DGOLD)
50 D SETTEXT("")
51 ;
52 I DGPFNC="D" D KILLALL
53 I DGPFNC="P" D PURGECP
54 I DGPFNC="DA" D KILLALL,ADDNEW^DGPREBJ1(0,DGPDT)
55 I DGPFNC="PA" D ADDNEW^DGPREBJ1(0,DGPDT),PURGECP
56 I DGPFNC="AO" D ADDNEW^DGPREBJ1(0,DGPDT)
57 ;
58 ; Purge call log entries beyond Days to Keep limit
59 S DGPNDAY=$P($G(^DG(43,1,"DGPRE")),U,4)
60 G:DGPNDAY']"" EXIT
61 ;
62 D SETTEXT("Running: Purge Call Log.")
63 ;
64 S DGPDT=$$FMADD^XLFDT(DGPTOD,-DGPNDAY)
65 S DGPCLD=0
66 S DGPN1=0 F S DGPN1=$O(^DGS(41.43,"B",DGPN1)) Q:'DGPN1!(DGPN1>DGPDT) D
67 . S DGPN2=0 F S DGPN2=$O(^DGS(41.43,"B",DGPN1,DGPN2)) Q:'DGPN2 D
68 .. S DGPCLD=DGPCLD+1
69 .. S DIK="^DGS(41.43,"
70 .. S DA=DGPN2
71 .. D ^DIK K DIC
72 ;
73 D SETTEXT("Number of Entries Deleted From Call History: "_DGPCLD)
74 D SETTEXT(" ")
75 ;
76EXIT ;
77 D SEND
78 Q
79 ;
80SEND ; Send notification of actions taken to mailgroup
81 S XMY("G.DGPRE PRE-REG STAFF")=""
82 S XMDUZ=$S($G(DUZ)>0:DUZ,1:.5)
83 S XMTEXT="DGPTXT("
84 S XMSUB="PRE-REGISTRATION NIGHTLY JOB REPORT"
85 D XMZ^XMA2
86 D:XMZ>0 ^XMD
87 K XMY,XMDUZ,XMTEXT,XMSUB
88 Q
89 ;
90SETTEXT(DGLINE) ; Add text line to message array
91 S DGPTXT(DGPNL)=DGLINE
92 S DGPNL=DGPNL+1
93 Q
94 ;
95PURGECP ; Purge called patients from the Pre-registration call list
96 ; Variables
97 ; DGPDEL - Counter of records deleted
98 ;
99 N DGPDEL
100 S DGPDEL=0
101 ;
102 D PRGLST^DGPREP4(0,.DGPDEL)
103 ;
104 D SETTEXT(DGPDEL_" Called Patients Purged.")
105 D SETTEXT(" ")
106 Q
107 ;
108KILLALL ; Clear all entries from the pre-registration call list.
109 ; Variables
110 ; DGPTOT - Counter if entries deleted
111 ;
112 N DGPTOT
113 S DGPTOT=0
114 ;
115 D CLRLST^DGPREP4(0,.DGPTOT)
116 ;
117 D SETTEXT(DGPTOT_" Entries Deleted from the Call List.")
118 D SETTEXT(" ")
119 Q
120 ;
121MES(TAG) ; Build message for missing parameters
122 N DGMES,I
123 ;
124 F I=1:1 S DGMES=$P($T(@TAG+I),";;",2,99) Q:DGMES="$$END" D SETTEXT(DGMES)
125 D SETTEXT(" ")
126 Q
127 ;
128MES1 ;
129 ;;There is either no entry or a 'No Action' entry in the 'CALL LIST NIGHT JOB
130 ;;FUNCTION' field in the site parameter file. No action will be taken on the
131 ;;Call List.
132 ;;$$END
Note: See TracBrowser for help on using the repository browser.