ASUW2ST1.m

ASUW2ST1 ; IHS/ITSC/LMH - CONSOLIDATE MASTER RECS ;  

 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000

 ;This routine will re-extract data from history transactions files

 ;based on a selected extract date.

 ;WAR 5/19/99 REM'D and changed next 3 lines for clarity

 ;I $G(ASUL(1,"AR","WHSE"))>2 W !,"WAREHOUSE FLAG NOT SET FOR IHS" Q

 ;D ASUW2ST4,ASUW2ST5

 ;I ASUL(1,"AR","WHSE")>2 Q

 I $G(ASUL(1,"AR","WHSE"))>2 D

 .W !,"WAREHOUSE FLAG NOT SET FOR IHS"

 E  D

 .D ASUW2ST4,ASUW2ST5

 Q

ASUW2ST4 ;EP

 K ^TMP("ASUW4",$J),^TMP("ASUWI") D ^ASUWMVHS

 D:'$D(U) ^XBKVAR

 D:'$D(IOF) HOME^%ZIS

 W !!,"Moving Area Masters to consolidation Global ^TMP(""ASUW"",$J,4,",!!

 S ASUG("TRGBL")="^TMP(""ASUW"",$J,4,"

 S (ASUC,ASUC(2))=0

 D ASUW2ST7

 F ASUC=ASUC:1 S ASUHDA=$O(@ASUG("E#")) Q:ASUHDA=""  D  ;DFM P1 8/27/98

 .W "."

 .S ASUV(0)=^TMP("ASUW",$J,4,ASUHDA,0) ;DFM P1 8/27/98

 .S ASUV(1)=^TMP("ASUW",$J,4,ASUHDA,1) ;DFM P1 8/27/98

 .S ASUV(4)=$G(^TMP("ASUW",$J,4,ASUHDA,4)) ;DFM P1 8/27/98

 .S ASUV("TRCODE")=$P(ASUV(1),U)

 .S ASUV("IDX")=$P(ASUV(1),U,5)

 .Q:ASUV("IDX")']""

 .S ASUR("KEY")=$S(ASUV("TRCODE")="4A":1,ASUV("TRCODE")="4C":2,1:3)_(ASUV("IDX")*.000001)

 .S ASUV("SV",1)=$G(^TMP("ASUW4",$J,ASUR("KEY"),1))

 .S ASUV("SV",4)=$G(^TMP("ASUW4",$J,ASUR("KEY"),4))

 .I ASUV("TRCODE")["C" D                               ;LMH 3/29/00

 ..S ASUC(2)=$G(ASUC(2))+1

 ..;S ASUU(0)=^TMP("ASUWI",$J,ASUR("KEY"))             ;LMH 3/29/00

 ..;S ^TMP("ASUWA",$J,ASUV("IDX"),ASUU(0))=""

 .F ASUC(1)=1:1:17 S:$P(ASUV(1),U,ASUC(1))]"" $P(ASUV("SV",1),U,ASUC(1))=$P(ASUV(1),U,ASUC(1))

 .F ASUC(1)=1:1:4 S:$P(ASUV(4),U,ASUC(1))]"" $P(ASUV("SV",4),U,ASUC(1))=$P(ASUV(4),U,ASUC(1))

 .S ^TMP("ASUW4",$J,ASUHDA,0)=ASUV(0)                  ;LMH 3/29/00

 .S ^TMP("ASUW4",$J,ASUHDA,1)=ASUV("SV",1)             ;LMH 3/29/00

 .S ^TMP("ASUW4",$J,ASUHDA,4)=ASUV("SV",4)             ;LMH 3/29/00

 .S ^TMP("ASUWI",$J,ASUR("KEY"))=ASUHDA ;DFM P1 8/27/98

 W !,"Processed ",$J($FN(ASUC,","),8)," Area Master transactions",!,"Combined  ",$J($FN(+$G(ASUC(2)),","),8)," of them",!!

 K ^TMP("ASUW",$J,4) M ^TMP("ASUW4",$J)=^TMP("ASUW",$J,4)

 K ASUC("TR"),ASUC,ASUV,ASUR

 Q

