Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGPFBGR

DGPFBGR.m

Go to the documentation of this file.
  1. DGPFBGR ;ALB/RPM - PRF BACKGROUND PROCESSING DRIVER ; 6/3/05 12:25pm
  1. ;;5.3;Registration;**425,650**;Aug 13, 1993;Build 3
  1. ;
  1. Q ;no direct entry
  1. ;
  1. EN ;entry point for PRF background processing
  1. ;
  1. D NOTIFY($$NOW^XLFDT()) ;send review notification
  1. D RUNQRY^DGPFHLRT ;run query for incomplete HL7 event status
  1. Q
  1. ;
  1. NOTIFY(DGDATE) ;Send notification message for pending Patient Record Flag
  1. ;Assignment reviews.
  1. ;
  1. ; Input:
  1. ; DGDATE - (optional) notification date requested in FM format,
  1. ; defaults to now ($$NOW^XLFDT())
  1. ;
  1. ; Output:
  1. ; none
  1. ;
  1. N DGAIEN ;pointer to PRF ASSIGNMENT (#26.13) file
  1. N DGDFN ;pointer to patient in PATIENT (#2) file
  1. N DGDEM ;patient demographics array
  1. N DGDOB ;patient date of birth
  1. N DGFLG ;flag data array
  1. N DGLIST ;closed root array list of patient IENs in a mail group
  1. N DGMSGTXT ;closed root of mail message text
  1. N DGNAME ;patient name
  1. N DGNDT ;notification date
  1. N DGPFA ;assignment data array
  1. N DGMGROUP ;review mail group
  1. N DGSSN ;patient social security number
  1. ;
  1. S DGLIST=$NA(^TMP("DGPFREV",$J))
  1. K @DGLIST
  1. ;
  1. S DGMSGTXT=$NA(^TMP("DGPFMSG",$J))
  1. K @DGMSGTXT
  1. ;
  1. I '+$G(DGDATE) S DGDATE=$$NOW^XLFDT()
  1. ;
  1. S DGNDT=0
  1. F S DGNDT=$O(^DGPF(26.13,"ANDAT",DGNDT)) Q:('DGNDT!(DGNDT>DGDATE)) D
  1. . S DGAIEN=0
  1. . F S DGAIEN=$O(^DGPF(26.13,"ANDAT",DGNDT,DGAIEN)) Q:'DGAIEN D
  1. . . N DGPFA,DGDEM,DGFLG
  1. . . ;
  1. . . ;get assignment record
  1. . . Q:'$$GETASGN^DGPFAA(DGAIEN,.DGPFA)
  1. . . ;
  1. . . ;retrieve pointer to patient record in PATIENT (#2) file
  1. . . S DGDFN=$P($G(DGPFA("DFN")),U,1)
  1. . . Q:'DGDFN
  1. . . ;
  1. . . ;retrieve patient demographics
  1. . . Q:'$$GETPAT^DGPFUT2(DGDFN,.DGDEM)
  1. . . S DGNAME=$G(DGDEM("NAME"))
  1. . . S DGSSN=$G(DGDEM("SSN"))
  1. . . S DGDOB=$G(DGDEM("DOB"))
  1. . . ;
  1. . . ;retrieve review date
  1. . . S DGREVDT=$P($G(DGPFA("REVIEWDT")),U,1)
  1. . . Q:'DGREVDT
  1. . . ;
  1. . . ;get flag review criteria, notice days and review mail group
  1. . . Q:'$$GETFLAG^DGPFUT1($P($G(DGPFA("FLAG")),U,1),.DGFLG)
  1. . . ;
  1. . . ;retrieve review mail group
  1. . . S DGMGROUP=$P($G(DGFLG("REVGRP")),U,2)
  1. . . Q:(DGMGROUP']"")
  1. . . ;
  1. . . ;build list
  1. . . S @DGLIST@(DGMGROUP,DGAIEN)=DGNAME_U_DGSSN_U_DGDOB_U_$P(DGPFA("FLAG"),U,2)_U_DGREVDT
  1. . . ;
  1. . . ;remove notification index entry
  1. . . K ^DGPF(26.13,"ANDAT",DGNDT,DGAIEN)
  1. ;
  1. ;build and send the message for each mail group
  1. S DGMGROUP=""
  1. F S DGMGROUP=$O(@DGLIST@(DGMGROUP)) Q:(DGMGROUP="") D
  1. . I $$BLDMSG(DGMGROUP,DGLIST,DGMSGTXT) D SEND(DGMGROUP,DGMSGTXT)
  1. . K @DGMSGTXT
  1. ;
  1. ;cleanup
  1. K @DGLIST
  1. ;
  1. Q
  1. ;
  1. BLDMSG(DGMGROUP,DGLIST,DGXMTXT) ;build MailMan message array
  1. ;
  1. ; Input:
  1. ; DGMGROUP - mail group name
  1. ; DGLIST - closed root array of assignment IENs by mail group
  1. ;
  1. ; Output:
  1. ; DGXMTXT - array of MailMan text lines
  1. ;
  1. N DGDOB ;formatted date of birth
  1. N DGFLAG ;formatted flag name
  1. N DGLIN ;line counter
  1. N DGNAME ;formatted patient name
  1. N DGMAX ;maximum line length
  1. N DGREC ;contents of a single node of the DGLIST array
  1. N DGREVDT ;review date
  1. N DGSITE ;results of VASITE call
  1. N DGSSN ;formatted social security number
  1. ;
  1. S DGLIN=0
  1. S DGMAX=78
  1. S DGSITE=$$SITE^VASITE()
  1. D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)
  1. D ADDLINE($$CJ^XLFSTR("* * * * PRF ASSIGNMENT REVIEW NOTIFICATION * * * *",78," "),0,DGMAX,.DGLIN,DGXMTXT)
  1. D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)
  1. D ADDLINE("The following Patient Record Flag Assignments are due for review for continuing appropriateness:",0,DGMAX,.DGLIN,DGXMTXT)
  1. D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)
  1. 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)
  1. D ADDLINE($$REPEAT^XLFSTR("-",DGMAX),0,DGMAX,.DGLIN,DGXMTXT)
  1. ;
  1. S DGAIEN=0,DGCNT=0
  1. F S DGAIEN=$O(@DGLIST@(DGMGROUP,DGAIEN)) Q:'DGAIEN D
  1. . ;record description: patient_name^SSN^DOB^flag_name^review_date
  1. . S DGREC=@DGLIST@(DGMGROUP,DGAIEN)
  1. . ;
  1. . ;format the fields
  1. . S DGNAME=$$LJ^XLFSTR($E($P(DGREC,U,1),1,20),22," ")
  1. . S DGSSN=$$LJ^XLFSTR($P(DGREC,U,2),11," ")
  1. . S DGDOB=$$LJ^XLFSTR($$FMTE^XLFDT($P(DGREC,U,3),"5D"),10," ")
  1. . S DGFLAG=$$LJ^XLFSTR($E($P(DGREC,U,4),1,20),22," ")
  1. . S DGREVDT=$$FMTE^XLFDT($P(DGREC,U,5),"5D")
  1. . ;
  1. . ;add the line
  1. . D ADDLINE(DGNAME_DGSSN_DGDOB_DGFLAG_DGREVDT,0,DGMAX,.DGLIN,DGXMTXT)
  1. . D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)
  1. . ;
  1. . ;success
  1. . S DGCNT=DGCNT+1
  1. ;
  1. Q DGCNT
  1. ;
  1. ADDLINE(DGTEXT,DGINDENT,DGMAXLEN,DGCNT,DGXMTXT) ;add text line to message array
  1. ;
  1. ; Input:
  1. ; DGTEXT - text string
  1. ; DGINDENT - number of spaces to insert at start of line
  1. ; DGMAXLEN - maximum desired line length (default: 60)
  1. ; DGCNT - line number passed by reference
  1. ;
  1. ; Output:
  1. ; DGXMTXT - array of text strings
  1. ;
  1. N DGAVAIL ;available space for text
  1. N DGLINE ;truncated text
  1. N DGLOC ;location of space character
  1. N DGPAD ;space indent
  1. ;
  1. S DGTEXT=$G(DGTEXT)
  1. S DGINDENT=+$G(DGINDENT)
  1. S DGMAXLEN=+$G(DGMAXLEN)
  1. S:'DGMAXLEN DGMAXLEN=60
  1. I DGINDENT>(DGMAXLEN-1) S DGINDENT=0
  1. S DGCNT=$G(DGCNT,0) ;default to 0
  1. ;
  1. S DGPAD=$$REPEAT^XLFSTR(" ",DGINDENT)
  1. ;
  1. ;determine availaible space for text
  1. S DGAVAIL=(DGMAXLEN-DGINDENT)
  1. F D Q:('$L(DGTEXT))
  1. . ;
  1. . ;find potential line break
  1. . S DGLOC=$L($E(DGTEXT,1,DGAVAIL)," ")
  1. . ;
  1. . ;break a line that is too long when it has potential line breaks
  1. . I $L(DGTEXT)>DGAVAIL,DGLOC D
  1. . . S DGLINE=$P(DGTEXT," ",1,$S(DGLOC>1:DGLOC-1,1:1))
  1. . . S DGTEXT=$P(DGTEXT," ",$S(DGLOC>1:DGLOC,1:DGLOC+1),$L(DGTEXT," "))
  1. . E D
  1. . . S DGLINE=DGTEXT,DGTEXT=""
  1. . ;
  1. . S DGCNT=DGCNT+1
  1. . S @DGXMTXT@(DGCNT)=DGPAD_DGLINE
  1. Q
  1. ;
  1. SEND(DGGROUP,DGXMTXT) ;send the MailMan message
  1. ;
  1. ; Input:
  1. ; DGGROUP - mail group name
  1. ; DGXMTXT - name of message text array in closed format
  1. ;
  1. ; Output:
  1. ; none
  1. ;
  1. N DIFROM ;protect FM package
  1. N XMDUZ ;sender
  1. N XMSUB ;message subject
  1. N XMTEXT ;name of message text array in open format
  1. N XMY ;recipient array
  1. N XMZ ;returned message number
  1. ;
  1. S XMDUZ="Patient Record Flag Module"
  1. S XMSUB="PRF ASSIGNMENT REVIEW NOTIFICATION"
  1. S XMTEXT=$$OREF^DILF(DGXMTXT)
  1. S XMY("G."_DGGROUP)=""
  1. D ^XMD
  1. Q