source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGEN339.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.1 KB
Line 
1DGEN339 ;ALB/SCK - IVMB HEC CLEANUP - VETERAN MERGE EXTRACT ; 1/13/2001
2 ;;5.3;Registration;**339,410**;Aug 13,1993
3 ;
4EN ; Main entry point for veteran merged pair collection and transmission to the HEC
5 N ZTRTN,ZTIO,ZTDESC,ZTSK,ZTDTH,ZTSAVE,DGDEST,DIR,DIRUT
6 ;
7 ; Check for merge of patient file in file #15.3
8 I '$D(^VA(15.3,2)) D Q
9 . W !?2,*7,">> There were no patient merge entries in the XDR REPOINTED ENTRY File (15.3)"
10 . W !?2,">> Please check that the Duplicate Patient Merge was completed."
11 ;
12 S DIR(0)="YAO",DIR("B")="YES",DIR("A")="Transmit to HEC Production? "
13 S DIR("?",1)="'YES' will transmit extracts to the HEC production system."
14 S DIR("?")="'NO' will transmit the extracts to the HEC Development accounts."
15 D ^DIR K DIR
16 Q:$D(DIRUT)
17 S DGDEST=+Y
18 ;
19 S ZTSAVE("DGDEST")=""
20 S ZTRTN="QUE^DGEN339"
21 S ZTDESC="DG53_339 VETERAN MERGE GENERATION"
22 S ZTIO=""
23 S ZTDTH=$$NOW^XLFDT
24 D ^%ZTLOAD
25 ;
26 I $G(ZTSK) W !,"Task Number: ",ZTSK
27 Q
28 ;
29QUE ;
30 N DGEXTRCT,DGDATA
31 ;
32 S DGEXTRCT="^TMP(""DGEN VET MRG"",$J)"
33 K @DGEXTRCT
34 ;
35 S DGDATA("SITE")=$P($$SITE^VASITE,U,3)
36 ;
37 D COLLECT(DGEXTRCT,.DGDATA)
38 D BUILD(DGEXTRCT,.DGDATA,1000,DGDEST)
39 D NOTIFY(.DGDATA)
40 ;
41 K @DGEXTRCT
42 Q
43 ;
44TEST(MODE) ; Test entry point for development testing. This entry point is not
45 ; supported for user use.
46 ;
47 N LINE,DGEXTRCT,DGDATA
48 ;
49 S MODE=$G(MODE)
50 ;
51 S DGDATA("TEST")=1
52 S DGEXTRCT="^TMP(""DGEN VET MRG"",$J)"
53 K @DGEXTRCT
54 ;
55 S DGDATA("SITE")=$P($$SITE^VASITE,U,3)
56 ;
57 I 'MODE D
58 . F LINE=1:1:1200 D
59 . . S @DGEXTRCT@(LINE)=$R(2000)_"^"_$R(2000)
60 . S DGDATA("NUMREC")=LINE
61 E D
62 . D COLLECT(DGEXTRCT,.DGDATA)
63 ;
64 D BUILD(DGEXTRCT,.DGDATA,500)
65 D NOTIFY(.DGDATA)
66 ;
67 K @DGEXTRCT
68 Q
69 ;
70COLLECT(DGEXTRCT,DGDATA) ; Collect Merge From and Merge To pair from XDR Repointed Entry File
71 ; Append ICN to end of merge pair using API call
72 N LINE,IX,ZVALUE,DFN1,DFN2
73 ;
74 S IX=0,LINE=1
75 F S IX=$O(^VA(15.3,2,1,IX)) Q:'IX D
76 . S ZVALUE=$G(^VA(15.3,2,1,IX,0))
77 . I ($T(GETICN^MPIF001)'="") D
78 . . S DFN1=$P(ZVALUE,U)
79 . . S DFN2=$P(ZVALUE,U,2)
80 . . S ZVALUE=ZVALUE_U_"M~"_$$GETICN^MPIF001(DFN1)_U_"MT~"_$$GETICN^MPIF001(DFN2)
81 . S @DGEXTRCT@(LINE)=ZVALUE
82 . S LINE=LINE+1
83 S DGDATA("NUMREC")=LINE-1
84 ;
85 Q
86 ;
87BUILD(DGEXTRCT,DGDATA,MAX,DGDEST) ; Build and send mailman messages of veteran pairs
88 N DGX,COUNT,DGMSG,LINE
89 ;
90 S MAX=$G(MAX)
91 S:'MAX MAX=1000
92 ;
93 S DGMSG="^TMP(""DG339TXT"",$J)"
94 K @DGMSG
95 ;
96 ; Calculate the number of messages to send using MAX and number of records
97 S DGDATA("TOSEND")=DGDATA("NUMREC")\MAX
98 S:DGDATA("NUMREC")#MAX>0 DGDATA("TOSEND")=DGDATA("TOSEND")+1
99 ;
100 S DGDATA("MSGNUM")=1 ; Initialize first message
101 S COUNT=0,LINE=1
102 F S COUNT=$O(@DGEXTRCT@(COUNT)) Q:'COUNT D
103 . S @DGMSG@(LINE)=@DGEXTRCT@(COUNT)
104 . S LINE=LINE+1
105 . I LINE>MAX D
106 . . S DGDATA("MSG",DGDATA("MSGNUM"))=LINE-1
107 . . D SEND(.DGDATA,DGMSG,DGDEST)
108 . . S DGDATA("MSGNUM")=$G(DGDATA("MSGNUM"))+1
109 . . K @DGMSG
110 . . S LINE=1
111 ; Send last message
112 S DGDATA("MSG",DGDATA("MSGNUM"))=LINE-1
113 D SEND(.DGDATA,DGMSG,DGDEST)
114 ;
115 Q
116 ;
117SEND(DGDATA,DGMSG,DGDEST) ; Build and send individual mailman messages
118 N XMY,XMSUB,XMDUZ,XMZ,XMERR,XMTEXT,MSG
119 ;
120 S XMDUZ="HEC VETERAN MERGE EXTRACT"
121 I $G(DGDEST) S XMY("S.IVMB VSE SERVER@IVM.MED.VA.GOV")=""
122 E S XMY("S.IVMB VSE SERVER@PDQMGR.IVM.MED.VA.GOV")=""
123 ;
124 S XMY(.5)=""
125 S XMY("G.IVMB HEC VSE NOTIFICATION")=""
126 S XMSUB=$$GET1^DIQ(4,DGDATA("SITE"),.01)_"/"_DGDATA("SITE")_":VSE #"_DGDATA("MSGNUM")_" OF "_DGDATA("TOSEND")
127 S @DGMSG@(.5)=DGDATA("SITE")_U_DGDATA("MSGNUM")_U_DGDATA("TOSEND")_U_DGDATA("MSG",DGDATA("MSGNUM"))_"^"_DGDATA("NUMREC")
128 S XMTEXT="MSG("
129 M MSG=@DGMSG
130 ;
131 D ^XMD
132 Q
133 ;
134NOTIFY(DGDATA) ; Send notification message to local mailgroup.
135 N XMY,XMSUB,XMTEXT,XMDUZ,XMZ,XMERR,DGTXT
136 ;
137 S XMDUZ="HEC VETERAN MERGE EXTRACT"
138 S XMY("G.IVMB HEC VSE NOTIFICATION")=""
139 S XMSUB="HEC VETERAN MERGE EXTRACT TRANSMISSION"
140 ;
141 S DGTXT(.1)="A total of "_DGDATA("NUMREC")_" veteran extract records in "_DGDATA("MSGNUM")
142 S DGTXT(.2)="messages have been transmitted to the HEC"
143 S DGTXT(.3)=""
144 ;
145 S X=0
146 F S X=$O(DGDATA("MSG",X)) Q:'X D
147 . S DGTXT(X)=" Message #"_X_" - "_DGDATA("MSG",X)_" records"
148 S XMTEXT="DGTXT("
149 D ^XMD
150 Q
Note: See TracBrowser for help on using the repository browser.