ASUW2ST5 ;EP

 K ^TMP("ASUW5",$J),^TMP("ASUWI") D ^ASUWMVHS

 D:'$D(U) ^XBKVAR

 D:'$D(IOF) HOME^%ZIS

 S ASUU(0)=""

 W !,"Moving Station Masters to consolidation Global ^TMP(""ASUW"",$J,5,",!!

 S ASUG("TRGBL")="^TMP(""ASUW"",$J,5,",ASUC=0 D ASUW2ST7

 F ASUC=ASUC:1 S ASUHDA=$O(@ASUG("E#")) Q:ASUHDA=""  D  ;DFM P1 8/27/98

 .W "."

 .S ASUV(0)=^TMP("ASUW",$J,5,ASUHDA,0) ;DFM P1 8/27/98

 .S ASUV(1)=^TMP("ASUW",$J,5,ASUHDA,1) ;DFM P1 8/27/98

 .S ASUV(5)=$G(^TMP("ASUW",$J,5,ASUHDA,5)) ;DFM P1 8/27/98

 .S ASUV("TRCODE")=$P(ASUV(1),U)

 .S ASUV("IDX")=$P(ASUV(1),U,5)

 .Q:ASUV("IDX")']""

 .S ASUR("KEY")=$S(ASUV("TRCODE")="5A":1,ASUV("TRCODE")="5B":2,ASUV("TRCODE")="5C":3,1:4)_(ASUV("IDX")*.000001)

 .S ASUV("SV",1)=$G(^TMP("ASUW5",$J,ASUR("KEY"),1))

 .S ASUV("SV",5)=$G(^TMP("ASUW5",$J,ASUR("KEY"),5))

 .I ASUV("TRCODE")["C" D

 ..S ASUC(2)=$G(ASUC(2))+1

 ..;S ASUU(0)=^TMP("ASUWI",$J,ASUR("KEY"))        ;LMH 3/30/00 

 ..;S ^TMP("ASUWA",$J,ASUV("IDX"),ASUU(0))=""

 .F ASUC(1)=1:1:20 S:$P(ASUV(1),U,ASUC(1))]"" $P(ASUV("SV",1),U,ASUC(1))=$P(ASUV(1),U,ASUC(1))

 .F ASUC(1)=1:1:20 S:$P(ASUV(5),U,ASUC(1))]"" $P(ASUV("SV",5),U,ASUC(1))=$P(ASUV(5),U,ASUC(1))

 .S ^TMP("ASUW5",$J,ASUHDA,0)=ASUV(0)             ;LMH 3/24/00

 .S ^TMP("ASUW5",$J,ASUHDA,1)=ASUV("SV",1)        ;LMH 3/24/00

 .S ^TMP("ASUW5",$J,ASUHDA,5)=ASUV("SV",5)        ;LMH 3/24/00

 .S ^TMP("ASUWI",$J,ASUR("KEY"))=ASUHDA ;DFM P1 8/27/98

 W !,"Processed ",$J($FN(ASUC,","),8)," Station Master transactions",!,"Combined  ",$J($FN(+$G(ASUC(2)),","),8)," of them",!!

 K ^TMP("ASUW",$J,5) M ^TMP("ASUW",$J,5)=^TMP("ASUW5",$J)

 K ASUC("TR"),ASUC,ASUV,ASUR

 Q

ASUW2ST7 ;EP ;

 S ASUHDA="" ;DFM P1 8/27/98

 S ASUG("E#")=ASUG("TRGBL")_"ASUHDA)" ;DFM P1 8/27/98

 Q

