ECXFTRAN ;BIR/DMA-Extract from Local Editing Files and Write to Host File ; 17 Mar 95 / 1:02 PM
;;3.0;DSS EXTRACTS;;Dec 22, 1997
;
S ECRE="",DIC=727,DIC(0)="AEQM",DIC("A")="File transfer which extract ",DIC("S")="I '$D(^(""L"")),'$D(^(""PURG""))" D ^DIC K DIC G END:Y<0
I $G(^ECX(727,+Y,"PURG")) W !,"Data for this extract was purged on ",$E(^("PURG"),4,5),"/",$E(^("PURG"),6,7),"/",$E(^("PURG"),2,3) G ECXFTRAN
S ECDA=+Y I $G(^ECX(727,ECDA,"TR")) W !,"This extract was transfered on ",$E(^("TR"),4,5),"/",$E(^("TR"),6,7),"/",$E(^("TR"),2,3) S DIR(0)="Y",DIR("A")="Do you want to transfer again "
D ^DIR K DIR G ECXFTRAN:'Y K ^ECX(727,ECDA,"TR") S ECRE="re"
S ZTSK=$G(^ECX(727,ECDA,"Q")) I ZTSK D STAT^%ZTLOAD I ZTSK(0) I ZTSK(1)<3 W !!,"Task ",ZTSK," is already queued to transmit this extract",!! K ZTSK G ECXFTRAN
S ZTIO=""
QUE S ZTSAVE("ECDA")="",ZTSAVE("ECRE")="",ZTRTN="START^ECXFTRAN",ZTDESC="Transmission of extract # "_ECDA D ^%ZTLOAD
SET I $D(ZTSK) W !,"Request queued as Task #",ZTSK,".",! S ^ECX(727,ECDA,"Q")=ZTSK K ZTSK
END K ECDA,ECRE,X,Y Q
;
START ; entry point
S ECINST=+$P(^ECX(728,1,0),"^") K ECXDIC S DA=ECINST,DIC="^DIC(4,",DIQ(0)="I",DIQ="ECXDIC",DR=".01;99"
D EN^DIQ1 S ECINST=$G(ECXDIC(4,DA,99,"I")) K DIC,DIQ,DA,DR,ECXDIC
S ECF=^ECX(727,ECDA,"FILE"),ECHEAD=^("HEAD"),ECGRP=^("GRP"),ECED=$P(^(0),"^",5),ECPACK=$P(^(0),"^",3)
K ^TMP($J) S ECHD(1)=ECINST_ECHEAD_$$ECXYM^ECXUTL(ECED),ECRN=0
S ECFILE=ECHEAD_ECDA_".DAT"
S %ZIS=0,IOP="DSS FILE DEVICE",%ZIS("HFSNAME")=ECFILE D ^%ZIS
U IO
W ECHD(1),!
F J=0:0 S J=$O(^ECX(ECF,"AC",ECDA,J)) Q:'J I $D(^ECX(ECF,J,0)) W $P(^(0),"^",4,100)_"^~",! S ECRN=ECRN+1 I ECRN>499,'(ECRN#500) I $$S^%ZTLOAD Q
I $$S^%ZTLOAD G CLEAN
;
S TIME=$P($$HTE^XLFDT($H),":",1,2)
MSG ; send message to mail group 'DSS-ECGRP'
S XMSUB=ECINST_" - "_ECPACK_" EXTRACT FOR DSS",XMDUZ="DSS SYSTEM"
K XMY S XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))=""
S ^TMP($J,"LOC",1,0)="The DSS "_ECPACK_" extract (#"_ECDA_") was "_ECRE_"transfered on "_$P(TIME,"@")_" at "_$P(TIME,"@",2)_". ",^TMP($J,"LOC",3,0)=" ",^TMP($J,"LOC",4,0)="A total of "_ECRN_" records were written."
S ^TMP($J,"LOC",5,0)="File name "_ECFILE,^TMP($J,"LOC",6,0)=" "
S XMTEXT="^TMP($J,""LOC""," D ^XMD S ^ECX(727,ECDA,"TR")=DT
CLEAN ;
S ZTREQ="@" K ^TMP($J),^ECX(727,ECDA,"Q") D ^%ZISC,^ECXKILL
I $$S^%ZTLOAD K ZTREQ S ZTSTOP=1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXFTRAN 2396 printed Apr 09, 2024@20:57:24 Page 2
ECXFTRAN ;BIR/DMA-Extract from Local Editing Files and Write to Host File ; 17 Mar 95 / 1:02 PM
+1 ;;3.0;DSS EXTRACTS;;Dec 22, 1997
+2 ;
+3 SET ECRE=""
SET DIC=727
SET DIC(0)="AEQM"
SET DIC("A")="File transfer which extract "
SET DIC("S")="I '$D(^(""L"")),'$D(^(""PURG""))"
DO ^DIC
KILL DIC
if Y<0
GOTO END
+4 IF $GET(^ECX(727,+Y,"PURG"))
WRITE !,"Data for this extract was purged on ",$EXTRACT(^("PURG"),4,5),"/",$EXTRACT(^("PURG"),6,7),"/",$EXTRACT(^("PURG"),2,3)
GOTO ECXFTRAN
+5 SET ECDA=+Y
IF $GET(^ECX(727,ECDA,"TR"))
WRITE !,"This extract was transfered on ",$EXTRACT(^("TR"),4,5),"/",$EXTRACT(^("TR"),6,7),"/",$EXTRACT(^("TR"),2,3)
SET DIR(0)="Y"
SET DIR("A")="Do you want to transfer again "
+6 DO ^DIR
KILL DIR
if 'Y
GOTO ECXFTRAN
KILL ^ECX(727,ECDA,"TR")
SET ECRE="re"
+7 SET ZTSK=$GET(^ECX(727,ECDA,"Q"))
IF ZTSK
DO STAT^%ZTLOAD
IF ZTSK(0)
IF ZTSK(1)<3
WRITE !!,"Task ",ZTSK," is already queued to transmit this extract",!!
KILL ZTSK
GOTO ECXFTRAN
+8 SET ZTIO=""
QUE SET ZTSAVE("ECDA")=""
SET ZTSAVE("ECRE")=""
SET ZTRTN="START^ECXFTRAN"
SET ZTDESC="Transmission of extract # "_ECDA
DO ^%ZTLOAD
SET IF $DATA(ZTSK)
WRITE !,"Request queued as Task #",ZTSK,".",!
SET ^ECX(727,ECDA,"Q")=ZTSK
KILL ZTSK
END KILL ECDA,ECRE,X,Y
QUIT
+1 ;
START ; entry point
+1 SET ECINST=+$PIECE(^ECX(728,1,0),"^")
KILL ECXDIC
SET DA=ECINST
SET DIC="^DIC(4,"
SET DIQ(0)="I"
SET DIQ="ECXDIC"
SET DR=".01;99"
+2 DO EN^DIQ1
SET ECINST=$GET(ECXDIC(4,DA,99,"I"))
KILL DIC,DIQ,DA,DR,ECXDIC
+3 SET ECF=^ECX(727,ECDA,"FILE")
SET ECHEAD=^("HEAD")
SET ECGRP=^("GRP")
SET ECED=$PIECE(^(0),"^",5)
SET ECPACK=$PIECE(^(0),"^",3)
+4 KILL ^TMP($JOB)
SET ECHD(1)=ECINST_ECHEAD_$$ECXYM^ECXUTL(ECED)
SET ECRN=0
+5 SET ECFILE=ECHEAD_ECDA_".DAT"
+6 SET %ZIS=0
SET IOP="DSS FILE DEVICE"
SET %ZIS("HFSNAME")=ECFILE
DO ^%ZIS
+7 USE IO
+8 WRITE ECHD(1),!
+9 FOR J=0:0
SET J=$ORDER(^ECX(ECF,"AC",ECDA,J))
if 'J
QUIT
IF $DATA(^ECX(ECF,J,0))
WRITE $PIECE(^(0),"^",4,100)_"^~",!
SET ECRN=ECRN+1
IF ECRN>499
IF '(ECRN#500)
IF $$S^%ZTLOAD
QUIT
+10 IF $$S^%ZTLOAD
GOTO CLEAN
+11 ;
+12 SET TIME=$PIECE($$HTE^XLFDT($HOROLOG),":",1,2)
MSG ; send message to mail group 'DSS-ECGRP'
+1 SET XMSUB=ECINST_" - "_ECPACK_" EXTRACT FOR DSS"
SET XMDUZ="DSS SYSTEM"
+2 KILL XMY
SET XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))=""
+3 SET ^TMP($JOB,"LOC",1,0)="The DSS "_ECPACK_" extract (#"_ECDA_") was "_ECRE_"transfered on "_$PIECE(TIME,"@")_" at "_$PIECE(TIME,"@",2)_". "
SET ^TMP($JOB,"LOC",3,0)=" "
SET ^TMP($JOB,"LOC",4,0)="A total of "_ECRN_" records were written."
+4 SET ^TMP($JOB,"LOC",5,0)="File name "_ECFILE
SET ^TMP($JOB,"LOC",6,0)=" "
+5 SET XMTEXT="^TMP($J,""LOC"","
DO ^XMD
SET ^ECX(727,ECDA,"TR")=DT
CLEAN ;
+1 SET ZTREQ="@"
KILL ^TMP($JOB),^ECX(727,ECDA,"Q")
DO ^%ZISC
DO ^ECXKILL
+2 IF $$S^%ZTLOAD
KILL ZTREQ
SET ZTSTOP=1
+3 QUIT
+4 ;
