source: WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXTRAC.m@ 619

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

initial load of WorldVistAEHR
File size: 7.5 KB
RevLine 
[613]1ECXTRAC ;ALB/GTS,JAP,BIR/DMA,CML-Package Extracts for DSS ; 7/29/07 12:51pm
2 ;;3.0;DSS EXTRACTS;**9,8,14,24,30,33,49,84,105**;Dec 22, 1997;Build 70
3 ;Date range, queuing and message sending for package extracts
4 ;Input
5 ; ECPACK printed name of package (e.g. Lab, Prescriptions)
6 ; ECNODE in file 728 where last date is stored
7 ; ECPIECE piece of node where last date is stored
8 ; ECRTN in the form of START^ROUTINE
9 ; ECGRP name of local mail group to receive summary message
10 ; (MUST BE 1 TO 5 UPPER CASE ALPHA - NO SPACES)
11 ; ECFILE file number of the local editing file
12 ; ECXLOGIC Fiscal year extract logic to use (optional)
13 ; ECXDATES StartDate^EndDate^DoNotUpdate728 (optional)
14 ;Generates
15 ; EC23=2nd and 3rd piece of zero node in local editing file
16 ; =YYMM of end date^pointer to 727
17 ; ECXLOGIC=Fiscal year extract logic to use
18 ;
19EN ;entry point
20 N OUT,CHKFLG
21 I '$D(ECNODE) S ECNODE=7
22 I '$D(ECHEAD) S ECHEAD=" "
23 I $P($G(^ECX(728,1,ECNODE+.1)),U,ECPIECE)]"" D Q
24 .W !!,$C(7),ECPACK," extract is already scheduled to run",!!
25 .D PAUSE
26 W @IOF,!,"Extract ",ECPACK," Information for DSS",!!
27 S:'$D(ECINST) ECINST=+$P(^ECX(728,1,0),U)
28 S ECXINST=ECINST
29 K ECXDIC S DA=ECINST,DIC="^DIC(4,",DIQ(0)="I",DIQ="ECXDIC",DR=".01;99"
30 D EN^DIQ1 S ECINST=$G(ECXDIC(4,DA,99,"I")) K DIC,DIQ,DA,DR,ECXDIC
31 ;* get last date for all extracts except prosthetics
32 I ECGRP'="PRO" D
33 .S ECLDT=$S($D(^ECX(728,1,ECNODE)):$P(^(ECNODE),U,ECPIECE),1:2610624)
34 .S:ECLDT="" ECLDT=2610624
35 ;* get last date for prosthetics
36 I ECGRP="PRO" D
37 .N ECXDA1
38 .S ECXDA1=$O(^ECX(728,0))
39 .I $D(^ECX(728,ECXDA1,1,ECXINST,0)) D
40 ..S ECLDT=$P(^ECX(728,ECXDA1,1,ECXINST,0),U,2)
41 .I '$D(^ECX(728,ECXDA1,1,ECXINST,0)) D
42 ..S DA(1)=ECXDA1
43 ..S DIC(0)="L" K ECXDD
44 ..D FIELD^DID(728,59,,"SPECIFIER","ECXDD")
45 ..S DIC("P")=ECXDD("SPECIFIER") K ECXDD
46 ..S DIC="^ECX(728,"_DA(1)_",1,",X=ECXINST,DINUM=X
47 ..K DD,DO D FILE^DICN
48 ..K DIC,X,DINUM,Y,DA
49 ..S ECLDT=2610624
50 S X=$G(ECXDATES) S ECSD=$P(X,"^",1),ECED=$P(X,"^",2)
51 S OUT=0
52 I (ECSD="")!(ECED="") F S (ECED,ECSD)="" D Q:OUT
53 .K %DT S %DT="AEX",%DT("A")="Starting with Date: " D ^%DT
54 .I Y<0 S OUT=1 Q
55 .S ECSD=Y
56 .K %DT S %DT="AEX",%DT("A")="Ending with Date: " D ^%DT
57 .I Y<0 S OUT=1 Q
58 .I Y<ECSD D Q
59 ..W !!,"The ending date cannot be earlier than the starting date."
60 ..W !,"Please try again.",!!
61 .I $E(Y,1,5)'=$E(ECSD,1,5) D Q
62 ..W !!,"Beginning and ending dates must be in the same month and year."
63 ..W !,"Please try again.",!!
64 .S ECED=Y
65 .I ECLDT'<ECSD D Q
66 ..W !!,"The ",ECPACK," information has already been extracted through ",$$FMTE^XLFDT(ECLDT),"."
67 ..W !,"Please enter a new date range.",!!
68 .S OUT=1
69 I ECED]"",ECSD]"" D QUE
70 Q
71 ;
72QUE ;queue extract
73 N CHKFLG
74 ;if extract is ivp (i.e., file=727.819) and data in the intermediate file use new format
75 I ECFILE=727.819 D Q:CHKFLG
76 .S CHKFLG=0
77 .S X="PSIVSTAT" X ^%ZOSF("TEST") I '$T Q
78 .I '$D(^ECX(728.113,"A")) S CHKFLG=1 D NOIVP Q
79 .S DATE=$O(^ECX(728.113,"A",ECED+1),-1) I DATE<ECSD S CHKFLG=1 D NOIVP Q
80 .D CHK^ECXDIVIV Q:CHKFLG
81 .D CHK2
82 .S ECRTN="START^ECXPIVDN",ECVER=7
83 I '$D(ECNODE) S ECNODE=7
84 I '$D(ECHEAD) S ECHEAD=""
85 S ECSDN=$$FMTE^XLFDT(ECSD),ECEDN=$$FMTE^XLFDT(ECED),ECSD1=ECSD-.1
86 K ZTSAVE
87 F X="ECINST","ECED","ECSD","ECSD1","ECEDN","ECSDN" S ZTSAVE(X)=""
88 F X="ECPACK","ECPIECE","ECRTN","ECGRP","ECNODE" S ZTSAVE(X)=""
89 F X="ECFILE","ECHEAD","ECVER","ECINST","ECXINST" S ZTSAVE(X)=""
90 F X="ECXLOGIC","ECXDATES" S ZTSAVE(X)=""
91 S ZTDESC=ECPACK_" EXTRACT: "_ECSDN_" TO "_ECEDN,ZTRTN="START^ECXTRAC",ZTIO=""
92 D ^%ZTLOAD
93 I $D(ZTSK) D
94 .S $P(^ECX(728,1,ECNODE+.1),U,ECPIECE)="R"
95 .W !,"Request queued as Task #",ZTSK,".",!
96 .D PAUSE
97 Q
98 ;
99NOIVP ;cannot generate ivp message
100 W !!,?5,"There does not appear to be any data in the IV EXTRACT DATA"
101 W !,?5,"file (#728.113) for the selected date range."
102 W !!,?5,"The IVP extract cannot be generated."
103 D PAUSE
104 Q
105 ;
106START ; entry when queued
107 S QFLG=0
108 L +^ECX(727,0) S EC=$P(^ECX(727,0),U,3)+1,$P(^(0),U,3,4)=EC_U_EC L -^ECX(727,0)
109 S ^ECX(727,EC,0)=EC_U_DT_U_ECPACK_U_ECSD_U_$E(ECED,1,7)_U_U_DUZ
110 S ^ECX(727,EC,"HEAD")=ECHEAD
111 S:ECFILE=727.816 ECFILE=727.827 S ^ECX(727,EC,"FILE")=ECFILE
112 S ^ECX(727,EC,"GRP")=ECGRP
113 I $G(ECXLOGIC)="" S ECXLOGIC=$$FISCAL^ECXUTL1(ECSD)
114 S ^ECX(727,EC,"VER")=$G(ECVER)_"^"_ECXLOGIC
115 S ^ECX(727,EC,"DIV")=ECXINST
116 S DA=EC,DIK="^ECX(727," D IX^DIK K DIK,DA
117 S ECRN=0,ECXYM=$$ECXYM^ECXUTL(ECED),EC23=ECXYM_U_EC
118 S ECXSTART=$P($$HTE^XLFDT($H),":",1,2),ECXNOW=$H
119 ;do specific extract
120 D @ECRTN
121 ;if task gets stop request, set ztstop and quit
122 I QFLG D Q
123 .S $P(^ECX(728,1,ECNODE+.1),U,ECPIECE)="",ZTSTOP=1
124 .D QKILL
125 .D QMSG
126 .D ^ECXKILL
127 ;Set last date for extract
128 I '$P($G(ECXDATES),"^",3) D
129 .;* set last date for all extracts except prosthetics
130 .I ECGRP'="PRO" S $P(^ECX(728,1,ECNODE),U,ECPIECE)=$P(ECED,".") Q
131 .;* set last date for prosthetics
132 .N ECXDA1
133 .S ECXDA1=$O(^ECX(728,0))
134 .S $P(^ECX(728,ECXDA1,1,ECXINST,0),U,2)=$P(ECED,".")
135 S TIME=$P($$HTE^XLFDT($H),":",1,2)
136 S $P(^ECX(727,$P(EC23,U,2),0),U,6)=ECRN
137 ;set piece 3 and 4 of the zero node
138 S ECLAST=$O(^ECX(ECFILE,99999999),-1),ECTOTAL=$P(^ECX(ECFILE,0),U,4)+ECRN,$P(^(0),U,3,4)=ECLAST_U_ECTOTAL K ECLAST,ECTOTAL
139 D MSG
140 S $P(^ECX(728,1,ECNODE+.1),U,ECPIECE)=""
141 I $D(ZTQUEUED) S ZTREQ="@"
142 Q
143 ;
144MSG ; send message to mail group 'DSS-ECGRP'
145 S XMSUB=ECINST_" - "_ECPACK_" EXTRACT FOR DSS",XMDUZ="DSS SYSTEM"
146 K XMY S XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))=""
147 S ECMSG(1,0)="The DSS-"_ECPACK_" extract (#"_$P(EC23,U,2)_") for "_ECSDN
148 S ECMSG(2,0)="through "_ECEDN_" was begun on "_$P(ECXSTART,"@")_" at "_$P(ECXSTART,"@",2)
149 S ECMSG(3,0)="and completed on "_$P(TIME,"@")_" at "_$P(TIME,"@",2)_"."
150 S ECMSG(4,0)=" "
151 S ECMSG(5,0)="A total of "_ECRN_" records were written."
152 S ECMSG(6,0)=" "
153 S ECMSG(7,0)="Extract time was [HH:MM:SS] "_$$HDIFF^XLFDT($H,ECXNOW,3)
154 S ECMSG(8,0)=" "
155 S X=$E(ECXLOGIC,5) S X=$S((X="")!(X=" "):"",1:"revision "_X_" of ")
156 S ECMSG(9,0)="The data was extracted using "_X_"fiscal year "_$E(ECXLOGIC,1,4)_" logic."
157 S ECMSG(10,0)=" "
158 S XMTEXT="ECMSG("
159 D ^XMD
160 Q
161 ;
162QMSG ; send abort message to mail group 'DSS-ECGRP'
163 S XMSUB=ECINST_" - "_ECPACK_" EXTRACT FOR DSS",XMDUZ="DSS SYSTEM"
164 K XMY S XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))=""
165 S ECMSG(1,0)="The DSS-"_ECPACK_" extract (#"_$P(EC23,U,2)_") for "_ECSDN
166 S ECMSG(2,0)="through "_ECEDN_" was begun on "_$P(ECXSTART,"@")_" at "_$P(ECXSTART,"@",2)_"."
167 S ECMSG(3,0)=" "
168 S ECMSG(4,0)="A user stop request was received by Taskmanager which caused processing"
169 S ECMSG(5,0)="to terminate before completion. Any records which may have been created"
170 S ECMSG(6,0)="in file #"_ECFILE_" for this extract have been deleted."
171 S ECMSG(7,0)=" "
172 S XMTEXT="ECMSG("
173 D ^XMD
174 Q
175 ;
176QKILL ;delete records created for any extract stopped at user request
177 N ECX,FILE,IEN,DA,DIK
178 S FILE="^ECX("_ECFILE_","
179 S ECX=$P(EC23,U,2)
180 F S IEN=$O(^ECX(ECFILE,999999999),-1) Q:($P(^ECX(ECFILE,IEN,0),U,3)'=ECX) D
181 .S DIK=FILE,DA=IEN D ^DIK
182 Q
183 ;
184CHK2 ;iv extract check - all active iv rooms to have a division
185 S EC=0
186 D ALL^PSJ59P5(,"??","ECXIV")
187 F S EC=$O(^TMP($J,"ECXIV",EC)) Q:'EC I '^(EC,19) D I CHKFLG D EXIT Q
188 .S CHKFLG=$S($G(^TMP($J,"ECXIV",EC,19)):1,$G(^(19))>DT:1,1:0)
189 .I CHKFLG D
190 ..W !!,"All active IV Rooms in the IV Room file (#59.5) must have a ""DIVISION""",!,"assigned to run this extract!"
191 ..W !!,"This information can be entered using the DSS Extract Manager's Maintenance ",!,"option ""Enter/Edit IV Room Division""."
192 ..D PAUSE
193EXIT K ^TMP($J,"ECXIV")
194 Q
195 ;
196PAUSE ;pause screen
197 N DIR,X,Y
198 S OUT=0
199 I $E(IOST)="C" D
200 .S SS=22-$Y F JJ=1:1:SS W !
201 .S DIR(0)="E" W ! D ^DIR K DIR
202 I 'Y S OUT=1
203 W !!
204 Q
Note: See TracBrowser for help on using the repository browser.