SV1 ;EP

 S ASUV("XB","MEDIUM")="F",XBMED=ASUV("XB","MEDIUM")

 I ASUW("SV DIR")]"" D

 .S ASUV("XB","DIRECTORY")=ASUW("SV DIR")

 E  D

 .S ASUV("XB","DIRECTORY")="/u/ihs/ftp/pub"

 S XBUF=ASUV("XB","DIRECTORY")

 S:'$D(ASUL(1,"AR","WHSE")) ASUL(1,"AR","WHSE")=1

ASUW2ST9 ;EP

 I ASUL(1,"AR","WHSE")>2 Q

 S XBGL="ASUPDATA" D ^XBGSAVE K XBGL

 I XBFLG D

 .S ASURX="W !,""Save of ASUPDATA Unsucessful -""" D ^ASUUPLOG

 .F ASUF("XB")=1:1 Q:'$D(XBFLG(ASUF("XB")))  D

 ..S ASURX="W """_XBFLG(ASUF("XB"))_""",!" D ^ASUUPLOG

 E  D

 .I '$D(ASUV("XB")) D

 ..S ASUV("XB","MEDIUM")="F"

 ..S ASUV("XB","DIRECTORY")="/u/ihs/ftp/pub"

 .S X2=$E(ASUK("DT","FM"),1,3)_"0101",X1=ASUK("DT","FM") D ^%DTC S X=X+1

 .S ASURX="W !,""Save of ^ASUPDATA global to "_ASUV("XB","DIRECTORY")_"/ASUP"_ASUK("ASUFAC")_"."_X_" Successful"",!"  D ^ASUUPLOG

 K XBFLG,ASUV("XB")

 Q

 S XBGL="ASUTRSV",XBMED="F" D ^XBGSAVE K XBGL

 I XBFLG D

 .S ASURX="W !,""Save of ASUTRSV Unsucessful -""" D ^ASUUPLOG

 .F ASUF("XB")=1:1 Q:'$D(XBFLG(ASUF("XB")))  D

 ..S ASURX="W """_XBFLG(ASUF("XB"))_""",!" D ^ASUUPLOG

 K XBFLG

 Q

REXT ;EP;RE-EXTRACT

 S DIR(0)="Y",DIR("A")="Do you wish to Re-Extract Transactions"

 S DIR("?",1)="Enter 'Y' to re-extract previously extracted, or"

 S DIR("?")=" 'N' to be prompted for a regular extract of updated transactions."

 D ^DIR K DIR

 Q:$D(DTOUT)  Q:$D(DUOUT)

 G:Y CONTURXT

 S DIR(0)="Y",DIR("A")="Do you wish to Extract Updated Transactions"

 S DIR("?",1)="Enter 'Y' to extract updated transactions, or"

 S DIR("?")=" 'N' to end this option selection."

 D ^DIR K DIR

 Q:$D(DTOUT)  Q:$D(DUOUT)

 I 'Y Q

 G BEGIN^ASUW2STO

CONTURXT ;

 K ^ASURX("R0R") S ASULA("X")="0R"

 S ASUW("TY RUN")=^ASUSITE(1,0)

 S $P(ASUW("TY RUN"),U,2)=8

 D:'$D(U) ^XBKVAR

 I '$D(IO(0)) S IOP=$I D ^%ZIS

 S ASUP("TYP")=$G(ASUP("TYP")) S:ASUP("TYP")']"" ASUP("TYP")=0

REXT2 ;EP ; RE-EXTRACT DATA

 S DIR(0)="D",DIR("A")="Enter Re-Extract Date",DIR("?")="^D DTHLP^ASUW2ST1" D ^DIR Q:$D(DTOUT)  Q:$D(DUOUT)!($D(DIROUT))

 S ASUW("DT EXT")=Y X ^DD("DD")

 S ASURX="W @IOF" D ^ASUUPLOG

 S ASURX="W !,""Re-extracting selected date of "_Y_"""" D ^ASUUPLOG

 K DIR,Y G OPNHFS^ASUW2STO

