source: WorldVistAEHR/trunk/r/ASISTS-OOPS/OOPSNDB.m@ 701

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

initial load of WorldVistAEHR

File size: 6.7 KB
Line 
1OOPSNDB ;WISC/LLH-NATIONAL DATABASE ;10/12/99
2 ;;2.0;ASISTS;;Jun 03, 2002
3 ;
4 N ARR,FIELD,FL,MAN,MSG,VAL,RDATE,OOPDA
5 S MAN=1
6 I '$D(^XUSEC("OOPS XMIT 2162 DATA",DUZ)) D G EXIT
7 . S DIR(0)="FO" W !
8 . S DIR("A")="You do NOT have the required Security Key."
9 . S DIR("A")=DIR("A")_" Press Enter to continue"
10 . D ^DIR K DIR
11 ; Assure the Queue (Q-ASI) has been defined
12 S VAL="Q-ASI.MED.VA.GOV",FIELD=.01,FL="X"
13 D FIND^DIC(4.2,"",FIELD,FL,VAL,"","","","","ARR")
14 I '$D(ARR("DILIST",1)) D G EXIT
15 . S DIR(0)="FO" W !
16 . S DIR("A")="Domain not found in the DOMAIN File,"
17 . S DIR("A")=DIR("A")_" No Transmission. Press Enter to continue"
18 . D ^DIR K DIR
19 S DIR(0)="D"
20 S DIR("A")="Re-transmit cases for what date "
21 S DIR("?",1)="Enter the date of original transmission for cases "
22 S DIR("?")="that need to be resent"
23 D ^DIR K DIR G:$D(DIRUT) EXIT I Y S RDATE=Y
24 S DIR(0)="Y",DIR("B")="Y",DIR("A")="Do you want to Queue Transmission"
25 S DIR("?",1)="Enter 'Y' if you want the 2162 data placed in mail"
26 S DIR("?")="messages as part of a tasked job."
27 D ^DIR K DIR G:$D(DIRUT) EXIT I Y D G EXIT
28 . S ZTRTN="EN^OOPSNDB",ZTIO=""
29 . S ZTDESC="TRAMSIT NATIONAL DATABASE 2162 DATA"
30 . D ^%ZTLOAD
31 S DIR(0)="Y"
32 S DIR("A")="Transmission NOT queued, OK to continue"
33 D ^DIR K DIR I 'Y G EXIT
34 S MSG("DIHELP",1)="Processing" W !
35 D MSG^DIALOG("WH","","","","MSG")
36EN ; Routine Entry
37 N CNT,ERR,ERROR,FAIL,OPMG,OPQ
38 K VMSG,INV ; used for data validation of records
39 S CTR=1 ; counter for Mail message array
40 S (START,END,FAIL)=""
41 ; Assure the Queue (Q-ASI) has been defined
42 S VAL="Q-ASI.MED.VA.GOV",FIELD=.01,FL="X"
43 D FIND^DIC(4.2,"",FIELD,FL,VAL,"","","","","ARR")
44 I '$D(ARR("DILIST",1)) D G EXIT
45 . S ERROR(1)="The Queue Q-ASI.MED.VA.GOV has not been created."
46 . S ERROR(2)="Install Patch XM*999*130, complete manual "
47 . S ERROR(3)="Transmission of NDB Data."
48 . D ERROR
49 ; Make sure Mail Group Exists
50 S OPMG=$$FIND1^DIC(3.8,"","X","OOPS NDB MESSAGES")
51 I 'OPMG D G EXIT
52 . S ERROR(1)="The Mail Group OOPS NDB MESSAGES is missing."
53 . S ERROR(2)="Add the Group so that ASISTS data can be transmitted "
54 . S ERROR(3)="to the AAC. Then contact IRM to complete manual "
55 . S ERROR(4)="Transmission of NDB Data."
56 . D ERROR
57 ; Get list of members
58 D LIST^DIC(3.81,","_OPMG_",","","",1,"","","","","","OPQ")
59 I '$P(OPQ("DILIST",0),U) D G EXIT
60 . S ERROR(1)="There are no members of the OOPS NDB MESSAGES "
61 . S ERROR(1)=ERROR(1)_"Mail Group."
62 . S ERROR(2)="Enter at least one member to the group. This person "
63 . S ERROR(3)="will receive messages concerning the transmission of "
64 . S ERROR(4)="ASISTS NDB data to and from the AAC. After adding member"
65 . S ERROR(5)="contact IRM to complete manual transmission of NDB data."
66 . D ERROR
67GETREC ; Loop thru ^OOP(2260 "AN" OR "ANC" Xref to get records to transmit
68 ; The logic for this data retrevial was changed for patch 11 to use
69 ; the Xrefs vs looping through the entire 2260 file.
70 N OOPIEN,PRSCNT,PRSDA,XMDUZ,XMTEXT,XMSUB,XMY,INDEX,INDEX2
71 N Y,%,%H,%I
72 K ^TMP($J,"C"),^TMP($J,"D")
73 S (CNT,PRSCNT,OOPDA)=0
74 D NOW^%DTC S DATE=%,Y=DATE X ^DD("DD")
75 S MTIME=$P(Y,"@",2),DATE=$$DC^OOPSNDBX(%)
76 S OOPIEN=""
77 I '$G(MAN) S INDEX="^OOPS(2260,""AN"",OPI)",INDEX2="^OOPS(2260,""AN"",OPI,OOPIEN)"
78 E S INDEX="^OOPS(2260,""ANC"",OPI)",INDEX2="^OOPS(2260,""ANC"",OPI,OOPIEN)"
79 S OPI=0 F S OPI=$O(@INDEX) Q:'OPI D
80 .S OOPIEN=0 F S OOPIEN=$O(@INDEX2) Q:'OOPIEN D
81 .. I $G(MAN),OPI'=RDATE Q
82 .. S VALID=""
83 .. F CHK=5:1:7 I '$$GET1^DIQ(2260,OOPIEN,CHK,"I") S:CHK=5 $P(VALID,U)=5 S:CHK=6 $P(VALID,U,2)=6 S:CHK=7 $P(VALID,U,3)=7
84 .. I $G(VALID)'="" S ^TMP($J,"D",OOPIEN)=VALID Q
85 .. S ^TMP($J,"C",OOPIEN)=""
86 .. S CNT=CNT+1
87 S ^TMP($J,"C")=CNT
88 ; Count # of Non-Separated PAID Employees
89 S PRSDA=0 D
90 . F S PRSDA=$O(^PRSPC(PRSDA)) Q:PRSDA'>0 D
91 .. I $$GET1^DIQ(450,PRSDA,80,"I")'="Y" S PRSCNT=PRSCNT+1
92NOCASES ; No Cases to Send - Send Mail Message with only NDB segment
93 I CNT=0 D G EXIT
94 . D CREATE Q:FAIL
95 . D SEND
96PROCESS ;
97 D CREATE G:FAIL EXIT
98 ; START - First case number in MM, End - Last Case # in MM
99 S OOPDA="",START="",END="",OPAST=""
100 F S OPAST=OOPDA,OOPDA=$O(^TMP($J,"C",OOPDA)) Q:OOPDA="" D
101 . D ^OOPSNDBX
102 . ; Set DATE TRANSMITTED TO NDB in ^OOPS(2260 records
103 . I $$GET1^DIQ(2260,OOPDA,57)="" D
104 .. K DR S DIE="^OOPS(2260,",(IEN,DA)=OOPDA,DR="57///TODAY" D ^DIE K DR,DA,DIE
105 ; If any records left to send and no FAILure
106 I ($G(XMZ)'<1)&('FAIL) D
107 . I END="" S END=$P($P(^OOPS(2260,OPAST,0),U),"-",2)
108 . D SEND
109 ;
110EXIT ; Quits the program
111 D BADREC ; Send Mail if any Bad Records
112 I $G(FAIL) D
113 . S ERROR(1)="Mail Message was not created. Contact IRM to comlete "
114 . S ERROR(2)="the manual transmission of ASISTS NDB data."
115 . D ERROR
116 K CTR,DATE,ERR,ERROR,GRP,INV,OPL,MSIZE,MTIME,XMSUB,XMTEXT,XMY,MSG
117 K ^TMP($J)
118 Q
119CREATE ; Create MailMan Message
120 N OPDATA,SN
121 S MSIZE=0
122 I $G(XMZ)'<1 D SEND
123 S OPL=0
124 S XMSUB="ASISTS NATIONAL DATABASE"
125 S XMDUZ=DUZ
126 D XMZ^XMA2 I XMZ<1 S FAIL=1 Q
127 S SN=$$GET1^DIQ(4,$P($G(^XMB(1,1,"XUS")),U,17),99)
128 S SN=$E("0000000",$L(SN)+1,7)_SN
129 S OPDATA="NDB^OOPS^"_SN_U_DATE_U_MTIME_U_^TMP($J,"C")
130 S OPDATA=OPDATA_U_U_PRSCNT_U_"002"_U_"|" ; chg 001 to 002 as ver 2
131 S OPL=OPL+1,^XMB(3.9,XMZ,2,OPL,0)=OPDATA
132 Q
133SEND ; Send MailMan Message
134 N NUMCASE
135 S ^XMB(3.9,XMZ,2,0)="^3.92A^"_OPL_U_OPL_U_DT
136 ; Set # of Cases in this Mail Message
137 S NUMCASE=$S(START'="":START_"-"_END,1:0)
138 S $P(^XMB(3.9,XMZ,2,1,0),U,7)=NUMCASE
139 ; Indicate last line of message
140 S OPL=OPL+1,^XMB(3.9,XMZ,2,OPL,0)="$"
141 S XMY(DUZ)="" ; also send here, in case of error.
142 S XMY("XXX@Q-ASI.MED.VA.GOV")=""
143 S XMCHAN=1 D ENT1^XMD K XMCHAN
144 K XMZ
145 Q
146BADREC ; If any records with missing data, send mail message
147 K MSG
148 S CTR=1,OOPDA=0
149 F S OOPDA=$O(^TMP($J,"D",OOPDA)) Q:OOPDA="" D
150 . S VALID=^TMP($J,"D",OOPDA)
151 . S MSG(CTR)="Case: "_$$GET1^DIQ(2260,OOPDA,.01)_" has missing data "
152 . S MSG(CTR)=MSG(CTR)_"that must be entered prior",CTR=CTR+1
153 . S MSG(CTR)="to transmitting to AAC. ",CTR=CTR+1
154 . I $P(VALID,U) S MSG(CTR)=" Missing SSN",CTR=CTR+1
155 . I $P(VALID,U,2) S MSG(CTR)=" Missing DOB",CTR=CTR+1
156 . I $P(VALID,U,3) S MSG(CTR)=" Missing SEX",CTR=CTR+1
157 I $D(MSG) D
158 . S XMSUB="ASISTS Records Missing Necessary Data Elements"
159 . S XMY("G.OOPS NDB MESSAGES@"_^XMB("NETNAME"))=""
160 . S XMTEXT="MSG("
161 . D ^XMD
162 Q
163ERROR ; Create appropriate Error message and Send message
164 S XMDUZ="ASISTS Package"
165 S GRP="OOPS SAFETY"
166 D GRP^OOPSMBUL
167 ; If no one in mail group (this should not occur), send to user
168 I $D(XMY)<9 S XMY(DUZ)=""
169 S XMSUB="ASISTS NDB Error Notification Message"
170 S XMTEXT="ERROR("
171 D ^XMD
172 I '$D(ZTQUEUED) D
173 . S MSG("DIHELP",1)="An Error Occurred during Processing, check"
174 . S MSG("DIHELP",2)="Mailman Message for details."
175 . D MSG^DIALOG("WH","","","","MSG")
176 K ERROR
177 Q
Note: See TracBrowser for help on using the repository browser.