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

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

initial load of WorldVistAEHR
File size: 4.6 KB
RevLine 
[613]1DGEN408 ;ALB/RKS - SEED THE HEC ; 5/3/02 3:04pm
2 ;;5.3;Registration;**408**;Aug 13,1993
3 Q
4 ;
5EN ; Main entry point for collection of MPI fields & transmission to HEC
6 ;
7 N ZTRTN,ZTIO,ZTDESC,ZTSK,ZTDTH,ZTSAVE,DGDEST,DIR,DIRUT
8 ;
9 ; Check for MPI
10 I ($T(GETICN^MPIF001)="") D Q
11 . W !?2,*7,">> There were no patient MPI"
12 ;
13 S DIR(0)="YAO",DIR("B")="YES",DIR("A")="Transmit to HEC Production? "
14 S DIR("?",1)="'YES' will transmit extracts to the HEC production system."
15 S DIR("?")="'NO' will transmit the extracts to the HEC Development accounts."
16 D ^DIR K DIR
17 Q:$D(DIRUT)
18 S DGDEST=+Y ;Destination = 1 for Production
19 I 'DGDEST D TEST Q ;else Test Mode and Quit
20 ;
21 S ZTSAVE("DGDEST")=""
22 S ZTRTN="QUE^DGEN408"
23 S ZTDESC="DG53_408 SEED THE HEC WITH ICN"
24 S ZTIO=""
25 S ZTDTH=$$NOW^XLFDT
26 D ^%ZTLOAD
27 ;
28 I $G(ZTSK) W !,"Task Number: ",ZTSK
29 Q
30 ;
31QUE ;Background task entry point for Production option
32 N DGEXTRCT,DGDATA
33 ;
34 S DGEXTRCT="^TMP(""SEED HEC"",$J)"
35 K @DGEXTRCT
36 ;
37 S DGDATA("SITE")=$P($$SITE^VASITE,U,3)
38 K IVMQUERY("LTD"),IVMQUERY("OVIS")
39 ;
40 D COLLECT(DGEXTRCT,.DGDATA)
41 D BUILD(DGEXTRCT,.DGDATA,1000,DGDEST)
42 D NOTIFY(.DGDATA)
43 ;
44 K @DGEXTRCT
45 Q
46 ;
47TEST ; Test entry point for development testing. This entry point is
48 ; not supported for user use.
49 N LINE,DGEXTRCT,DGDATA
50 K DIR
51 S DIR(0)="SO^P:PDQMGR ENV;S:SDQMGR ENV;Q:QDQMGR ENV"
52 S DIR("A")="Transmit to which Environment? "
53 S DIR("?")="Enter 1 of the 3 test environments allowed"
54 D ^DIR K DIR Q:$D(DIRUT)
55 S DGDEST=Y ;Destination = P, S, or Q for testing
56 S DGDATA("TEST")=1
57 S DGEXTRCT="^TMP(""SEED HEC"",$J)"
58 K @DGEXTRCT
59 S DGDATA("SITE")=$P($$SITE^VASITE,U,3)
60 ;
61 W !!,"COLLECTING DATA TO SEND TO "_DGDEST_"DQMGR...please wait..."
62 D COLLECT(DGEXTRCT,.DGDATA)
63 D BUILD(DGEXTRCT,.DGDATA,1000,DGDEST) ;batch 1000 vets per message
64 D NOTIFY(.DGDATA)
65 ;
66 K @DGEXTRCT
67 Q
68 ;
69COLLECT(DGEXTRCT,DGDATA) ; Collect valid MPI data
70 N LINE,DFN
71 ;
72 S DFN=0,LINE=1
73 ;
74 ;loop and set TMP extract global with patients that qualify, ignoring
75 ;those patients whose CMOR is not from this site or have a Local ICN
76 F S DFN=$O(^DPT(DFN)) Q:'DFN D
77 . I +$$GETICN^MPIF001(DFN)<0!(($$IFLOCAL^MPIF001(DFN)=1)!($$IFVCCI^MPIF001(DFN)'=1)) Q
78 . S @DGEXTRCT@(LINE)=DFN_U_$$GETICN^MPIF001(DFN)_U
79 . S @DGEXTRCT@(LINE)=@DGEXTRCT@(LINE)_$$GETVCCI^MPIF001(DFN)
80 . S LINE=LINE+1
81 ;
82 S DGDATA("NUMREC")=LINE-1
83 ;
84 Q
85 ;
86BUILD(DGEXTRCT,DGDATA,MAX,DGDEST) ; Build mailman messages of MPI data
87 N DGX,COUNT,DGMSG,LINE
88 ;
89 S MAX=$G(MAX)
90 S:'MAX MAX=1000
91 ;
92 S DGMSG="^TMP(""DGEN408TXT"",$J)"
93 K @DGMSG
94 ;
95 ; Calculate the number of messages (batches) to send based on MAX
96 S DGDATA("TOSEND")=DGDATA("NUMREC")\MAX
97 S:DGDATA("NUMREC")#MAX>0 DGDATA("TOSEND")=DGDATA("TOSEND")+1
98 ;
99 S (COUNT,LINE)=0
100 F S COUNT=$O(@DGEXTRCT@(COUNT)) Q:'COUNT D
101 . S LINE=LINE+1
102 . S @DGMSG@(LINE)=@DGEXTRCT@(COUNT)
103 . ; if exceed max per batch, then stop and send now & reset for next
104 . I LINE=MAX D
105 . . S DGDATA("MSGNUM")=$G(DGDATA("MSGNUM"))+1
106 . . S DGDATA("MSG",DGDATA("MSGNUM"))=LINE
107 . . D SEND(.DGDATA,DGMSG,DGDEST)
108 . . K @DGMSG
109 . . S LINE=0
110 ;
111 ; Quit if Not at least 1 record exists, else send last batch
112 Q:'LINE
113 ;
114 ;send the last partial batch
115 S DGDATA("MSGNUM")=$G(DGDATA("MSGNUM"))+1
116 S DGDATA("MSG",DGDATA("MSGNUM"))=LINE
117 D SEND(.DGDATA,DGMSG,DGDEST)
118 ;
119 Q
120 ;
121SEND(DGDATA,DGMSG,DGDEST) ; Build and send individual mailman messages
122 N XMY,XMSUB,XMDUZ,XMZ,XMERR,XMTEXT,MSG
123 ;
124 S XMDUZ="HEC MPI SEEDING"
125 I DGDEST=1 D ;send to production
126 . S XMY("S.IVMB MPI SERVER@IVM.MED.VA.GOV")=""
127 E D ;send to a test account
128 . N TMP
129 . S TMP="S.IVMB MPI SERVER@"_DGDEST_"DQMGR.IVM.MED.VA.GOV"
130 . S XMY(TMP)=""
131 ;
132 S XMY(.5)=""
133 S XMY("G.IVMB HEC MPI NOTIFICATION")=""
134 S XMSUB=$$GET1^DIQ(4,DGDATA("SITE"),.01)_"/"_DGDATA("SITE")
135 S XMSUB=XMSUB_":MPI #"_DGDATA("MSGNUM")_" OF "_DGDATA("TOSEND")
136 S @DGMSG@(.5)=DGDATA("SITE")_U_DGDATA("MSGNUM")_U_DGDATA("TOSEND")
137 S @DGMSG@(.5)=@DGMSG@(.5)_U_DGDATA("MSG",DGDATA("MSGNUM"))_U
138 S @DGMSG@(.5)=@DGMSG@(.5)_DGDATA("NUMREC")
139 S XMTEXT="MSG("
140 M MSG=@DGMSG
141 ;
142 D ^XMD
143 Q
144 ;
145NOTIFY(DGDATA) ; Send notification message to local mailgroup.
146 N XMY,XMSUB,XMTEXT,XMDUZ,XMZ,XMERR,DGTXT
147 ;
148 S XMDUZ="HEC MPI SEEDING"
149 S XMY("G.IVMB HEC MPI NOTIFICATION")=""
150 S XMSUB="HEC MPI TRANSMISSION"
151 ;
152 S DGTXT(.1)="A total of "_DGDATA("NUMREC")_" MPI seeding records in "_DGDATA("MSGNUM")
153 S DGTXT(.2)="messages have been transmitted to the HEC"
154 S DGTXT(.3)=""
155 ;
156 S X=0
157 F S X=$O(DGDATA("MSG",X)) Q:'X D
158 . S DGTXT(X)=" Message #"_X_" - "_DGDATA("MSG",X)_" records"
159 S XMTEXT="DGTXT("
160 ;
161 D ^XMD
162 Q
Note: See TracBrowser for help on using the repository browser.