Changeset 623 for WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXTRAC.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXTRAC.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXTRAC.m
r613 r623 1 ECXTRAC ;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 ; 19 EN ;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 ; 72 QUE ;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 ; 99 NOIVP ;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 ; 106 START ; 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 ; 144 MSG ; 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 ; 162 QMSG ; 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 ; 176 QKILL ;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 ; 184 CHK2 ;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 193 EXIT K ^TMP($J,"ECXIV") 194 Q 195 ; 196 PAUSE ;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 1 ECXTRAC ;ALB/GTS,JAP,BIR/DMA,CML-Package Extracts for DSS ; 5/9/05 10:39am 2 ;;3.0;DSS EXTRACTS;**9,8,14,24,30,33,49,84**;Dec 22, 1997 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 ; 19 EN ;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 ; 72 QUE ;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 ; 99 NOIVP ;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 ; 106 START ; 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 ; 144 MSG ; 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 ; 162 QMSG ; 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 ; 176 QKILL ;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 ; 184 CHK2 ;iv extract check - all active iv rooms to have a division 185 S EC=0 186 F S EC=$O(^PS(59.5,EC)) Q:'EC I '$P(^PS(59.5,EC,0),U,4) D Q:CHKFLG 187 .S CHKFLG=$S('$G(^PS(59.5,EC,"I")):1,$G(^PS(59.5,EC,"I"))>DT:1,1:0) 188 .I CHKFLG D 189 ..W !!,"All active IV Rooms in the IV Room file (#59.5) must have a ""DIVISION""",!,"assigned to run this extract!" 190 ..W !!,"This information can be entered using the DSS Extract Manager's Maintenance ",!,"option ""Enter/Edit IV Room Division""." 191 ..D PAUSE 192 Q 193 ; 194 PAUSE ;pause screen 195 N DIR,X,Y 196 S OUT=0 197 I $E(IOST)="C" D 198 .S SS=22-$Y F JJ=1:1:SS W ! 199 .S DIR(0)="E" W ! D ^DIR K DIR 200 I 'Y S OUT=1 201 W !! 202 Q
Note:
See TracChangeset
for help on using the changeset viewer.
