- 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 Feb 19, 2025@00:13:32 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