DTHLP ;LIST DATES EXTRACTED

 W !,"Enter the Extracted Date on records to be re-extracted.  Dates are:"

 S X=0 F  S X=$O(^ASUML("B",X)) Q:X'?1N.N  W !,$E(X,4,5),"/",$E(X,6,7),"/",$E(X,2,3)

 Q

ASUW2ST1  ; IHS/ITSC/LMH - CONSOLIDATE MASTER RECS ;  

 +1       ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000

 +2       ;This routine will re-extract data from history transactions files

 +3       ;based on a selected extract date.

 +4       ;WAR 5/19/99 REM'D and changed next 3 lines for clarity

 +5       ;I $G(ASUL(1,"AR","WHSE"))>2 W !,"WAREHOUSE FLAG NOT SET FOR IHS" Q

 +6       ;D ASUW2ST4,ASUW2ST5

 +7       ;I ASUL(1,"AR","WHSE")>2 Q

 +8        IF $GET(ASUL(1,"AR","WHSE"))>2

               Begin DoDot:1

 +9                WRITE !,"WAREHOUSE FLAG NOT SET FOR IHS"

               End DoDot:1

 +10      IF '$TEST

               Begin DoDot:1

 +11               DO ASUW2ST4

                   DO ASUW2ST5

               End DoDot:1

 +12       QUIT 

ASUW2ST4  ;EP

 +1        KILL ^TMP("ASUW4",$JOB),^TMP("ASUWI")

           DO ^ASUWMVHS

 +2        IF '$DATA(U)

               DO ^XBKVAR

 +3        IF '$DATA(IOF)

               DO HOME^%ZIS

 +4        WRITE !!,"Moving Area Masters to consolidation Global ^TMP(""ASUW"",$J,4,",!!

 +5        SET ASUG("TRGBL")="^TMP(""ASUW"",$J,4,"

 +6        SET (ASUC,ASUC(2))=0

 +7        DO ASUW2ST7

 +8       ;DFM P1 8/27/98

           FOR ASUC=ASUC:1

               SET ASUHDA=$ORDER(@ASUG("E#"))

               IF ASUHDA=""

                   QUIT 

               Begin DoDot:1

 +9                WRITE "."

 +10      ;DFM P1 8/27/98

                   SET ASUV(0)=^TMP("ASUW",$JOB,4,ASUHDA,0)

 +11      ;DFM P1 8/27/98

                   SET ASUV(1)=^TMP("ASUW",$JOB,4,ASUHDA,1)

 +12      ;DFM P1 8/27/98

                   SET ASUV(4)=$GET(^TMP("ASUW",$JOB,4,ASUHDA,4))

 +13               SET ASUV("TRCODE")=$PIECE(ASUV(1),U)

 +14               SET ASUV("IDX")=$PIECE(ASUV(1),U,5)

 +15               IF ASUV("IDX")']""

                       QUIT 

 +16               SET ASUR("KEY")=$SELECT(ASUV("TRCODE")="4A":1,ASUV("TRCODE")="4C":2,1:3)_(ASUV("IDX")*.000001)

 +17               SET ASUV("SV",1)=$GET(^TMP("ASUW4",$JOB,ASUR("KEY"),1))

 +18               SET ASUV("SV",4)=$GET(^TMP("ASUW4",$JOB,ASUR("KEY"),4))

 +19      ;LMH 3/29/00

                   IF ASUV("TRCODE")["C"

                       Begin DoDot:2

 +20                       SET ASUC(2)=$GET(ASUC(2))+1

 +21      ;S ASUU(0)=^TMP("ASUWI",$J,ASUR("KEY"))             ;LMH 3/29/00

 +22      ;S ^TMP("ASUWA",$J,ASUV("IDX"),ASUU(0))=""

                       End DoDot:2

 +23               FOR ASUC(1)=1:1:17

                       IF $PIECE(ASUV(1),U,ASUC(1))]""

                           SET $PIECE(ASUV("SV",1),U,ASUC(1))=$PIECE(ASUV(1),U,ASUC(1))

 +24               FOR ASUC(1)=1:1:4

                       IF $PIECE(ASUV(4),U,ASUC(1))]""

                           SET $PIECE(ASUV("SV",4),U,ASUC(1))=$PIECE(ASUV(4),U,ASUC(1))

 +25      ;LMH 3/29/00

                   SET ^TMP("ASUW4",$JOB,ASUHDA,0)=ASUV(0)

 +26      ;LMH 3/29/00

                   SET ^TMP("ASUW4",$JOB,ASUHDA,1)=ASUV("SV",1)

 +27      ;LMH 3/29/00

                   SET ^TMP("ASUW4",$JOB,ASUHDA,4)=ASUV("SV",4)

 +28      ;DFM P1 8/27/98

                   SET ^TMP("ASUWI",$JOB,ASUR("KEY"))=ASUHDA

               End DoDot:1

 +29       WRITE !,"Processed ",$JUSTIFY($FNUMBER(ASUC,","),8)," Area Master transactions",!,"Combined  ",$JUSTIFY($FNUMBER(+$GET(ASUC(2)),","),8)," of them",!!

 +30       KILL ^TMP("ASUW",$JOB,4)

           MERGE ^TMP("ASUW4",$JOB)=^TMP("ASUW",$JOB,4)

 +31       KILL ASUC("TR"),ASUC,ASUV,ASUR

 +32       QUIT 

