source: FOIAVistA/trunk/r/DSS_EXTRACTS-ECX/ECXDEFIN.m@ 1801

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

initial load of FOIAVistA 6/30/08 version
File size: 6.3 KB
Line 
1ECXDEFIN ;ALB/JAP,BIR/DMA-Define Extract Formats for Auto Queuing ; 17 Mar 95 / 9:55 AM
2 ;;3.0;DSS EXTRACTS;**24**;Dec 22, 1997
3EN ;entry point from option
4 N OUT,DIC,DIR,DIQ,DIRUT,DTOUT,DUOUT,DA,DR,X,Y,J,JJ
5 D MES^XPDUTL(" ")
6 D MES^XPDUTL("This option allows you to queue the generation of a specific DSS extract.")
7 D MES^XPDUTL("The extract will then be automatically requeued to run next month and")
8 D MES^XPDUTL("each subsequent month until the end of the fiscal year. It will be")
9 D MES^XPDUTL("requeued to run on the same day of each month at the same time of day.")
10 D MES^XPDUTL(" ")
11 S DIC="727.1",DIC(0)="AEQLMZ",ECF=0 D ^DIC
12 Q:Y<0 Q:$D(DTOUT) Q:$D(DUOUT)
13 S (DA,ECDA)=+Y,ECDATA=Y(0),ECROU=^ECX(727.1,ECDA,"ROU"),X="SETUP^"_ECROU D @X
14 I '$D(ECNODE) S ECNODE=7
15 ;don't allow setup if more than 1 primary prosthetics division
16 I ECGRP="PRO" D Q:OUT>1
17 .S OUT=0,J=0
18 .S ECXDA1=$O(^ECX(728,0))
19 .F S J=$O(^ECX(728,ECXDA1,1,J)) Q:'J I $D(^ECX(728,ECXDA1,1,J,0)) S OUT=OUT+1
20 .I OUT>1 D
21 ..D MES^XPDUTL(" ")
22 ..D MES^XPDUTL("This DSS site is responsible for Prosthetics data from")
23 ..D MES^XPDUTL("more than one Primary Prosthetics Division. Therefore,")
24 ..D MES^XPDUTL("the PRO extract may not be setup for automatic requeue.")
25 ..D MES^XPDUTL(" ")
26 ..D MES^XPDUTL("Please use the Prosthetics Extract option on the Package")
27 ..D MES^XPDUTL("Extracts menu to generate the monthly PRO extract for each")
28 ..D MES^XPDUTL("Primary Prosthetics Division. Exiting...")
29 ..D MES^XPDUTL(" ")
30 .I $E(IOST)="C" D
31 ..S SS=22-$Y F JJ=1:1:SS W !
32 ..S DIR(0)="E" W ! D ^DIR K DIR
33 ;don't allow setup if extract has never been run or if 1st extract of fiscal year
34 I ECGRP'="PRO" D
35 .S ECLDT=$P($G(^ECX(728,1,ECNODE)),U,ECPIECE)
36 I ECGRP="PRO" D
37 .S ECLDT=""
38 .S ECXDA1=$O(^ECX(728,0))
39 .I $D(^ECX(728,ECXDA1,1,ECXINST,0)) S ECLDT=$P(^ECX(728,ECXDA1,1,ECXINST,0),U,2)
40 I ECLDT="" D MSG Q
41 S X=$$CYFY^ECXUTL1(DT)
42 I ECLDT=$$FMADD^XLFDT($P(X,U,3),-1) D MSG Q
43 ;check if extract already queued to run
44 I $P(ECDATA,"^",6) D Q
45 .F J=1:1 S X=$P($T(WARN+J),";",3,300) Q:X="QUIT" W !,?5,X
46 .S DIR(0)="YA",DIR("A")="Do you wish to proceed? ",DIR("B")="N" K DIRUT,DUOUT,DTOUT
47 .D ^DIR K DIR
48 .I Y D QUEUE
49 D QUEUE
50 Q
51 ;
52QUEUE ;queue thru taskmanager
53 N ZTIO,ZTRTN,ZTDESC,ZTDTH,OUT,MONTH
54 D MES^XPDUTL(" ")
55 S OUT=0
56 F D Q:OUT
57 .D MES^XPDUTL(" ")
58 .S %DT="AEXR",%DT(0)=$$NOW^XLFDT+.0002,%DT("A")="Queue to run at what date/time? "
59 .D ^%DT K %DT
60 .S ECD=Y
61 .I ECD<0 S OUT=1
62 .I $E(ECD,6,7)>28 D Q
63 ..D MES^XPDUTL(" ")
64 ..D MES^XPDUTL("Monthly extracts must be queued for a date not greater than the 28th.")
65 ..D MES^XPDUTL(" ")
66 .S OUT=1
67 I ECD>DT D
68 .S:'$D(ECINST) ECINST=+$P(^ECX(728,1,0),U)
69 .S ECXINST=ECINST
70 .K ECXDIC S DA=ECINST,DIC="^DIC(4,",DIQ(0)="I",DIQ="ECXDIC",DR=".01;99"
71 .D EN^DIQ1 S ECINST=$G(ECXDIC(4,DA,99,"I")) K DIC,DIQ,DA,DR,ECXDIC
72 .;get last date for all extracts except prosthetics
73 .I ECGRP'="PRO" D
74 ..S ECLDT=$S($D(^ECX(728,1,ECNODE)):$P(^(ECNODE),U,ECPIECE),1:2610624)
75 .;get last date for prosthetics
76 .I ECGRP="PRO" D
77 ..S ECLDT=""
78 ..S ECXDA1=$O(^ECX(728,0))
79 ..I $D(^ECX(728,ECXDA1,1,ECXINST,0)) S ECLDT=$P(^ECX(728,ECXDA1,1,ECXINST,0),U,2)
80 .;ecldt should be valid so continue
81 .I ECLDT D Q:'$G(Y) Q:$D(DIRUT)
82 ..S ECFDT=$$LASTMON(ECD)
83 ..;change to 1st day of month
84 ..S $E(ECFDT,6,7)="01"
85 ..S ECDIF=$$FMDIFF^XLFDT(ECFDT,ECLDT)
86 ..Q:ECDIF=1
87 ..S Y=$E(ECFDT,1,5)_"00" D DD^%DT S MONTH=Y K Y
88 ..D MES^XPDUTL(" ")
89 ..D MES^XPDUTL("The last date for the "_ECHEAD_" extract was "_$$FMTE^XLFDT(ECLDT)_".")
90 ..D MES^XPDUTL(" ")
91 ..D MES^XPDUTL("When the extract is run using the queue date/time you supplied, data")
92 ..D MES^XPDUTL("for the month of "_MONTH_" will be extracted.")
93 ..D MES^XPDUTL(" ")
94 ..I ECDIF>1 D MES^XPDUTL("It appears that there is a period of time for which data will not be extracted.")
95 ..I ECDIF<0 D MES^XPDUTL("It appears that you may be duplicating previously extracted data.")
96 ..D MES^XPDUTL(" ")
97 ..S DIR(0)="YA",DIR("A")="Do you wish to proceed? ",DIR("B")="N" K DIRUT,DUOUT,DTOUT
98 ..D ^DIR K DIR
99 .S ZTRTN="QUE^"_ECROU,ZTDESC=ECPACK_" EXTRACT",ZTIO="",ZTDTH=ECD
100 .D ^%ZTLOAD
101 .I $G(ZTSK) D
102 ..S $P(^ECX(727.1,ECDA,0),"^",6)=1
103 ..D MES^XPDUTL(" ")
104 ..D MES^XPDUTL("Request queued as Task #"_ZTSK)
105 ..D MES^XPDUTL("with automatic monthly requeue.")
106 ..D MES^XPDUTL(" ")
107 ..I $E(IOST)="C" D
108 ...S SS=22-$Y F JJ=1:1:SS W !
109 ...S DIR(0)="E" W ! D ^DIR K DIR
110 K ECD,ECDA,ECDATA,ECDIF,ECF,ECFDT,ECFILE,ECGRP,ECHEAD,ECLDT,ECPIECE,ECPACK,ECROU,ECINST,ECNODE,ECXDA1,ECXINST
111 Q
112 ;
113WARN ;
114 ;;
115 ;;It appears that the extract has already been queued to run. If you make
116 ;;changes now, there is a possibility that data for a particular date range
117 ;;may be omitted from the extract process and not transmitted to AAC.
118 ;;
119 ;;Before continuing, you should carefully review the extract history for
120 ;;this extract. You should also verify that this extract is not currently
121 ;;queued to run in the future.
122 ;;
123 ;;QUIT
124 ;
125MSG ;
126 D MES^XPDUTL(" ")
127 I ECLDT="" D
128 .D MES^XPDUTL("Automatic requeue may not be setup for a DSS extract")
129 .D MES^XPDUTL("which has never been previously generated.")
130 I ECLDT D
131 .D MES^XPDUTL("Automatic requeue may not be setup to generate the October")
132 .D MES^XPDUTL("extract of the current fiscal year.")
133 D MES^XPDUTL(" ")
134 D MES^XPDUTL("Please use the appropriate option on the Package Extracts")
135 D MES^XPDUTL("menu to generate the first monthly "_ECHEAD_" extract of")
136 D MES^XPDUTL("the current fiscal year. Exiting...")
137 D MES^XPDUTL(" ")
138 I $E(IOST)="C" D
139 .S SS=22-$Y F JJ=1:1:SS W !
140 .S DIR(0)="E" W ! D ^DIR K DIR
141 Q
142 ;
143NEXTMON(ECXDATE) ;get date for date+(1 month)
144 ;input ECXDATE = FM date or date/time [required]
145 ; where day of month is cannot be greater than 28
146 ;output returns FM date or date/time; next month, but same day of month
147 N DATE,ECXNEXT,X1,X2,X
148 S DATE=$P(ECXDATE,".")
149 I +$E(DATE,6,7)>28 S $E(DATE,6,7)="28"
150 S X1=DATE,X2=30 D C^%DTC
151 S ECXNEXT=X
152 I $E(ECXNEXT,6,7)'=$E(ECXDATE,6,7) S $E(ECXNEXT,6,7)=$E(ECXDATE,6,7)
153 I $P(ECXDATE,".",2) S $P(ECXNEXT,".",2)=$P(ECXDATE,".",2)
154 Q ECXNEXT
155 ;
156LASTMON(ECXDATE) ;get last day of previous month
157 ;input ECXDATE = FM date or date/time [required]
158 ;output returns FM date; previous month, last day of month
159 N DATE,ECXLAST,X1,X2,X
160 S DATE=$P(ECXDATE,"."),DATE=$E(DATE,1,5)_"01"
161 S X1=DATE,X2=-1 D C^%DTC
162 S ECXLAST=X
163 Q ECXLAST
Note: See TracBrowser for help on using the repository browser.