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