ASUW2ST5  ;EP

 +1        KILL ^TMP("ASUW5",$JOB),^TMP("ASUWI")

           DO ^ASUWMVHS

 +2        IF '$DATA(U)

               DO ^XBKVAR

 +3        IF '$DATA(IOF)

               DO HOME^%ZIS

 +4        SET ASUU(0)=""

 +5        WRITE !,"Moving Station Masters to consolidation Global ^TMP(""ASUW"",$J,5,",!!

 +6        SET ASUG("TRGBL")="^TMP(""ASUW"",$J,5,"

           SET ASUC=0

           DO ASUW2ST7

 +7       ;DFM P1 8/27/98

           FOR ASUC=ASUC:1

               SET ASUHDA=$ORDER(@ASUG("E#"))

               IF ASUHDA=""

                   QUIT 

               Begin DoDot:1

 +8                WRITE "."

 +9       ;DFM P1 8/27/98

                   SET ASUV(0)=^TMP("ASUW",$JOB,5,ASUHDA,0)

 +10      ;DFM P1 8/27/98

                   SET ASUV(1)=^TMP("ASUW",$JOB,5,ASUHDA,1)

 +11      ;DFM P1 8/27/98

                   SET ASUV(5)=$GET(^TMP("ASUW",$JOB,5,ASUHDA,5))

 +12               SET ASUV("TRCODE")=$PIECE(ASUV(1),U)

 +13               SET ASUV("IDX")=$PIECE(ASUV(1),U,5)

 +14               IF ASUV("IDX")']""

                       QUIT 

 +15               SET ASUR("KEY")=$SELECT(ASUV("TRCODE")="5A":1,ASUV("TRCODE")="5B":2,ASUV("TRCODE")="5C":3,1:4)_(ASUV("IDX")*.000001)

 +16               SET ASUV("SV",1)=$GET(^TMP("ASUW5",$JOB,ASUR("KEY"),1))

 +17               SET ASUV("SV",5)=$GET(^TMP("ASUW5",$JOB,ASUR("KEY"),5))

 +18               IF ASUV("TRCODE")["C"

                       Begin DoDot:2

 +19                       SET ASUC(2)=$GET(ASUC(2))+1

 +20      ;S ASUU(0)=^TMP("ASUWI",$J,ASUR("KEY"))        ;LMH 3/30/00 

 +21      ;S ^TMP("ASUWA",$J,ASUV("IDX"),ASUU(0))=""

                       End DoDot:2

 +22               FOR ASUC(1)=1:1:20

                       IF $PIECE(ASUV(1),U,ASUC(1))]""

                           SET $PIECE(ASUV("SV",1),U,ASUC(1))=$PIECE(ASUV(1),U,ASUC(1))

 +23               FOR ASUC(1)=1:1:20

                       IF $PIECE(ASUV(5),U,ASUC(1))]""

                           SET $PIECE(ASUV("SV",5),U,ASUC(1))=$PIECE(ASUV(5),U,ASUC(1))

 +24      ;LMH 3/24/00

                   SET ^TMP("ASUW5",$JOB,ASUHDA,0)=ASUV(0)

 +25      ;LMH 3/24/00

                   SET ^TMP("ASUW5",$JOB,ASUHDA,1)=ASUV("SV",1)

 +26      ;LMH 3/24/00

                   SET ^TMP("ASUW5",$JOB,ASUHDA,5)=ASUV("SV",5)

 +27      ;DFM P1 8/27/98

                   SET ^TMP("ASUWI",$JOB,ASUR("KEY"))=ASUHDA

               End DoDot:1

 +28       WRITE !,"Processed ",$JUSTIFY($FNUMBER(ASUC,","),8)," Station Master transactions",!,"Combined  ",$JUSTIFY($FNUMBER(+$GET(ASUC(2)),","),8)," of them",!!

 +29       KILL ^TMP("ASUW",$JOB,5)

           MERGE ^TMP("ASUW",$JOB,5)=^TMP("ASUW5",$JOB)

 +30       KILL ASUC("TR"),ASUC,ASUV,ASUR

 +31       QUIT 

