DGROMAIL ;DJH/AMA - ROM HL7 MAIL MESSAGE PROCESSING ; 28 Apr 2004 4:16 PM
;;5.3;Registration;**533,572**;Aug 13, 1993
;
Q
;
MPIMAIL(DGQRY) ;LOG MPI EXCEPTION FROM LAST SITE TREATED
;The ICN sent from the MPI does not match the patient at the Last Site
;Treated, even though the site was on the Treatment Facility List
;received from the MPI. Send the MPI an exception to this effect.
;CALLED FROM RCVQRY^DGROHLR
;
; Input:
; DGQRY - Patient lookup components array
N FACNAM,LINE,TEXT,DGXMTXT,MPIFL,SITE,HLMID,LST,QS
S HLMID=$G(HL("MID"))
S LST=+$G(HL("RFN"))
S QS=+$G(HL("SAF"))
;
S FACNAM="",LINE="",MPIFL=1,HL("MID")=""
I '$G(DGQRY("RCVFAC")) D
. S SITE=$$SITE^VASITE
. S DGQRY("RCVFAC")=$P(SITE,U,3)
. S QS=DGQRY("RCVAC")
;
S RGEXC=219
S TEXT="Unable to find ICN # "_DGQRY("ICN")_" at "_LST_" for a Register Once call from Station # "_QS
D EXC^RGHLLOG(RGEXC,TEXT)
S HL("MID")=HLMID
Q
;
DODMAIL(DGDATA,DFN,LSTDFN) ;SEND MAIL MESSAGE TO DATE OF DEATH MAIL GROUP
;Date of Death data has been received from the Last Site Treated,
;so notify the appropriate people that this person is listed as
;deceased at the LST.
; CALLED FROM DOD^DGRODEBR
;
; Input:
; DGDATA - Data element array from LST, ^TMP("DGROFDA",$J)
; DFN - Pointer to the PATIENT (#2) file
; LSTDFN - Pointer to the patient data from the LST, in DGDATA
N U,LINE,LNCNT,TEXT,DGXMTXT,MPIFL
;
S U="^",LINE="",LNCNT=7,MPIFL=0
S LINE(1)="* * * * DG REGISTER ONCE NOTIFICATION * * * *"
S LINE(2)="Death Information has been received for the following patient:"
S LINE(3)="Patient Name: "_$$GET1^DIQ(2,DFN,.01)
S LINE(4)="Social Security Number: "_$$GET1^DIQ(2,DFN,.09)
S LINE(5)="Date Of Birth: "_$$FMTE^XLFDT($$GET1^DIQ(2,DFN,.03,"I"))
S LINE(6)="Integrated Control #: "_$$GET1^DIQ(2,DFN,991.01)
;
S LINE(LNCNT)="Death data received:"
I $D(@DGDATA@(2,LSTDFN_",",.351)) D
. S LNCNT=LNCNT+1
. ;* Format External date received per XLFDT for output consistency
. K X,%DT,Y ;* DG*5.3*572
. S X=@DGDATA@(2,LSTDFN_",",.351,"E")
. S %DT="TSN"
. D ^%DT
. S LINE(LNCNT)=" Date of Death: "_$$FMTE^XLFDT(Y)
;
I $D(@DGDATA@(2,LSTDFN_",",.353)) D
. N DGSET,DGSRCE
. ;* External DOD Source returned from LST
. S DGSRCE=@DGDATA@(2,LSTDFN_",",.353,"E") ;* DG*5.3*572
. S LNCNT=LNCNT+1
. S LINE(LNCNT)=" Source Of Notification of D.o.D.: "_DGSRCE
;
I $D(@DGDATA@(2,LSTDFN_",",.352)) D
. S LNCNT=LNCNT+1
. S LINE(LNCNT)=" D.o.D. Entered By: "_@DGDATA@(2,LSTDFN_",",.352,"E")
;
I $D(@DGDATA@(2,LSTDFN_",",.354)) D
. S LNCNT=LNCNT+1
. ;* Format External date received per XLFDT for output consistency
. K X,%DT,Y ;* DG*5.3*572
. S X=@DGDATA@(2,LSTDFN_",",.354,"E")
. S %DT="TSN"
. D ^%DT
. S LINE(LNCNT)=" D.o.D. Last Updated: "_$$FMTE^XLFDT(Y)
;
;DG*5.3*572 -- added field .355
I $D(@DGDATA@(2,LSTDFN_",",.355)) D
. S LNCNT=LNCNT+1
. S LINE(LNCNT)=" D.o.D. Last Edited By: "_@DGDATA@(2,LSTDFN_",",.355,"E")
;
S DGXMTXT=$NA(TEXT)
D BLDMSG(.LINE,DGXMTXT)
D SNDMSG(DGXMTXT,"DG REGISTER ONCE",MPIFL)
K X,%DT,Y ;* DG*5.3*572
Q
;
SPMAIL(DFN) ;SEND MAIL MESSAGE REGARDING A SENSITIVE PATIENT
;Sensitive Patient data has been received from the Last Site Treated,
;so notify the appropriate people that this person is listed as
;Sensitive at the LST.
; CALLED FROM SP^DGRODEBR
;
; Input:
; DGDATA - Data element array from LST, ^TMP("DGROFDA",$J)
; DFN - Pointer to the PATIENT (#2) file
N U,LINE,TEXT,DGXMTXT,MPIFL
;
S U="^",LINE="",MPIFL=0
S LINE(1)="* * * * DG REGISTER ONCE NOTIFICATION * * * *"
S LINE(2)="Sensitive Patient Information has been received for the following patient:"
S LINE(3)="Patient Name: "_$$GET1^DIQ(2,DFN,.01)
S LINE(4)="Social Security Number: "_$$GET1^DIQ(2,DFN,.09)
S LINE(5)="Date Of Birth: "_$$FMTE^XLFDT($$GET1^DIQ(2,DFN,.03,"I"))
S LINE(6)="Integrated Control #: "_$$GET1^DIQ(2,DFN,991.01)
;
S DGXMTXT=$NA(TEXT)
D BLDMSG(.LINE,DGXMTXT)
D SNDMSG(DGXMTXT,"DG REGISTER ONCE",MPIFL)
Q
;
BLDMSG(LINE,DGXMTXT) ;build MailMan message array
;
; Input:
; LINE - message array
;
; Output:
; DGXMTXT - array of MailMan text lines
;
N DGLIN ;line counter
N DGMAX ;maximum line length
N DGCNT ;counter
;
S DGLIN=0
S DGMAX=65
;
S DGCNT=0 F S DGCNT=$O(LINE(DGCNT)) Q:'DGCNT D
. D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)
. D ADDLINE(LINE(DGCNT),0,DGMAX,.DGLIN,DGXMTXT)
;
D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)
Q
;
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 available 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
;
SNDMSG(DGXMTXT,MAILGRP,MPIFL) ;send the MailMan message
;
; Input:
; 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="DG Register Once Module"
S XMSUB="DG REGISTER ONCE MESSAGE"
S XMTEXT=$$OREF^DILF(DGXMTXT)
S XMY("G."_MAILGRP)=""
I '$G(MPIFL) S XMY(DUZ)=""
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGROMAIL 6360 printed Sep 23, 2025@20:31:15 Page 2
DGROMAIL ;DJH/AMA - ROM HL7 MAIL MESSAGE PROCESSING ; 28 Apr 2004 4:16 PM
+1 ;;5.3;Registration;**533,572**;Aug 13, 1993
+2 ;
+3 QUIT
+4 ;
MPIMAIL(DGQRY) ;LOG MPI EXCEPTION FROM LAST SITE TREATED
+1 ;The ICN sent from the MPI does not match the patient at the Last Site
+2 ;Treated, even though the site was on the Treatment Facility List
+3 ;received from the MPI. Send the MPI an exception to this effect.
+4 ;CALLED FROM RCVQRY^DGROHLR
+5 ;
+6 ; Input:
+7 ; DGQRY - Patient lookup components array
+8 NEW FACNAM,LINE,TEXT,DGXMTXT,MPIFL,SITE,HLMID,LST,QS
+9 SET HLMID=$GET(HL("MID"))
+10 SET LST=+$GET(HL("RFN"))
+11 SET QS=+$GET(HL("SAF"))
+12 ;
+13 SET FACNAM=""
SET LINE=""
SET MPIFL=1
SET HL("MID")=""
+14 IF '$GET(DGQRY("RCVFAC"))
Begin DoDot:1
+15 SET SITE=$$SITE^VASITE
+16 SET DGQRY("RCVFAC")=$PIECE(SITE,U,3)
+17 SET QS=DGQRY("RCVAC")
End DoDot:1
+18 ;
+19 SET RGEXC=219
+20 SET TEXT="Unable to find ICN # "_DGQRY("ICN")_" at "_LST_" for a Register Once call from Station # "_QS
+21 DO EXC^RGHLLOG(RGEXC,TEXT)
+22 SET HL("MID")=HLMID
+23 QUIT
+24 ;
DODMAIL(DGDATA,DFN,LSTDFN) ;SEND MAIL MESSAGE TO DATE OF DEATH MAIL GROUP
+1 ;Date of Death data has been received from the Last Site Treated,
+2 ;so notify the appropriate people that this person is listed as
+3 ;deceased at the LST.
+4 ; CALLED FROM DOD^DGRODEBR
+5 ;
+6 ; Input:
+7 ; DGDATA - Data element array from LST, ^TMP("DGROFDA",$J)
+8 ; DFN - Pointer to the PATIENT (#2) file
+9 ; LSTDFN - Pointer to the patient data from the LST, in DGDATA
+10 NEW U,LINE,LNCNT,TEXT,DGXMTXT,MPIFL
+11 ;
+12 SET U="^"
SET LINE=""
SET LNCNT=7
SET MPIFL=0
+13 SET LINE(1)="* * * * DG REGISTER ONCE NOTIFICATION * * * *"
+14 SET LINE(2)="Death Information has been received for the following patient:"
+15 SET LINE(3)="Patient Name: "_$$GET1^DIQ(2,DFN,.01)
+16 SET LINE(4)="Social Security Number: "_$$GET1^DIQ(2,DFN,.09)
+17 SET LINE(5)="Date Of Birth: "_$$FMTE^XLFDT($$GET1^DIQ(2,DFN,.03,"I"))
+18 SET LINE(6)="Integrated Control #: "_$$GET1^DIQ(2,DFN,991.01)
+19 ;
+20 SET LINE(LNCNT)="Death data received:"
+21 IF $DATA(@DGDATA@(2,LSTDFN_",",.351))
Begin DoDot:1
+22 SET LNCNT=LNCNT+1
+23 ;* Format External date received per XLFDT for output consistency
+24 ;* DG*5.3*572
KILL X,%DT,Y
+25 SET X=@DGDATA@(2,LSTDFN_",",.351,"E")
+26 SET %DT="TSN"
+27 DO ^%DT
+28 SET LINE(LNCNT)=" Date of Death: "_$$FMTE^XLFDT(Y)
End DoDot:1
+29 ;
+30 IF $DATA(@DGDATA@(2,LSTDFN_",",.353))
Begin DoDot:1
+31 NEW DGSET,DGSRCE
+32 ;* External DOD Source returned from LST
+33 ;* DG*5.3*572
SET DGSRCE=@DGDATA@(2,LSTDFN_",",.353,"E")
+34 SET LNCNT=LNCNT+1
+35 SET LINE(LNCNT)=" Source Of Notification of D.o.D.: "_DGSRCE
End DoDot:1
+36 ;
+37 IF $DATA(@DGDATA@(2,LSTDFN_",",.352))
Begin DoDot:1
+38 SET LNCNT=LNCNT+1
+39 SET LINE(LNCNT)=" D.o.D. Entered By: "_@DGDATA@(2,LSTDFN_",",.352,"E")
End DoDot:1
+40 ;
+41 IF $DATA(@DGDATA@(2,LSTDFN_",",.354))
Begin DoDot:1
+42 SET LNCNT=LNCNT+1
+43 ;* Format External date received per XLFDT for output consistency
+44 ;* DG*5.3*572
KILL X,%DT,Y
+45 SET X=@DGDATA@(2,LSTDFN_",",.354,"E")
+46 SET %DT="TSN"
+47 DO ^%DT
+48 SET LINE(LNCNT)=" D.o.D. Last Updated: "_$$FMTE^XLFDT(Y)
End DoDot:1
+49 ;
+50 ;DG*5.3*572 -- added field .355
+51 IF $DATA(@DGDATA@(2,LSTDFN_",",.355))
Begin DoDot:1
+52 SET LNCNT=LNCNT+1
+53 SET LINE(LNCNT)=" D.o.D. Last Edited By: "_@DGDATA@(2,LSTDFN_",",.355,"E")
End DoDot:1
+54 ;
+55 SET DGXMTXT=$NAME(TEXT)
+56 DO BLDMSG(.LINE,DGXMTXT)
+57 DO SNDMSG(DGXMTXT,"DG REGISTER ONCE",MPIFL)
+58 ;* DG*5.3*572
KILL X,%DT,Y
+59 QUIT
+60 ;
SPMAIL(DFN) ;SEND MAIL MESSAGE REGARDING A SENSITIVE PATIENT
+1 ;Sensitive Patient data has been received from the Last Site Treated,
+2 ;so notify the appropriate people that this person is listed as
+3 ;Sensitive at the LST.
+4 ; CALLED FROM SP^DGRODEBR
+5 ;
+6 ; Input:
+7 ; DGDATA - Data element array from LST, ^TMP("DGROFDA",$J)
+8 ; DFN - Pointer to the PATIENT (#2) file
+9 NEW U,LINE,TEXT,DGXMTXT,MPIFL
+10 ;
+11 SET U="^"
SET LINE=""
SET MPIFL=0
+12 SET LINE(1)="* * * * DG REGISTER ONCE NOTIFICATION * * * *"
+13 SET LINE(2)="Sensitive Patient Information has been received for the following patient:"
+14 SET LINE(3)="Patient Name: "_$$GET1^DIQ(2,DFN,.01)
+15 SET LINE(4)="Social Security Number: "_$$GET1^DIQ(2,DFN,.09)
+16 SET LINE(5)="Date Of Birth: "_$$FMTE^XLFDT($$GET1^DIQ(2,DFN,.03,"I"))
+17 SET LINE(6)="Integrated Control #: "_$$GET1^DIQ(2,DFN,991.01)
+18 ;
+19 SET DGXMTXT=$NAME(TEXT)
+20 DO BLDMSG(.LINE,DGXMTXT)
+21 DO SNDMSG(DGXMTXT,"DG REGISTER ONCE",MPIFL)
+22 QUIT
+23 ;
BLDMSG(LINE,DGXMTXT) ;build MailMan message array
+1 ;
+2 ; Input:
+3 ; LINE - message array
+4 ;
+5 ; Output:
+6 ; DGXMTXT - array of MailMan text lines
+7 ;
+8 ;line counter
NEW DGLIN
+9 ;maximum line length
NEW DGMAX
+10 ;counter
NEW DGCNT
+11 ;
+12 SET DGLIN=0
+13 SET DGMAX=65
+14 ;
+15 SET DGCNT=0
FOR
SET DGCNT=$ORDER(LINE(DGCNT))
if 'DGCNT
QUIT
Begin DoDot:1
+16 DO ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)
+17 DO ADDLINE(LINE(DGCNT),0,DGMAX,.DGLIN,DGXMTXT)
End DoDot:1
+18 ;
+19 DO ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)
+20 QUIT
+21 ;
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 available 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 ;
SNDMSG(DGXMTXT,MAILGRP,MPIFL) ;send the MailMan message
+1 ;
+2 ; Input:
+3 ; DGXMTXT - name of message text array in closed format
+4 ;
+5 ; Output:
+6 ; none
+7 ;
+8 ;protect FM package
NEW DIFROM
+9 ;sender
NEW XMDUZ
+10 ;message subject
NEW XMSUB
+11 ;name of message text array in open format
NEW XMTEXT
+12 ;recipient array
NEW XMY
+13 ;returned message number
NEW XMZ
+14 ;
+15 SET XMDUZ="DG Register Once Module"
+16 SET XMSUB="DG REGISTER ONCE MESSAGE"
+17 SET XMTEXT=$$OREF^DILF(DGXMTXT)
+18 SET XMY("G."_MAILGRP)=""
+19 IF '$GET(MPIFL)
SET XMY(DUZ)=""
+20 DO ^XMD
+21 QUIT
