DG53293B ;AR/BP - ALS EXTRACT; ; 7/25/00 10:38am
;;5.3;Registration;**293,1015**;Aug 13, 1993;Build 21
;
;Description:
;This routine contains calls to various Mailman functions. The calls
;vary from sending mail to the user, to mailgroups or server groups.
;
;
SETMAIL(DGTATION,DGDFN) ;
I DGLINE=0 D INITMAIL(1)
;
S DGLINE=DGLINE+1
S DGPECE=1
;
; set first line of each record to station^ssn
S ^XMB(3.9,XMZ,2,DGLINE,0)=DGTATION_"^"_$P($G(^DPT(+DGDFN,0)),"^",9)_"^"
S DGLINE=DGLINE+1
;
S DGFIELD=0
F S DGFIELD=$O(^XTMP("DGALS",$J,"DATA",2,DGDFN,DGFIELD)) Q:'DGFIELD DO
. ;set mailmsg for 1 dfn
. I $$LINECALC(DGFIELD,DGLINE)>254 DO
. . ; make sure end piece has last ^
. . S $P(^XMB(3.9,XMZ,2,DGLINE,0),"^",DGPECE)=""
. . S DGLINE=DGLINE+1
. . S DGPECE=1
. D SETLINE
. S DGPECE=DGPECE+1
;
; make sure end piece has last ^
S $P(^XMB(3.9,XMZ,2,DGLINE,0),"^",DGPECE)=""
S DGLINE=DGLINE+1
; set record delimiter
S ^XMB(3.9,XMZ,2,DGLINE,0)=">>>"
;
Q
LINECALC(DGFIELD,DGLINE) ;
; return length that would be set
Q $L($G(^XTMP("DGALS",$J,"DATA",2,DGDFN,DGFIELD,"E")))+$L($G(^XMB(3.9,XMZ,2,DGLINE,0)))
;
;
SETLINE ;set mailmsg from xtmp array
; $g will preserve piece position if field returned error
S $P(^XMB(3.9,XMZ,2,DGLINE,0),"^",DGPECE)=$G(^XTMP("DGALS",$J,"DATA",2,DGDFN,DGFIELD,"E")) Q
;
;
INITMAIL(FLAG) ;-- This function will initialize mail variables
;
S XMSUB="DG*5.3*293 "_(+$$SITE^VASITE())_" VA PATIENT SURVEY"
S XMDUZ=.5,XMY(DUZ)="",XMY(XMDUZ)=""
I $G(FLAG) DO
. S XMY("S.DG ALS SERVER@MNTVBB.ISC-ALBANY.VA.GOV")=""
. S XMY("YORTY.M_ROBERT@FORUM.VA.GOV")=""
D GET^XMA2
Q
SMAIL(DGLINE) ;-- Send Mail Message containing records so far
;
; INPUT TOTAL- Total Lines in Message
;
S ^XMB(3.9,XMZ,2,0)="^3.92A^"_DGLINE_U_DGLINE_U_DT
D ENT1^XMD
D KILL^XM
Q
;
FMAIL(DATA) ;- This function will generate a summary mail message.
;
S XMSUB="DG*5.3*293 "_(+$$SITE^VASITE())_" VA Patient Survey Error Summary"
S XMDUZ=.5,XMY(DUZ)="",XMY(XMDUZ)=""
I DATA S XMY("YORTY.M_ROBERT@FORUM.VA.GOV")=""
;
D GET^XMA2
S ^XMB(3.9,XMZ,2,1,0)="VA Patient Survey completed."
S ^XMB(3.9,XMZ,2,2,0)=""
S ^XMB(3.9,XMZ,2,3,0)="Start Time: "_DGSTART
S ^XMB(3.9,XMZ,2,4,0)=" Stop Time: "_$$FMTE^XLFDT($$NOW^XLFDT)
S ^XMB(3.9,XMZ,2,5,0)=""
;
S DGLINE=6
I 'DATA DO QUIT
. S ^XMB(3.9,XMZ,2,DGLINE,0)="No data requested"
. D SMAIL(DGLINE)
;
S DGZ=$Q(^XTMP("DGALS",$J,"ERROR"))
I DGZ]"",DGZ[("""DGALS"""_","_$J_","_"""ERROR""")
E DO QUIT
. S ^XMB(3.9,XMZ,2,DGLINE,0)=" Error Summary: No errors Found "
. D SMAIL(DGLINE)
;
S ^XMB(3.9,XMZ,2,DGLINE,0)=" Error Summary: "
S DGLINE=DGLINE+1
S ^XMB(3.9,XMZ,2,DGLINE,0)="""ERR"_$P(DGZ,"ERROR",2)_" = "_@DGZ
;
F S DGZ=$Q(@DGZ) Q:DGZ']"" Q:DGZ'[("""DGALS"""_","_$J_","_"""ERROR""") DO
. S DGLINE=DGLINE+1
. S ^XMB(3.9,XMZ,2,DGLINE,0)="""ERR"_$P(DGZ,"ERROR",2)_" = "_@DGZ
.;
.;quit if this gets to be too much
. I DGLINE>500 S DGZ="ZZZEND"
D SMAIL(DGLINE)
Q
DG53293B ;AR/BP - ALS EXTRACT; ; 7/25/00 10:38am
+1 ;;5.3;Registration;**293,1015**;Aug 13, 1993;Build 21
+2 ;
+3 ;Description:
+4 ;This routine contains calls to various Mailman functions. The calls
+5 ;vary from sending mail to the user, to mailgroups or server groups.
+6 ;
+7 ;
SETMAIL(DGTATION,DGDFN) ;
+1 IF DGLINE=0
DO INITMAIL(1)
+2 ;
+3 SET DGLINE=DGLINE+1
+4 SET DGPECE=1
+5 ;
+6 ; set first line of each record to station^ssn
+7 SET ^XMB(3.9,XMZ,2,DGLINE,0)=DGTATION_"^"_$PIECE($GET(^DPT(+DGDFN,0)),"^",9)_"^"
+8 SET DGLINE=DGLINE+1
+9 ;
+10 SET DGFIELD=0
+11 FOR
SET DGFIELD=$ORDER(^XTMP("DGALS",$JOB,"DATA",2,DGDFN,DGFIELD))
IF 'DGFIELD
QUIT
Begin DoDot:1
+12 ;set mailmsg for 1 dfn
+13 IF $$LINECALC(DGFIELD,DGLINE)>254
Begin DoDot:2
+14 ; make sure end piece has last ^
+15 SET $PIECE(^XMB(3.9,XMZ,2,DGLINE,0),"^",DGPECE)=""
+16 SET DGLINE=DGLINE+1
+17 SET DGPECE=1
End DoDot:2
+18 DO SETLINE
+19 SET DGPECE=DGPECE+1
End DoDot:1
+20 ;
+21 ; make sure end piece has last ^
+22 SET $PIECE(^XMB(3.9,XMZ,2,DGLINE,0),"^",DGPECE)=""
+23 SET DGLINE=DGLINE+1
+24 ; set record delimiter
+25 SET ^XMB(3.9,XMZ,2,DGLINE,0)=">>>"
+26 ;
+27 QUIT
LINECALC(DGFIELD,DGLINE) ;
+1 ; return length that would be set
+2 QUIT $LENGTH($GET(^XTMP("DGALS",$JOB,"DATA",2,DGDFN,DGFIELD,"E")))+$LENGTH($GET(^XMB(3.9,XMZ,2,DGLINE,0)))
+3 ;
+4 ;
SETLINE ;set mailmsg from xtmp array
+1 ; $g will preserve piece position if field returned error
+2 SET $PIECE(^XMB(3.9,XMZ,2,DGLINE,0),"^",DGPECE)=$GET(^XTMP("DGALS",$JOB,"DATA",2,DGDFN,DGFIELD,"E"))
QUIT
+3 ;
+4 ;
INITMAIL(FLAG) ;-- This function will initialize mail variables
+1 ;
+2 SET XMSUB="DG*5.3*293 "_(+$$SITE^VASITE())_" VA PATIENT SURVEY"
+3 SET XMDUZ=.5
SET XMY(DUZ)=""
SET XMY(XMDUZ)=""
+4 IF $GET(FLAG)
Begin DoDot:1
+5 SET XMY("S.DG ALS SERVER@MNTVBB.ISC-ALBANY.VA.GOV")=""
+6 SET XMY("YORTY.M_ROBERT@FORUM.VA.GOV")=""
End DoDot:1
+7 DO GET^XMA2
+8 QUIT
SMAIL(DGLINE) ;-- Send Mail Message containing records so far
+1 ;
+2 ; INPUT TOTAL- Total Lines in Message
+3 ;
+4 SET ^XMB(3.9,XMZ,2,0)="^3.92A^"_DGLINE_U_DGLINE_U_DT
+5 DO ENT1^XMD
+6 DO KILL^XM
+7 QUIT
+8 ;
FMAIL(DATA) ;- This function will generate a summary mail message.
+1 ;
+2 SET XMSUB="DG*5.3*293 "_(+$$SITE^VASITE())_" VA Patient Survey Error Summary"
+3 SET XMDUZ=.5
SET XMY(DUZ)=""
SET XMY(XMDUZ)=""
+4 IF DATA
SET XMY("YORTY.M_ROBERT@FORUM.VA.GOV")=""
+5 ;
+6 DO GET^XMA2
+7 SET ^XMB(3.9,XMZ,2,1,0)="VA Patient Survey completed."
+8 SET ^XMB(3.9,XMZ,2,2,0)=""
+9 SET ^XMB(3.9,XMZ,2,3,0)="Start Time: "_DGSTART
+10 SET ^XMB(3.9,XMZ,2,4,0)=" Stop Time: "_$$FMTE^XLFDT($$NOW^XLFDT)
+11 SET ^XMB(3.9,XMZ,2,5,0)=""
+12 ;
+13 SET DGLINE=6
+14 IF 'DATA
Begin DoDot:1
+15 SET ^XMB(3.9,XMZ,2,DGLINE,0)="No data requested"
+16 DO SMAIL(DGLINE)
End DoDot:1
QUIT
+17 ;
+18 SET DGZ=$QUERY(^XTMP("DGALS",$JOB,"ERROR"))
+19 IF DGZ]""
IF DGZ[("""DGALS"""_","_$JOB_","_"""ERROR""")
+20 IF '$TEST
Begin DoDot:1
+21 SET ^XMB(3.9,XMZ,2,DGLINE,0)=" Error Summary: No errors Found "
+22 DO SMAIL(DGLINE)
End DoDot:1
QUIT
+23 ;
+24 SET ^XMB(3.9,XMZ,2,DGLINE,0)=" Error Summary: "
+25 SET DGLINE=DGLINE+1
+26 SET ^XMB(3.9,XMZ,2,DGLINE,0)="""ERR"_$PIECE(DGZ,"ERROR",2)_" = "_@DGZ
+27 ;
+28 FOR
SET DGZ=$QUERY(@DGZ)
IF DGZ']""
QUIT
IF DGZ'[("""DGALS"""_","_$JOB_","_"""ERROR""")
QUIT
Begin DoDot:1
+29 SET DGLINE=DGLINE+1
+30 SET ^XMB(3.9,XMZ,2,DGLINE,0)="""ERR"_$PIECE(DGZ,"ERROR",2)_" = "_@DGZ
+31 ;
+32 ;quit if this gets to be too much
+33 IF DGLINE>500
SET DGZ="ZZZEND"
End DoDot:1
+34 DO SMAIL(DGLINE)
+35 QUIT
