source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBJDE1.m@ 1742

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

initial load of FOIAVistA 6/30/08 version
File size: 8.8 KB
Line 
1IBJDE1 ;ALB/RB - DM DATA EXTRACTION (MENU OPTIONS/TRANSMIT E-MAIL) ;15-APR-99
2 ;;2.0;INTEGRATED BILLING;**100,118,123,159,254,244**;21-MAR-94
3 ;
4VPE ; - View/print entries in IB DM EXTRACT DATA file (#351.71).
5 I '$O(^IBE(351.71,0)) W !!,"There are no entries available.",*7 G ENQ
6 ;
7 S DIC="^IBE(351.71,",DIC(0)="AEMQZ",DIC("A")="Enter MONTH/YEAR: "
8 D ^DIC K DIC G:Y'>0 ENQ S IB0=+Y,IBS=$P(Y(0),U,2),IBDT=Y(0,0)
9 ;
10 S DIC="^IBE(351.71,",BY=.01,(FR,TO)=IB0,DHD="W ?0 D VPH^IBJDE1"
11 S FLDS="[IBJD DM V/P EXTRACTS]",L=0 D EN1^DIP W ! G VPE
12 ;
13VPH ; - Heading for View/Print option.
14 W "DIAGNOSTIC MEASURES SUMMARY EXTRACTIONS-",IBDT
15 W " (Status: ",$S(IBS=3:"COMPLETED",IBS=2:"STARTED",1:"ON STANDBY"),")"
16 W !!,"Summary Line Item",?58,"Total",! F X=1:1:80 W "-"
17 Q
18 ;
19DER ; - Disable/enable report(s) or extraction process.
20 W ! S DIR(0)="Y",DIR("B")="NO"
21 I $D(^IBE(351.7,"DISABLE")) D
22 .S DIR("A",1)="The DM extract background job has been disabled."
23 .S DIR("A")=" Do you want to re-enable it"
24 E S DIR("A")="Do you want to disable the DM extract background job"
25 D ^DIR K DIR G:Y["^" ENQ I 'Y G DE1
26 I $D(^IBE(351.7,"DISABLE")) K ^("DISABLE")
27 E S ^IBE(351.7,"DISABLE")=""
28 W " ...Done",*7
29 ;
30DE1 ; - List disabled reports, if any.
31 I $D(^IBE(351.7,"DISABLE")) G ENQ ; DM extract background job disabled.
32 ;
33 I $D(^IBE(351.7,"AC",1)) D
34 .W !!,"These DM reports have been disabled:",!! S X=0
35 .F S X=$O(^IBE(351.7,"AC",1,X)) Q:'X W ?3,$P($G(^IBE(351.7,X,0)),U),!
36 E W !!,"There are no disabled DM reports.",!
37 ;
38DE2 S DIR(0)="PO^351.7:AEMQZ",DIR("A")="Enter REPORT NAME"
39 S DIR("?")="^D DEH^IBJDE1" D ^DIR K DIR I Y'>0 G ENQ
40 S IB0=+Y,IBFL=$P(Y(0),U,2) W !!,Y(0,0),!
41 ;
42 S DIR("A")="Do you want to "_$S(IBFL:"re-en",1:"dis")_"able this report"
43 S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR I Y["^"!('Y) W ! G DE2
44 S DIE="^IBE(351.7,",DR=".02///"_$S('IBFL&(Y):1,1:"@"),DA=IB0
45 D ^DIE K DA,DIE,DR W " ...Done",*7 G DE1
46 ;
47DEH ; - Help message for disable/enable option.
48 W !,"Enter the name of the report you want disabled or re-enabled."
49 W !,"If the report you enter is disabled, the monthly DM extraction"
50 W !,"process will not collect summary data from the report until you"
51 W !,"re-enable it again."
52 Q
53 ;
54RTN ; - Help message for the field ROUTINE (entry point for the reprot)
55 W !?9,"Enter the entry point for this report. You may enter a program"
56 W !?9,"name (^ROUTINE), or a specific label of a program (TAG^ROUTINE)"
57 W !?9,"or you may also leave it blank.",!
58 W !?9,"Obs: If this field is left blank, it means that the code respon-"
59 W !?9," sible for extracting the data will be invoked by another"
60 W !?9," report.",!
61 Q
62 ;
63MAN1 ; - Manually start DM extraction process.
64 I $D(^IBE(351.7,"DISABLE")) D G ENQ
65 .W !!,"The DM extract process has been disabled.",!,*7
66 S (IBX,X)=0
67 F S X=$O(^IBE(351.71,X)) Q:'X I $P(^(X,0),U,2)'=3 S IBX=IBX+1
68 I 'IBX W !,"All DM extracts on file have been transmitted.",!,*7 G ENQ
69 ;
70M1A S DIC="^IBE(351.71,",DIC(0)="AEMQZ",DIC("A")="Enter DM extract date: "
71 S DIC("S")="I $P(^(0),U,2)'=3" W ! D ^DIC K DIC I Y'>0 G ENQ
72 S IBDT=+Y,IBN=Y(0),IBDT1=$$M1^IBJDE(IBDT,3),IBST=$P(IBN,U,2)
73 S DIR("A")="Do you want to start the DM extract process for "_IBDT1
74 S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR I 'Y G ENQ
75 I IBST=2 D G:'Y ENQ
76 .S DIR(0)="Y",DIR("B")="NO",IBS=$$M1^IBJDE($P(IBN,U,3),3)
77 .S DIR("A",1)="The extract process for "_IBDT1_" began on "_IBS_"."
78 .S DIR("A")="Do you want to restart it" W ! D ^DIR K DIR
79 ;
80 D BJ^IBJDE ; Start DM extraction background job.
81 S IBS=$$M1^IBJDE($P($G(^IBE(351.71,IBDT,0)),U,3),3)
82 W !!,"Extract process started on ",IBS,".",*7 S IBX=IBX-1
83 I IBX D G:Y M1A
84 .S DIR("A")="Do you want to start the process for another date"
85 .S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR
86 ;
87 G ENQ
88 ;
89MAN2 ; - Manually transmit DM extract file.
90 I $D(^IBE(351.7,"DISABLE")) D G ENQ
91 .W !!,"The DM extract process has been disabled.",!,*7
92 S (IBX,X)=0
93 F S X=$O(^IBE(351.71,X)) Q:'X I $P(^(X,0),U,2)=3 S IBX=IBX+1
94 I 'IBX D G ENQ
95 .W !,"All DM extracts on file have NOT been completed.",!,*7
96 ;
97M2A S DIC="^IBE(351.71,",DIC(0)="AEMQZ",DIC("A")="Enter DM extract date: "
98 S DIC("S")="I $P(^(0),U,2)=3" W ! D ^DIC K DIC I Y'>0 G ENQ
99 S IBDT=+Y,IBN=Y(0),DIR(0)="Y",DIR("B")="NO"
100 S DIR("A")="Are you sure you want to transmit for "_$$M1^IBJDE(IBDT,3)
101 D ^DIR K DIR I 'Y G M2A
102M2B S $P(^IBE(351.71,IBDT,0),U,5)="" D XM(IBDT)
103 I $G(XMZ) W " Done."
104 E D G:Y M2B
105 .S DIR(0)="Y",DIR("B")="NO"
106 .S DIR("A")="The DM extract message failed to transmit...try again"
107 .W !,*7 D ^DIR K DIR
108 ;
109 I IBX D G:Y M2A
110 .S DIR("A")="Do you want to start the process for another date"
111 .S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR I Y S IBX=IBX-1
112 ;
113 G ENQ
114 ;
115MSG ; - DM extract reports message (shown when DM Menu is called up).
116 S IBDT=$$M1^IBJDE(DT,1),IBDT1=$$M1^IBJDE(IBDT,3)
117 I '$D(^IBE(351.71,IBDT,0)) G ENQ ; No extract data for this month yet.
118 ;
119 W @IOF S IBN=$G(^IBE(351.71,IBDT,0)),IBST=$P(IBN,U,2) I 'IBST G ENQ
120 I IBST=1 D G MSQ
121 .W !,"The DM extract process for ",IBDT1," was initiated on "
122 .W $$M1^IBJDE($P(IBN,U,3),3),!,"but it hasn't run yet.",!
123 ;
124 I IBST=3 D G ENQ
125 .W !,"The DM report data for ",IBDT1," has been successfully"
126 .W !,"extracted on ",$$M1^IBJDE($P(IBN,U,4),3),". This data has been"
127 .W !,"sent to the Central Collections mail group in FORUM.",*7
128 ;
129 S DIC="^IBE(351.71,",BY="[IBJD DM REPT SORT]",FR=IBDT_",1",TO=IBDT_",2"
130 S DIOEND="I $Y'<(IOSL-14) R X:DTIME",(IOP,L)=0
131 S DHD="W ?0 D MSH^IBJDE1",FLDS="[IBJD DM REPT PRINT]" D EN1^DIP
132 ;
133MSQ W !,"If you want, you can restart the DM extract process"
134 W !,"by using the ""Manually Start DM Extraction"" option in"
135 W !,"the Diagnostic Measures Extract Menu."
136 G ENQ
137 ;
138MSH ; - DM extract reports message header.
139 W !,"Data for the following DM reports have not been extracted"
140 W !," for ",IBDT1,":",!!,*7
141 Q
142 ;
143CHK ; - Check file #351.71 for completed and/or transmitted DM extracts
144 ; (shown when DM Extract Menu is called up).
145 W @IOF,!,"Checking for completed and/or transmitted DM extracts"
146 K IBX,IBX1 S (IBX,IBX1,IB0)=0
147 S DT=$$DT^XLFDT
148 F S IB0=$O(^IBE(351.71,IB0)) Q:'IB0 S IBN=$G(^(IB0,0)) D
149 .; - Do not process for invalid (day not equal 00 or future) dates
150 .; and remove data.
151 .I (+$E(IB0,6,7)>0)!(IB0>DT) D Q
152 ..W !,"** Invalid date entry found. Entry ("_IB0_") deleted.**",!
153 ..S DIK="^IBE(351.71,",DA=IB0
154 ..D ^DIK
155 .; - Check for missing zero node.
156 .I IBN="" W !,"Zero node data missing for "_IB0_" entry. Data corruption possible.",! Q
157 .; - Check for past months missing from file, if any.
158 .I $O(^IBE(351.71,IB0)) D
159 ..S IB1=$P(^IBE(351.71,0),U,4),IB2=IB0+$S($E(IB0,4,5)=12:8900,1:100)
160 ..I $D(^IBE(351.71,"B",IB2,IB2))!(IB2>DT) Q
161 ..S DIC="^IBE(351.71,",DIC(0)="L",DIC("DR")=".02///1",(DINUM,X)=IB2
162 ..K DD,DO D FILE^DICN S $P(^IBE(351.71,0),U,4)=IB1+1 K DIC,DINUM,DD,DO
163 .;
164 .I $P(IBN,U,2)'=3 S IBX(IB0)="" S:'IBX IBX=1 Q
165 .E I '$P(IBN,U,5) S IBX1(IB0)="" S:'IBX1 IBX1=1 Q
166 .W "."
167 ;
168 I 'IBX,'IBX1 W "Done" G ENQ
169 I IBX D
170 .W !!,"DM data has NOT been fully extracted for these months:",!,*7
171 .S IB0=0 F S IB0=$O(IBX(IB0)) Q:'IB0 W " ",$$M1^IBJDE(IB0,3)
172 .W !,"If you want, you can start the DM extract process for these"
173 .W !,"months by using the ""Manually Start DM Extraction"" option."
174 ;
175 I IBX1 D
176 .W !!,"DM data has NOT been transmitted for these months:",!,*7
177 .S IB0=0 F S IB0=$O(IBX1(IB0)) Q:'IB0 W " ",$$M1^IBJDE(IB0,3)
178 .W !,"If you want, you can transmit the DM extract data for these"
179 .W !,"months by using the ""Manually Transmit DM Extract"" option."
180 ;
181 G ENQ
182 ;
183XM(IBDT) ; - Create/transmit DM extract file message.
184 ;
185 N DA,DIE,DR,IB0,IB1,IBC,IBDT1,IBMG,IBSTE,X,XMDUZ,XMSUB,XMTEXT
186 ;
187 K ^TMP("DME",$J) S IBSTE=$$SITE^VASITE,X=$E(DT,4,7)_(1700+$E(DT,1,3))
188 S ^TMP("DME",$J,1)="HDR^"_$P(IBSTE,U,3)_U_$P(IBSTE,U,2)_U_X
189 S IBC=1,IB0=0
190 F S IB0=$O(^IBE(351.71,IBDT,1,IB0)) Q:'IB0 D
191 .Q:IB0=37 ; No unbilled report needed
192 .S X=$S(IB0=8:$$M2^IBJDE(IBDT,5,3,1),1:$$M1^IBJDE(IBDT,2))
193 .S IBC=IBC+1,^TMP("DME",$J,IBC)="DAT~"_IB0_"~"_$P(X,U)_"~"_$P(X,U,2)
194 .S IB1=0 F S IB1=$O(^IBE(351.71,IBDT,1,IB0,1,IB1)) Q:'IB1 D
195 ..S X=$P($G(^IBE(351.71,IBDT,1,IB0,1,IB1,0)),U,2)
196 ..S ^TMP("DME",$J,IBC)=^TMP("DME",$J,IBC)_U_X
197 ;
198 S ^TMP("DME",$J,IBC+1)="END^"_$P(IBSTE,U,3),IBDT1=$$M1^IBJDE(IBDT,3)
199 S XMSUB="DIAG. MEASURES EXTRACT FILE-"_IBDT1_" ("_$P(IBSTE,U,2)_")"
200 ;
201 S IBMG=$P($G(^IBE(350.9,1,4)),U,5) I IBMG="" G ENQ:'$G(IBX),ENQ1
202 ;
203 S XMDUZ="INTEGRATED BILLING PACKAGE"
204 S XMTEXT="^TMP(""DME"",$J,",XMY(IBMG)=""
205 D SEND
206 I $G(XMZ) S DIE="^IBE(351.71,",DA=IBDT,DR=".05///1;.06///"_XMZ D ^DIE
207 ;
208 I $G(IBX) G ENQ1 ; Return to DME manual transmit option.
209 ;
210ENQ K IB2,IBDT2,IBD1,IBD2,IBDT,IBFL,IBFR,IBN,IBS,IBST,IBST1,IBX,IBX1,BY,DHD
211 K DIC,DIOEND,FLDS,FR,IOP,L,TO,X,XMZ,Y,%
212ENQ1 K IB0,IB1,IBC,IBDT1,IBMG,IBSTE,XMSUB,XMTEXT,XMY,^TMP("DME",$J)
213 Q
214 ;
215SEND ; Calls ^XMD to send the mail message with the data extracted
216 ; Obs: By NEWing DUZ, ^XMD will assume DUZ=.5 (Sender=POSTMASTER)
217 ;
218 N DUZ D ^XMD
219 Q
Note: See TracBrowser for help on using the repository browser.