source: FOIAVistA/trunk/r/ASISTS-OOPS/OOPSDOL.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 8.9 KB
Line 
1OOPSDOL ;WIOFO/CAH-ASISTS TRANSMISSION OF CA1/CA2 TO DOL ;3/15/00
2 ;;2.0;ASISTS;;Jun 03, 2002
3 ;
4 N ARR,FIELD,FL,MSG,VAL,XMZ
5 S MAN=1
6 ;Check for security keys
7 I '$D(^XUSEC("OOPS DOL XMIT DATA",DUZ)) D G EXIT
8 .S DIR(0)="FO" W !
9 .S DIR("A")="You do not have the required Security Key."
10 .S DIR("A")=DIR("A")_" Press Enter to continue"
11 .D ^DIR K DIR
12 ;Assure the Queue (Q-AST) has been defined
13 S VAL="Q-AST.MED.VA.GOV",FIELD=.01,FL="X"
14 D FIND^DIC(4.2,"",FIELD,FL,VAL,"","","","","ARR")
15 I '$D(ARR("DILIST",1)) D G EXIT
16 .S DIR(0)="FO" W !
17 .S DIR("A")="Domain not found in the DOMAIN File,"
18 .S DIR("A")=DIR("A")_" No Transmission. Press Enter to continue"
19 .D ^DIR K DIR
20 S DIR(0)="D"
21 S DIR("A")="Re-transmit cases for what date "
22 S DIR("?",1)="Enter the date of original transmission for cases "
23 S DIR("?")="that need to be resent"
24 D ^DIR K DIR G:$D(DIRUT) EXIT I Y S RDATE=Y
25 S DIR(0)="Y",DIR("B")="Y",DIR("A")="Do you want to Queue Transmission"
26 S DIR("?",1)="Enter 'Y' if you want the CA1/CA2 data placed in mail"
27 S DIR("?")="message as part of a tasked job."
28 D ^DIR K DIR G:$D(DIRUT) EXIT I Y D G EXIT
29 .S ZTRTN="EN^OOPSDOL",ZTIO=""
30 .S ZTDESC="TRANSMIT DOL CA1/CA2 DATA"
31 .D ^%ZTLOAD
32 S DIR(0)="Y"
33 S DIR("A")="Transmission NOT queued, OK to continue"
34 D ^DIR K DIR I 'Y G EXIT
35 S MSG("DIHELP",1)="Processing" W !
36 D MSG^DIALOG("WH","","","","MSG")
37EN ;Routine Entry
38 S WOK=1
39 N CNT,ERR,ERROR,FAIL,OPMG,OPQ
40 K VMSG,INV ; used for data validation of records
41 S CTR=1 ; counter for Mail message array
42 S (START,END,FAIL)=""
43 ; Assure the Queue (Q-AST) has been defined
44 S VAL="Q-AST.MED.VA.GOV",FIELD=.01,FL="X"
45 D FIND^DIC(4.2,"",FIELD,FL,VAL,"","","","","ARR")
46 I '$D(ARR("DILIST",1)) D G EXIT
47 . S ERROR(1)="The Queue Q-AST.MED.VA.GOV has not been created. Please contact your IRM "
48 . S ERROR(2)="Dept. to have Patch XM*999*136 installed; once installed complete manual "
49 . S ERROR(3)="transmission of DOL Data."
50 . D ERROR2
51 ; Make sure Mail Group Exists
52 S OPMG=$$FIND1^DIC(3.8,"","X","OOPS WC MESSAGE")
53 I 'OPMG D G EXIT
54 . S ERROR(1)="The Mail Group OOPS WC MESSAGE is missing."
55 . S ERROR(2)="Add the Group so that ASISTS data can be transmitted "
56 . S ERROR(3)="to the AAC. Then contact Worker Compensation office "
57 . S ERROR(4)="to complete manual Transmission of DOL Data."
58 . D ERROR
59 ; Get list of members
60 D LIST^DIC(3.81,","_OPMG_",","","",1,"","","","","","OPQ")
61 I '$P(OPQ("DILIST",0),U) D G EXIT
62 . S ERROR(1)="There are no members of the OOPS WC MESSAGE "
63 . S ERROR(1)=ERROR(1)_"Mail Group."
64 . S ERROR(2)="Enter at least one member to the group. This person "
65 . S ERROR(3)="will receive messages concerning the transmission of "
66 . S ERROR(4)="ASISTS DOL data to and from the AAC. After adding member"
67 . S ERROR(5)="contact Worker Compensation office to complete manual transmission of DOL data."
68 . D ERROR
69GETREC ; Loop thru ^OOP(2260 "AW" or "AWC" XRef to get records to transmit
70 ; AW=Schedule Transmission
71 ; AWC=Manual Transmission
72 N OOPDA,SMSG,STA,XMDUZ,XMTEXT,XMSUB,XMY,MDATA,VALID
73 N Y,%,%H,%I
74 K ^TMP($J,"C"),^TMP($J,"D")
75 S (CNT,OOPDA)=0
76 D NOW^%DTC S DATE=%,Y=DATE X ^DD("DD")
77 S MTIME=$P(Y,"@",2),DATE=$$DC^OOPSUTL3(%)
78 I $D(MAN) S INDEX="^OOPS(2260,""AWC"",OPI)",INDEX2="^OOPS(2260,""AWC"",OPI,OOPDA)"
79 E S INDEX="^OOPS(2260,""AW"",OPI)",INDEX2="^OOPS(2260,""AW"",OPI,OOPDA)"
80 S OPI=0 F S OPI=$O(@INDEX) Q:'OPI D
81 .S OOPDA=0 F S OOPDA=$O(@INDEX2) Q:'OOPDA D
82 .. I $D(MAN),OPI'=RDATE Q
83 .. I '$G(MAN),($$GET1^DIQ(2260,OOPDA,66)'="") D Q
84 ... K ^OOPS(2260,"AW",OPI,OOPDA)
85 .. I '$$VERIFY^OOPSUTL6(OOPDA) Q ; verify data not chged
86 .. S VALID=$$VAL^OOPSUTL5(OOPDA)
87 .. ; Get Station #, use w/Mail Grp by Station for messages, if there
88 .. S STA=$$GET1^DIQ(4,$P(^OOPS(2260,OOPDA,"2162A"),U,9),99,"E")
89 .. ; Valid Case
90 .. I $G(VALID)'="" S CNT=CNT+1,^TMP($J,"C",OOPDA)="",SMSG(STA,OOPDA)="" Q
91 .. ; Invalid Case
92 .. S T="" F S T=$O(NULL(T)) Q:'T S ^TMP($J,"D",STA,OOPDA,T)=$G(NULL(T))
93 S ^TMP($J,"C")=CNT
94NOCASES ; No Cases to Send - Send Mail Message with only DOL segment
95 I $D(MAN),CNT=0 D G EXIT
96 .S DIR(0)="FO"
97 .S DIR("A")="No cases to transmit for requested date"
98 .D ^DIR K DIR
99 I CNT=0 D G EXIT
100 . S XMDUZ="ASISTS Report on Daily Transmission to the AAC"
101 . S GRP="OOPS WC MESSAGE"
102 . S XMY("G."_GRP)=""
103 . ; If no one in mail group (this should not occur), send to user
104 . I $D(XMY)<9 S XMY(DUZ)=""
105 . S XMSUB="ASISTS no claims to process"
106 . S XMTEXT="MSG("
107 . S MSG(1)="There were no claims ready for transmission"
108 . S MSG(2)="to the Austin Automation Center when the."
109 . S MSG(3)="scheduled task last ran."
110 . D ^XMD
111 . K MSG
112 . Q
113PROCESS ;
114 D CREATE G:FAIL EXIT
115 ; START - First case number in MM, End - Last Case # in MM
116 S OOPDA="",START="",END="",OPAST=""
117 F S OPAST=OOPDA,OOPDA=$O(^TMP($J,"C",OOPDA)) Q:OOPDA="" D
118 . D ^OOPSDOLX
119 . ; if first send, Set DATE TRANSMITTED TO WCMIS in ^OOPS(2260
120 . I $$GET1^DIQ(2260,OOPDA,66)="" D
121 .. K DR S DIE="^OOPS(2260,",(IEN,DA)=OOPDA,DR="66///TODAY"
122 .. D ^DIE K DR,DA,DIE
123 . I $$GET1^DIQ(2260,OOPDA,199,"I")="Y" D WCP^OOPSMBUL(OOPDA,"E")
124 ; If any records left to send and no FAILure
125 I ($G(XMZ)'<1)&('FAIL) D
126 . I END="" S END=$P($P(^OOPS(2260,OPAST,0),U),"-",2)
127 . D SEND
128EXIT ; Quit the program
129 D BADREC ; Send Mail if any Bad Records
130 D SENTMSG ; Send message to OOPS WCP with sent claims
131 I $G(FAIL) D
132 .S ERROR(1)="Mail Message was not created. Contact Worker Compensation office "
133 .S ERROR(2)="to complete the transmission of ASISTS DOL data."
134 .D ERROR2
135 K CTR,DATE,ERR,ERROR,GRP,INV,OPL,MSIZE,MTIME,XMSUB,XMTEXT,XMY,MSG,MAN
136 K ^TMP($J),%DT,CATY,D,DO,DATA,DI,DIC,DISYS,DIW,DIWI,DAS,DIWT,DN,DQ
137 K END,FL174,FLD,HOUR,I,INDEX,INDEX2,MAX,MIN,OOPSAR,OPAST,OPI,OSHA
138 K OSHASC,P,RPOL,START,T,WOK,X,XMDUN,XMY,XMZ,Y,Z,RDATE,IEN,OPHM,CONV
139 K COPDT,DIWTC,DIWX,OTIME,REL,SIEN
140 Q
141CREATE ; Create Mailman Message
142 N OPDATA,SN
143 S MSIZE=0
144 I $G(XMZ)'<1 D SEND
145 S OPL=0
146 S XMSUB="ASISTS DOL DATA"
147 S XMDUZ=DUZ
148 D XMZ^XMA2 I XMZ<1 S FAIL=1 Q
149 S SN=$$GET1^DIQ(4,$P($G(^XMB(1,1,"XUS")),U,17),99)
150 S SN=$E("0000000",$L(SN)+1,7)_SN
151 S OPDATA="0DOL^ASISTS^"_SN_U_DATE
152 S OPDATA=OPDATA_U_U_"001"_U_"|"
153 S OPL=OPL+1,^XMB(3.9,XMZ,2,OPL,0)=OPDATA
154 Q
155SEND ; Send Mailman Message
156 N NUMCASE
157 S ^XMB(3.9,XMZ,2,0)="^3.92A^"_OPL_U_OPL_U_DT
158 ; Set # of Cases in this Mail Message
159 S NUMCASE=$S(START'="":START_"-"_END,1:0)
160 S $P(^XMB(3.9,XMZ,2,1,0),U,5)=NUMCASE
161 ; Indicate last line of message
162 S OPL=OPL+1,^XMB(3.9,XMZ,2,OPL,0)="NNNN"_$C(13)_$C(10)
163 S XMY(DUZ)="" ; also send here, in case of error.
164 S XMY("XXX@Q-AST.MED.VA.GOV")=""
165 S XMCHAN=1 D ENT1^XMD K XMCHAN
166 K XMZ
167 Q
168BADREC ; If any records with missing data, send mail message
169 S OOPDA=0,OPI=0,STA=""
170 F S STA=$O(^TMP($J,"D",STA)) Q:STA="" K MSG S CTR=1 D
171 . F S OOPDA=$O(^TMP($J,"D",STA,OOPDA)) Q:OOPDA="" D
172 .. S MSG(CTR)="Case: "_$$GET1^DIQ(2260,OOPDA,.01)_" has missing required data or word processing fields that are",CTR=CTR+1
173 .. S MSG(CTR)="larger than DOL requirements. Please edit the case(s); and once completed,",CTR=CTR+1
174 .. S MSG(CTR)="the cases will be transmitted with the next scheduled transmission. ",CTR=CTR+1
175 .. F S OPI=$O(^TMP($J,"D",STA,OOPDA,OPI)) Q:OPI="" D
176 ... S MSG(CTR)=" >"_$G(^TMP($J,"D",STA,OOPDA,OPI)),CTR=CTR+1
177 .. S MSG(CTR)=$C(10),CTR=CTR+1
178 . I $D(MSG) D
179 .. S XMSUB="ASISTS Record(s) not transmitted for Station "_STA
180 .. S GRP="OOPS WCP"
181 .. I $$FIND1^DIC(3.8,"","AMX",GRP_" - "_STA) S GRP=GRP_" - "_STA
182 .. S XMY("G."_GRP)=""
183 .. S XMTEXT="MSG("
184 .. D ^XMD
185 Q
186SENTMSG ; Send message to OOPS WCP mail group with claims sent to AAC
187 N CNT,MSG,STA,STR,OOPDA
188 S (STA,OOPDA)=""
189 F S STA=$O(SMSG(STA)) Q:STA="" K MSG S CNT=1 D
190 . S MSG(CNT)="The following claims have been transmitted to the AAC:"
191 . S CNT=CNT+1
192 . F S OOPDA=$O(SMSG(STA,OOPDA)) Q:OOPDA="" D
193 .. S STR=^OOPS(2260,OOPDA,0)
194 .. S MSG(CNT)="> "_$P(STR,U)_" "_$P(STR,U,2),CNT=CNT+1
195 . S XMSUB="ASISTS Record(s) transmitted to AAC for Station "_STA
196 . S GRP="OOPS WCP"
197 . I $$FIND1^DIC(3.8,"","AMX",GRP_" - "_STA) S GRP=GRP_" - "_STA
198 . S XMY("G."_GRP)=""
199 . S XMTEXT="MSG("
200 . D ^XMD
201 Q
202ERROR ; Create appropriate Error message and Send message
203 S XMDUZ="ASISTS Package"
204 ; If no one in mail group (this should not occur), send to user
205 I $D(XMY)<9 S XMY(DUZ)=""
206 S XMSUB="ASISTS DOL Error Notification Message"
207 S XMTEXT="ERROR("
208 D ^XMD
209 I '$D(ZTQUEUED) D
210 . S MSG("DIHELP",1)="An Error Occurred during Processing, check"
211 . S MSG("DIHELP",2)="Mailman Message for details."
212 . D MSG^DIALOG("WH","","","","MSG")
213 K ERROR
214 Q
215ERROR2 ; Create appropriate Error message and Send message
216 S XMDUZ="ASISTS Package"
217 S GRP="OOPS WC MESSAGE"
218 D GRP^OOPSMBUL
219 ; If no one in mail group (this should not occur), send to user
220 I $D(XMY)<9 S XMY(DUZ)=""
221 S XMSUB="ASISTS DOL Error Notification Message"
222 S XMTEXT="ERROR("
223 D ^XMD
224 I '$D(ZTQUEUED) D
225 . S MSG("DIHELP",1)="An Error Occurred during Processing, check"
226 . S MSG("DIHELP",2)="Mailman Message for details."
227 . D MSG^DIALOG("WH","","","","MSG")
228 K ERROR
229 Q
Note: See TracBrowser for help on using the repository browser.