ASUW2ST7  ;EP ;

 +1       ;DFM P1 8/27/98

           SET ASUHDA=""

 +2       ;DFM P1 8/27/98

           SET ASUG("E#")=ASUG("TRGBL")_"ASUHDA)"

 +3        QUIT 

SV1       ;EP

 +1        SET ASUV("XB","MEDIUM")="F"

           SET XBMED=ASUV("XB","MEDIUM")

 +2        IF ASUW("SV DIR")]""

               Begin DoDot:1

 +3                SET ASUV("XB","DIRECTORY")=ASUW("SV DIR")

               End DoDot:1

 +4       IF '$TEST

               Begin DoDot:1

 +5                SET ASUV("XB","DIRECTORY")="/u/ihs/ftp/pub"

               End DoDot:1

 +6        SET XBUF=ASUV("XB","DIRECTORY")

 +7        IF '$DATA(ASUL(1,"AR","WHSE"))

               SET ASUL(1,"AR","WHSE")=1

ASUW2ST9  ;EP

 +1        IF ASUL(1,"AR","WHSE")>2

               QUIT 

 +2        SET XBGL="ASUPDATA"

           DO ^XBGSAVE

           KILL XBGL

 +3        IF XBFLG

               Begin DoDot:1

 +4                SET ASURX="W !,""Save of ASUPDATA Unsucessful -"""

                   DO ^ASUUPLOG

 +5                FOR ASUF("XB")=1:1

                       IF '$DATA(XBFLG(ASUF("XB")))

                           QUIT 

                       Begin DoDot:2

 +6                        SET ASURX="W """_XBFLG(ASUF("XB"))_""",!"

                           DO ^ASUUPLOG

                       End DoDot:2

               End DoDot:1

 +7       IF '$TEST

               Begin DoDot:1

 +8                IF '$DATA(ASUV("XB"))

                       Begin DoDot:2

 +9                        SET ASUV("XB","MEDIUM")="F"

 +10                       SET ASUV("XB","DIRECTORY")="/u/ihs/ftp/pub"

                       End DoDot:2

 +11               SET X2=$EXTRACT(ASUK("DT","FM"),1,3)_"0101"

                   SET X1=ASUK("DT","FM")

                   DO ^%DTC

                   SET X=X+1

 +12               SET ASURX="W !,""Save of ^ASUPDATA global to "_ASUV("XB","DIRECTORY")_"/ASUP"_ASUK("ASUFAC")_"."_X_" Successful"",!"

                   DO ^ASUUPLOG

               End DoDot:1

 +13       KILL XBFLG,ASUV("XB")

 +14       QUIT 

 +15       SET XBGL="ASUTRSV"

           SET XBMED="F"

           DO ^XBGSAVE

           KILL XBGL

 +16       IF XBFLG

               Begin DoDot:1

 +17               SET ASURX="W !,""Save of ASUTRSV Unsucessful -"""

                   DO ^ASUUPLOG

 +18               FOR ASUF("XB")=1:1

                       IF '$DATA(XBFLG(ASUF("XB")))

                           QUIT 

                       Begin DoDot:2

 +19                       SET ASURX="W """_XBFLG(ASUF("XB"))_""",!"

                           DO ^ASUUPLOG

                       End DoDot:2

               End DoDot:1

 +20       KILL XBFLG

 +21       QUIT 

REXT      ;EP;RE-EXTRACT

 +1        SET DIR(0)="Y"

           SET DIR("A")="Do you wish to Re-Extract Transactions"

 +2        SET DIR("?",1)="Enter 'Y' to re-extract previously extracted, or"

 +3        SET DIR("?")=" 'N' to be prompted for a regular extract of updated transactions."

 +4        DO ^DIR

           KILL DIR

 +5        IF $DATA(DTOUT)

               QUIT 

           IF $DATA(DUOUT)

               QUIT 

 +6        IF Y

               GOTO CONTURXT

 +7        SET DIR(0)="Y"

           SET DIR("A")="Do you wish to Extract Updated Transactions"

 +8        SET DIR("?",1)="Enter 'Y' to extract updated transactions, or"

 +9        SET DIR("?")=" 'N' to end this option selection."

 +10       DO ^DIR

           KILL DIR

 +11       IF $DATA(DTOUT)

               QUIT 

           IF $DATA(DUOUT)

               QUIT 

 +12       IF 'Y

               QUIT 

 +13       GOTO BEGIN^ASUW2STO

CONTURXT  ;

 +1        KILL ^ASURX("R0R")

           SET ASULA("X")="0R"

 +2        SET ASUW("TY RUN")=^ASUSITE(1,0)

 +3        SET $PIECE(ASUW("TY RUN"),U,2)=8

 +4        IF '$DATA(U)

               DO ^XBKVAR

 +5        IF '$DATA(IO(0))

               SET IOP=$IO

               DO ^%ZIS

 +6        SET ASUP("TYP")=$GET(ASUP("TYP"))

           IF ASUP("TYP")']""

               SET ASUP("TYP")=0

REXT2     ;EP ; RE-EXTRACT DATA

 +1        SET DIR(0)="D"

           SET DIR("A")="Enter Re-Extract Date"

           SET DIR("?")="^D DTHLP^ASUW2ST1"

           DO ^DIR

           IF $DATA(DTOUT)

               QUIT 

           IF $DATA(DUOUT)!($DATA(DIROUT))

               QUIT 

 +2        SET ASUW("DT EXT")=Y

           XECUTE ^DD("DD")

 +3        SET ASURX="W @IOF"

           DO ^ASUUPLOG

 +4        SET ASURX="W !,""Re-extracting selected date of "_Y_""""

           DO ^ASUUPLOG

 +5        KILL DIR,Y

           GOTO OPNHFS^ASUW2STO

DTHLP     ;LIST DATES EXTRACTED

 +1        WRITE !,"Enter the Extracted Date on records to be re-extracted.  Dates are:"

 +2        SET X=0

           FOR 

               SET X=$ORDER(^ASUML("B",X))

               IF X'?1N.N

                   QUIT 

               WRITE !,$EXTRACT(X,4,5),"/",$EXTRACT(X,6,7),"/",$EXTRACT(X,2,3)

 +3        QUIT