source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPFBGR.m@ 1251

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

initial load of FOIAVistA 6/30/08 version
File size: 6.0 KB
Line 
1DGPFBGR ;ALB/RPM - PRF BACKGROUND PROCESSING DRIVER ; 6/3/05 12:25pm
2 ;;5.3;Registration;**425,650**;Aug 13, 1993;Build 3
3 ;
4 Q ;no direct entry
5 ;
6EN ;entry point for PRF background processing
7 ;
8 D NOTIFY($$NOW^XLFDT()) ;send review notification
9 D RUNQRY^DGPFHLRT ;run query for incomplete HL7 event status
10 Q
11 ;
12NOTIFY(DGDATE) ;Send notification message for pending Patient Record Flag
13 ;Assignment reviews.
14 ;
15 ; Input:
16 ; DGDATE - (optional) notification date requested in FM format,
17 ; defaults to now ($$NOW^XLFDT())
18 ;
19 ; Output:
20 ; none
21 ;
22 N DGAIEN ;pointer to PRF ASSIGNMENT (#26.13) file
23 N DGDFN ;pointer to patient in PATIENT (#2) file
24 N DGDEM ;patient demographics array
25 N DGDOB ;patient date of birth
26 N DGFLG ;flag data array
27 N DGLIST ;closed root array list of patient IENs in a mail group
28 N DGMSGTXT ;closed root of mail message text
29 N DGNAME ;patient name
30 N DGNDT ;notification date
31 N DGPFA ;assignment data array
32 N DGMGROUP ;review mail group
33 N DGSSN ;patient social security number
34 ;
35 S DGLIST=$NA(^TMP("DGPFREV",$J))
36 K @DGLIST
37 ;
38 S DGMSGTXT=$NA(^TMP("DGPFMSG",$J))
39 K @DGMSGTXT
40 ;
41 I '+$G(DGDATE) S DGDATE=$$NOW^XLFDT()
42 ;
43 S DGNDT=0
44 F S DGNDT=$O(^DGPF(26.13,"ANDAT",DGNDT)) Q:('DGNDT!(DGNDT>DGDATE)) D
45 . S DGAIEN=0
46 . F S DGAIEN=$O(^DGPF(26.13,"ANDAT",DGNDT,DGAIEN)) Q:'DGAIEN D
47 . . N DGPFA,DGDEM,DGFLG
48 . . ;
49 . . ;get assignment record
50 . . Q:'$$GETASGN^DGPFAA(DGAIEN,.DGPFA)
51 . . ;
52 . . ;retrieve pointer to patient record in PATIENT (#2) file
53 . . S DGDFN=$P($G(DGPFA("DFN")),U,1)
54 . . Q:'DGDFN
55 . . ;
56 . . ;retrieve patient demographics
57 . . Q:'$$GETPAT^DGPFUT2(DGDFN,.DGDEM)
58 . . S DGNAME=$G(DGDEM("NAME"))
59 . . S DGSSN=$G(DGDEM("SSN"))
60 . . S DGDOB=$G(DGDEM("DOB"))
61 . . ;
62 . . ;retrieve review date
63 . . S DGREVDT=$P($G(DGPFA("REVIEWDT")),U,1)
64 . . Q:'DGREVDT
65 . . ;
66 . . ;get flag review criteria, notice days and review mail group
67 . . Q:'$$GETFLAG^DGPFUT1($P($G(DGPFA("FLAG")),U,1),.DGFLG)
68 . . ;
69 . . ;retrieve review mail group
70 . . S DGMGROUP=$P($G(DGFLG("REVGRP")),U,2)
71 . . Q:(DGMGROUP']"")
72 . . ;
73 . . ;build list
74 . . S @DGLIST@(DGMGROUP,DGAIEN)=DGNAME_U_DGSSN_U_DGDOB_U_$P(DGPFA("FLAG"),U,2)_U_DGREVDT
75 . . ;
76 . . ;remove notification index entry
77 . . K ^DGPF(26.13,"ANDAT",DGNDT,DGAIEN)
78 ;
79 ;build and send the message for each mail group
80 S DGMGROUP=""
81 F S DGMGROUP=$O(@DGLIST@(DGMGROUP)) Q:(DGMGROUP="") D
82 . I $$BLDMSG(DGMGROUP,DGLIST,DGMSGTXT) D SEND(DGMGROUP,DGMSGTXT)
83 . K @DGMSGTXT
84 ;
85 ;cleanup
86 K @DGLIST
87 ;
88 Q
89 ;
90BLDMSG(DGMGROUP,DGLIST,DGXMTXT) ;build MailMan message array
91 ;
92 ; Input:
93 ; DGMGROUP - mail group name
94 ; DGLIST - closed root array of assignment IENs by mail group
95 ;
96 ; Output:
97 ; DGXMTXT - array of MailMan text lines
98 ;
99 N DGDOB ;formatted date of birth
100 N DGFLAG ;formatted flag name
101 N DGLIN ;line counter
102 N DGNAME ;formatted patient name
103 N DGMAX ;maximum line length
104 N DGREC ;contents of a single node of the DGLIST array
105 N DGREVDT ;review date
106 N DGSITE ;results of VASITE call
107 N DGSSN ;formatted social security number
108 ;
109 S DGLIN=0
110 S DGMAX=78
111 S DGSITE=$$SITE^VASITE()
112 D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)
113 D ADDLINE($$CJ^XLFSTR("* * * * PRF ASSIGNMENT REVIEW NOTIFICATION * * * *",78," "),0,DGMAX,.DGLIN,DGXMTXT)
114 D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)
115 D ADDLINE("The following Patient Record Flag Assignments are due for review for continuing appropriateness:",0,DGMAX,.DGLIN,DGXMTXT)
116 D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)
117 D ADDLINE($$LJ^XLFSTR("Patient Name",22," ")_$$LJ^XLFSTR("SSN",11," ")_$$LJ^XLFSTR("DOB",10," ")_$$LJ^XLFSTR("Flag Name",22," ")_"Review Date",0,DGMAX,.DGLIN,DGXMTXT)
118 D ADDLINE($$REPEAT^XLFSTR("-",DGMAX),0,DGMAX,.DGLIN,DGXMTXT)
119 ;
120 S DGAIEN=0,DGCNT=0
121 F S DGAIEN=$O(@DGLIST@(DGMGROUP,DGAIEN)) Q:'DGAIEN D
122 . ;record description: patient_name^SSN^DOB^flag_name^review_date
123 . S DGREC=@DGLIST@(DGMGROUP,DGAIEN)
124 . ;
125 . ;format the fields
126 . S DGNAME=$$LJ^XLFSTR($E($P(DGREC,U,1),1,20),22," ")
127 . S DGSSN=$$LJ^XLFSTR($P(DGREC,U,2),11," ")
128 . S DGDOB=$$LJ^XLFSTR($$FMTE^XLFDT($P(DGREC,U,3),"5D"),10," ")
129 . S DGFLAG=$$LJ^XLFSTR($E($P(DGREC,U,4),1,20),22," ")
130 . S DGREVDT=$$FMTE^XLFDT($P(DGREC,U,5),"5D")
131 . ;
132 . ;add the line
133 . D ADDLINE(DGNAME_DGSSN_DGDOB_DGFLAG_DGREVDT,0,DGMAX,.DGLIN,DGXMTXT)
134 . D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)
135 . ;
136 . ;success
137 . S DGCNT=DGCNT+1
138 ;
139 Q DGCNT
140 ;
141ADDLINE(DGTEXT,DGINDENT,DGMAXLEN,DGCNT,DGXMTXT) ;add text line to message array
142 ;
143 ; Input:
144 ; DGTEXT - text string
145 ; DGINDENT - number of spaces to insert at start of line
146 ; DGMAXLEN - maximum desired line length (default: 60)
147 ; DGCNT - line number passed by reference
148 ;
149 ; Output:
150 ; DGXMTXT - array of text strings
151 ;
152 N DGAVAIL ;available space for text
153 N DGLINE ;truncated text
154 N DGLOC ;location of space character
155 N DGPAD ;space indent
156 ;
157 S DGTEXT=$G(DGTEXT)
158 S DGINDENT=+$G(DGINDENT)
159 S DGMAXLEN=+$G(DGMAXLEN)
160 S:'DGMAXLEN DGMAXLEN=60
161 I DGINDENT>(DGMAXLEN-1) S DGINDENT=0
162 S DGCNT=$G(DGCNT,0) ;default to 0
163 ;
164 S DGPAD=$$REPEAT^XLFSTR(" ",DGINDENT)
165 ;
166 ;determine availaible space for text
167 S DGAVAIL=(DGMAXLEN-DGINDENT)
168 F D Q:('$L(DGTEXT))
169 . ;
170 . ;find potential line break
171 . S DGLOC=$L($E(DGTEXT,1,DGAVAIL)," ")
172 . ;
173 . ;break a line that is too long when it has potential line breaks
174 . I $L(DGTEXT)>DGAVAIL,DGLOC D
175 . . S DGLINE=$P(DGTEXT," ",1,$S(DGLOC>1:DGLOC-1,1:1))
176 . . S DGTEXT=$P(DGTEXT," ",$S(DGLOC>1:DGLOC,1:DGLOC+1),$L(DGTEXT," "))
177 . E D
178 . . S DGLINE=DGTEXT,DGTEXT=""
179 . ;
180 . S DGCNT=DGCNT+1
181 . S @DGXMTXT@(DGCNT)=DGPAD_DGLINE
182 Q
183 ;
184SEND(DGGROUP,DGXMTXT) ;send the MailMan message
185 ;
186 ; Input:
187 ; DGGROUP - mail group name
188 ; DGXMTXT - name of message text array in closed format
189 ;
190 ; Output:
191 ; none
192 ;
193 N DIFROM ;protect FM package
194 N XMDUZ ;sender
195 N XMSUB ;message subject
196 N XMTEXT ;name of message text array in open format
197 N XMY ;recipient array
198 N XMZ ;returned message number
199 ;
200 S XMDUZ="Patient Record Flag Module"
201 S XMSUB="PRF ASSIGNMENT REVIEW NOTIFICATION"
202 S XMTEXT=$$OREF^DILF(DGXMTXT)
203 S XMY("G."_DGGROUP)=""
204 D ^XMD
205 Q
Note: See TracBrowser for help on using the repository browser.