DGPFBGR ;ALB/RPM - PRF BACKGROUND PROCESSING DRIVER ; 6/3/05 12:25pm
;;5.3;Registration;**425,650**;Aug 13, 1993;Build 3
;
Q ;no direct entry
;
EN ;entry point for PRF background processing
;
D NOTIFY($$NOW^XLFDT()) ;send review notification
D RUNQRY^DGPFHLRT ;run query for incomplete HL7 event status
Q
;
NOTIFY(DGDATE) ;Send notification message for pending Patient Record Flag
;Assignment reviews.
;
; Input:
; DGDATE - (optional) notification date requested in FM format,
; defaults to now ($$NOW^XLFDT())
;
; Output:
; none
;
N DGAIEN ;pointer to PRF ASSIGNMENT (#26.13) file
N DGDFN ;pointer to patient in PATIENT (#2) file
N DGDEM ;patient demographics array
N DGDOB ;patient date of birth
N DGFLG ;flag data array
N DGLIST ;closed root array list of patient IENs in a mail group
N DGMSGTXT ;closed root of mail message text
N DGNAME ;patient name
N DGNDT ;notification date
N DGPFA ;assignment data array
N DGMGROUP ;review mail group
N DGSSN ;patient social security number
;
S DGLIST=$NA(^TMP("DGPFREV",$J))
K @DGLIST
;
S DGMSGTXT=$NA(^TMP("DGPFMSG",$J))
K @DGMSGTXT
;
I '+$G(DGDATE) S DGDATE=$$NOW^XLFDT()
;
S DGNDT=0
F S DGNDT=$O(^DGPF(26.13,"ANDAT",DGNDT)) Q:('DGNDT!(DGNDT>DGDATE)) D
. S DGAIEN=0
. F S DGAIEN=$O(^DGPF(26.13,"ANDAT",DGNDT,DGAIEN)) Q:'DGAIEN D
. . N DGPFA,DGDEM,DGFLG
. . ;
. . ;get assignment record
. . Q:'$$GETASGN^DGPFAA(DGAIEN,.DGPFA)
. . ;
. . ;retrieve pointer to patient record in PATIENT (#2) file
. . S DGDFN=$P($G(DGPFA("DFN")),U,1)
. . Q:'DGDFN
. . ;
. . ;retrieve patient demographics
. . Q:'$$GETPAT^DGPFUT2(DGDFN,.DGDEM)
. . S DGNAME=$G(DGDEM("NAME"))
. . S DGSSN=$G(DGDEM("SSN"))
. . S DGDOB=$G(DGDEM("DOB"))
. . ;
. . ;retrieve review date
. . S DGREVDT=$P($G(DGPFA("REVIEWDT")),U,1)
. . Q:'DGREVDT
. . ;
. . ;get flag review criteria, notice days and review mail group
. . Q:'$$GETFLAG^DGPFUT1($P($G(DGPFA("FLAG")),U,1),.DGFLG)
. . ;
. . ;retrieve review mail group
. . S DGMGROUP=$P($G(DGFLG("REVGRP")),U,2)
. . Q:(DGMGROUP']"")
. . ;
. . ;build list
. . S @DGLIST@(DGMGROUP,DGAIEN)=DGNAME_U_DGSSN_U_DGDOB_U_$P(DGPFA("FLAG"),U,2)_U_DGREVDT
. . ;
. . ;remove notification index entry
. . K ^DGPF(26.13,"ANDAT",DGNDT,DGAIEN)
;
;build and send the message for each mail group
S DGMGROUP=""
F S DGMGROUP=$O(@DGLIST@(DGMGROUP)) Q:(DGMGROUP="") D
. I $$BLDMSG(DGMGROUP,DGLIST,DGMSGTXT) D SEND(DGMGROUP,DGMSGTXT)
. K @DGMSGTXT
;
;cleanup
K @DGLIST
;
Q
;
BLDMSG(DGMGROUP,DGLIST,DGXMTXT) ;build MailMan message array
;
; Input:
; DGMGROUP - mail group name
; DGLIST - closed root array of assignment IENs by mail group
;
; Output:
; DGXMTXT - array of MailMan text lines
;
N DGDOB ;formatted date of birth
N DGFLAG ;formatted flag name
N DGLIN ;line counter
N DGNAME ;formatted patient name
N DGMAX ;maximum line length
N DGREC ;contents of a single node of the DGLIST array
N DGREVDT ;review date
N DGSITE ;results of VASITE call
N DGSSN ;formatted social security number
;
S DGLIN=0
S DGMAX=78
S DGSITE=$$SITE^VASITE()
D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)
D ADDLINE($$CJ^XLFSTR("* * * * PRF ASSIGNMENT REVIEW NOTIFICATION * * * *",78," "),0,DGMAX,.DGLIN,DGXMTXT)
D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)
D ADDLINE("The following Patient Record Flag Assignments are due for review for continuing appropriateness:",0,DGMAX,.DGLIN,DGXMTXT)
D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)
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)
D ADDLINE($$REPEAT^XLFSTR("-",DGMAX),0,DGMAX,.DGLIN,DGXMTXT)
;
S DGAIEN=0,DGCNT=0
F S DGAIEN=$O(@DGLIST@(DGMGROUP,DGAIEN)) Q:'DGAIEN D
. ;record description: patient_name^SSN^DOB^flag_name^review_date
. S DGREC=@DGLIST@(DGMGROUP,DGAIEN)
. ;
. ;format the fields
. S DGNAME=$$LJ^XLFSTR($E($P(DGREC,U,1),1,20),22," ")
. S DGSSN=$$LJ^XLFSTR($P(DGREC,U,2),11," ")
. S DGDOB=$$LJ^XLFSTR($$FMTE^XLFDT($P(DGREC,U,3),"5D"),10," ")
. S DGFLAG=$$LJ^XLFSTR($E($P(DGREC,U,4),1,20),22," ")
. S DGREVDT=$$FMTE^XLFDT($P(DGREC,U,5),"5D")
. ;
. ;add the line
. D ADDLINE(DGNAME_DGSSN_DGDOB_DGFLAG_DGREVDT,0,DGMAX,.DGLIN,DGXMTXT)
. D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)
. ;
. ;success
. S DGCNT=DGCNT+1
;
Q DGCNT
;
ADDLINE(DGTEXT,DGINDENT,DGMAXLEN,DGCNT,DGXMTXT) ;add text line to message array
;
; Input:
; DGTEXT - text string
; DGINDENT - number of spaces to insert at start of line
; DGMAXLEN - maximum desired line length (default: 60)
; DGCNT - line number passed by reference
;
; Output:
; DGXMTXT - array of text strings
;
N DGAVAIL ;available space for text
N DGLINE ;truncated text
N DGLOC ;location of space character
N DGPAD ;space indent
;
S DGTEXT=$G(DGTEXT)
S DGINDENT=+$G(DGINDENT)
S DGMAXLEN=+$G(DGMAXLEN)
S:'DGMAXLEN DGMAXLEN=60
I DGINDENT>(DGMAXLEN-1) S DGINDENT=0
S DGCNT=$G(DGCNT,0) ;default to 0
;
S DGPAD=$$REPEAT^XLFSTR(" ",DGINDENT)
;
;determine availaible space for text
S DGAVAIL=(DGMAXLEN-DGINDENT)
F D Q:('$L(DGTEXT))
. ;
. ;find potential line break
. S DGLOC=$L($E(DGTEXT,1,DGAVAIL)," ")
. ;
. ;break a line that is too long when it has potential line breaks
. I $L(DGTEXT)>DGAVAIL,DGLOC D
. . S DGLINE=$P(DGTEXT," ",1,$S(DGLOC>1:DGLOC-1,1:1))
. . S DGTEXT=$P(DGTEXT," ",$S(DGLOC>1:DGLOC,1:DGLOC+1),$L(DGTEXT," "))
. E D
. . S DGLINE=DGTEXT,DGTEXT=""
. ;
. S DGCNT=DGCNT+1
. S @DGXMTXT@(DGCNT)=DGPAD_DGLINE
Q
;
SEND(DGGROUP,DGXMTXT) ;send the MailMan message
;
; Input:
; DGGROUP - mail group name
; DGXMTXT - name of message text array in closed format
;
; Output:
; none
;
N DIFROM ;protect FM package
N XMDUZ ;sender
N XMSUB ;message subject
N XMTEXT ;name of message text array in open format
N XMY ;recipient array
N XMZ ;returned message number
;
S XMDUZ="Patient Record Flag Module"
S XMSUB="PRF ASSIGNMENT REVIEW NOTIFICATION"
S XMTEXT=$$OREF^DILF(DGXMTXT)
S XMY("G."_DGGROUP)=""
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFBGR 6361 printed Sep 23, 2025@20:23:22 Page 2
DGPFBGR ;ALB/RPM - PRF BACKGROUND PROCESSING DRIVER ; 6/3/05 12:25pm
+1 ;;5.3;Registration;**425,650**;Aug 13, 1993;Build 3
+2 ;
+3 ;no direct entry
QUIT
+4 ;
EN ;entry point for PRF background processing
+1 ;
+2 ;send review notification
DO NOTIFY($$NOW^XLFDT())
+3 ;run query for incomplete HL7 event status
DO RUNQRY^DGPFHLRT
+4 QUIT
+5 ;
NOTIFY(DGDATE) ;Send notification message for pending Patient Record Flag
+1 ;Assignment reviews.
+2 ;
+3 ; Input:
+4 ; DGDATE - (optional) notification date requested in FM format,
+5 ; defaults to now ($$NOW^XLFDT())
+6 ;
+7 ; Output:
+8 ; none
+9 ;
+10 ;pointer to PRF ASSIGNMENT (#26.13) file
NEW DGAIEN
+11 ;pointer to patient in PATIENT (#2) file
NEW DGDFN
+12 ;patient demographics array
NEW DGDEM
+13 ;patient date of birth
NEW DGDOB
+14 ;flag data array
NEW DGFLG
+15 ;closed root array list of patient IENs in a mail group
NEW DGLIST
+16 ;closed root of mail message text
NEW DGMSGTXT
+17 ;patient name
NEW DGNAME
+18 ;notification date
NEW DGNDT
+19 ;assignment data array
NEW DGPFA
+20 ;review mail group
NEW DGMGROUP
+21 ;patient social security number
NEW DGSSN
+22 ;
+23 SET DGLIST=$NAME(^TMP("DGPFREV",$JOB))
+24 KILL @DGLIST
+25 ;
+26 SET DGMSGTXT=$NAME(^TMP("DGPFMSG",$JOB))
+27 KILL @DGMSGTXT
+28 ;
+29 IF '+$GET(DGDATE)
SET DGDATE=$$NOW^XLFDT()
+30 ;
+31 SET DGNDT=0
+32 FOR
SET DGNDT=$ORDER(^DGPF(26.13,"ANDAT",DGNDT))
if ('DGNDT!(DGNDT>DGDATE))
QUIT
Begin DoDot:1
+33 SET DGAIEN=0
+34 FOR
SET DGAIEN=$ORDER(^DGPF(26.13,"ANDAT",DGNDT,DGAIEN))
if 'DGAIEN
QUIT
Begin DoDot:2
+35 NEW DGPFA,DGDEM,DGFLG
+36 ;
+37 ;get assignment record
+38 if '$$GETASGN^DGPFAA(DGAIEN,.DGPFA)
QUIT
+39 ;
+40 ;retrieve pointer to patient record in PATIENT (#2) file
+41 SET DGDFN=$PIECE($GET(DGPFA("DFN")),U,1)
+42 if 'DGDFN
QUIT
+43 ;
+44 ;retrieve patient demographics
+45 if '$$GETPAT^DGPFUT2(DGDFN,.DGDEM)
QUIT
+46 SET DGNAME=$GET(DGDEM("NAME"))
+47 SET DGSSN=$GET(DGDEM("SSN"))
+48 SET DGDOB=$GET(DGDEM("DOB"))
+49 ;
+50 ;retrieve review date
+51 SET DGREVDT=$PIECE($GET(DGPFA("REVIEWDT")),U,1)
+52 if 'DGREVDT
QUIT
+53 ;
+54 ;get flag review criteria, notice days and review mail group
+55 if '$$GETFLAG^DGPFUT1($PIECE($GET(DGPFA("FLAG")),U,1),.DGFLG)
QUIT
+56 ;
+57 ;retrieve review mail group
+58 SET DGMGROUP=$PIECE($GET(DGFLG("REVGRP")),U,2)
+59 if (DGMGROUP']"")
QUIT
+60 ;
+61 ;build list
+62 SET @DGLIST@(DGMGROUP,DGAIEN)=DGNAME_U_DGSSN_U_DGDOB_U_$PIECE(DGPFA("FLAG"),U,2)_U_DGREVDT
+63 ;
+64 ;remove notification index entry
+65 KILL ^DGPF(26.13,"ANDAT",DGNDT,DGAIEN)
End DoDot:2
End DoDot:1
+66 ;
+67 ;build and send the message for each mail group
+68 SET DGMGROUP=""
+69 FOR
SET DGMGROUP=$ORDER(@DGLIST@(DGMGROUP))
if (DGMGROUP="")
QUIT
Begin DoDot:1
+70 IF $$BLDMSG(DGMGROUP,DGLIST,DGMSGTXT)
DO SEND(DGMGROUP,DGMSGTXT)
+71 KILL @DGMSGTXT
End DoDot:1
+72 ;
+73 ;cleanup
+74 KILL @DGLIST
+75 ;
+76 QUIT
+77 ;
BLDMSG(DGMGROUP,DGLIST,DGXMTXT) ;build MailMan message array
+1 ;
+2 ; Input:
+3 ; DGMGROUP - mail group name
+4 ; DGLIST - closed root array of assignment IENs by mail group
+5 ;
+6 ; Output:
+7 ; DGXMTXT - array of MailMan text lines
+8 ;
+9 ;formatted date of birth
NEW DGDOB
+10 ;formatted flag name
NEW DGFLAG
+11 ;line counter
NEW DGLIN
+12 ;formatted patient name
NEW DGNAME
+13 ;maximum line length
NEW DGMAX
+14 ;contents of a single node of the DGLIST array
NEW DGREC
+15 ;review date
NEW DGREVDT
+16 ;results of VASITE call
NEW DGSITE
+17 ;formatted social security number
NEW DGSSN
+18 ;
+19 SET DGLIN=0
+20 SET DGMAX=78
+21 SET DGSITE=$$SITE^VASITE()
+22 DO ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)
+23 DO ADDLINE($$CJ^XLFSTR("* * * * PRF ASSIGNMENT REVIEW NOTIFICATION * * * *",78," "),0,DGMAX,.DGLIN,DGXMTXT)
+24 DO ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)
+25 DO ADDLINE("The following Patient Record Flag Assignments are due for review for continuing appropriateness:",0,DGMAX,.DGLIN,DGXMTXT)
+26 DO ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)
+27 DO 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)
+28 DO ADDLINE($$REPEAT^XLFSTR("-",DGMAX),0,DGMAX,.DGLIN,DGXMTXT)
+29 ;
+30 SET DGAIEN=0
SET DGCNT=0
+31 FOR
SET DGAIEN=$ORDER(@DGLIST@(DGMGROUP,DGAIEN))
if 'DGAIEN
QUIT
Begin DoDot:1
+32 ;record description: patient_name^SSN^DOB^flag_name^review_date
+33 SET DGREC=@DGLIST@(DGMGROUP,DGAIEN)
+34 ;
+35 ;format the fields
+36 SET DGNAME=$$LJ^XLFSTR($EXTRACT($PIECE(DGREC,U,1),1,20),22," ")
+37 SET DGSSN=$$LJ^XLFSTR($PIECE(DGREC,U,2),11," ")
+38 SET DGDOB=$$LJ^XLFSTR($$FMTE^XLFDT($PIECE(DGREC,U,3),"5D"),10," ")
+39 SET DGFLAG=$$LJ^XLFSTR($EXTRACT($PIECE(DGREC,U,4),1,20),22," ")
+40 SET DGREVDT=$$FMTE^XLFDT($PIECE(DGREC,U,5),"5D")
+41 ;
+42 ;add the line
+43 DO ADDLINE(DGNAME_DGSSN_DGDOB_DGFLAG_DGREVDT,0,DGMAX,.DGLIN,DGXMTXT)
+44 DO ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)
+45 ;
+46 ;success
+47 SET DGCNT=DGCNT+1
End DoDot:1
+48 ;
+49 QUIT DGCNT
+50 ;
ADDLINE(DGTEXT,DGINDENT,DGMAXLEN,DGCNT,DGXMTXT) ;add text line to message array
+1 ;
+2 ; Input:
+3 ; DGTEXT - text string
+4 ; DGINDENT - number of spaces to insert at start of line
+5 ; DGMAXLEN - maximum desired line length (default: 60)
+6 ; DGCNT - line number passed by reference
+7 ;
+8 ; Output:
+9 ; DGXMTXT - array of text strings
+10 ;
+11 ;available space for text
NEW DGAVAIL
+12 ;truncated text
NEW DGLINE
+13 ;location of space character
NEW DGLOC
+14 ;space indent
NEW DGPAD
+15 ;
+16 SET DGTEXT=$GET(DGTEXT)
+17 SET DGINDENT=+$GET(DGINDENT)
+18 SET DGMAXLEN=+$GET(DGMAXLEN)
+19 if 'DGMAXLEN
SET DGMAXLEN=60
+20 IF DGINDENT>(DGMAXLEN-1)
SET DGINDENT=0
+21 ;default to 0
SET DGCNT=$GET(DGCNT,0)
+22 ;
+23 SET DGPAD=$$REPEAT^XLFSTR(" ",DGINDENT)
+24 ;
+25 ;determine availaible space for text
+26 SET DGAVAIL=(DGMAXLEN-DGINDENT)
+27 FOR
Begin DoDot:1
+28 ;
+29 ;find potential line break
+30 SET DGLOC=$LENGTH($EXTRACT(DGTEXT,1,DGAVAIL)," ")
+31 ;
+32 ;break a line that is too long when it has potential line breaks
+33 IF $LENGTH(DGTEXT)>DGAVAIL
IF DGLOC
Begin DoDot:2
+34 SET DGLINE=$PIECE(DGTEXT," ",1,$SELECT(DGLOC>1:DGLOC-1,1:1))
+35 SET DGTEXT=$PIECE(DGTEXT," ",$SELECT(DGLOC>1:DGLOC,1:DGLOC+1),$LENGTH(DGTEXT," "))
End DoDot:2
+36 IF '$TEST
Begin DoDot:2
+37 SET DGLINE=DGTEXT
SET DGTEXT=""
End DoDot:2
+38 ;
+39 SET DGCNT=DGCNT+1
+40 SET @DGXMTXT@(DGCNT)=DGPAD_DGLINE
End DoDot:1
if ('$LENGTH(DGTEXT))
QUIT
+41 QUIT
+42 ;
SEND(DGGROUP,DGXMTXT) ;send the MailMan message
+1 ;
+2 ; Input:
+3 ; DGGROUP - mail group name
+4 ; DGXMTXT - name of message text array in closed format
+5 ;
+6 ; Output:
+7 ; none
+8 ;
+9 ;protect FM package
NEW DIFROM
+10 ;sender
NEW XMDUZ
+11 ;message subject
NEW XMSUB
+12 ;name of message text array in open format
NEW XMTEXT
+13 ;recipient array
NEW XMY
+14 ;returned message number
NEW XMZ
+15 ;
+16 SET XMDUZ="Patient Record Flag Module"
+17 SET XMSUB="PRF ASSIGNMENT REVIEW NOTIFICATION"
+18 SET XMTEXT=$$OREF^DILF(DGXMTXT)
+19 SET XMY("G."_DGGROUP)=""
+20 DO ^XMD
+21 QUIT
