ASUAWXT ;DSD/DFM - EXTRACT TRANS - CONVERT TO DDPS FORMAT ; [ 04/15/98 3:00 PM ]
;;3.0;SAMS;**1**;AUG 20, 1993
BEGIN ;EP;FOR RE-EXTRACT//^ASUAWXTW
D:'$D(U) ^XBKVAR
I '$D(IO(0)) S IOP=$I D ^%ZIS
S ASUW("RUN TYPE")=$G(ASUW("RUN TYPE"))
S:ASUW("RUN TYPE")']"" ASUW("RUN TYPE")=0
S ASUW("TYPE LAST RUN")=^ASUTLRUN(1,0)
I $P(ASUW("TYPE LAST RUN"),U,2)=8 G REXT2^ASUAWXTW
S ASUX("EXTRACT DATE")=DT
OPNHFS ;EP;FOR RE-EXTRACT//^ASUAWXTW
S ASUW("SAVE MEDIUM")=$P(ASUW("TYPE LAST RUN"),U,9)
S ASUK("WAREHOUSE")=$G(ASUK("WAREHOUSE"))
I ASUK("WAREHOUSE")<2 D ^ASUAWBTS
K ^ASUPDATA
;KILL OF UNSUBSCRIPTED GLOBAL - EXTRACT FOR AIB TO DATA CENTER - NEW EACH MONTH
S ASULNPAD=""
S (ASUC(0),ASUC("TOT REC COUNT"),ASUC("ACCUMULATE COUNT"),ASUC("TOT PROC"))=0
F ASUG("FILE NUMBER")=1:1:7 D
.S ASUC(0)=ASUC(0)+1
.S ASUG("SAVE NODE")="^ASUTRSV("_ASUG("FILE NUMBER")_",ASUX(""RECORD #""),"
.S ASUG("TRAN GLOBAL")=U_$P(^ASUXCTRL(ASUG("FILE NUMBER"),0),U,2)
.S ASUG("TRAN CODE PIECE #")=$P(^ASUXCTRL(ASUG("FILE NUMBER"),0),U,4)
.S ASUG("AREA CODE PIECE #")=$P(^ASUXCTRL(ASUG("FILE NUMBER"),0),U,7)
.S ASUG("ZERO NODE")=ASUG("TRAN GLOBAL")_"(0)"
.S DIE=$E($P(@ASUG("ZERO NODE"),U,2),1,10)
.S ASUX("FILE NAME")=$P(@ASUG("ZERO NODE"),U)
.I ASUK("WAREHOUSE")<2 S ASUTRX="W !,""Now Processing "_ASUX("FILE NAME")_" Records"",!" D LOG^ASUAUTIL
.S ASUX("SORT XREF")=$S($P(ASUW("TYPE LAST RUN"),U,2)=8:"AX",1:"C")
.I ASUX("SORT XREF")="AX" D
..S (ASUX("STATUS"),ASUX("READ STATUS"))=ASUX("EXTRACT DATE")
..S ASUX("READ STATUS")=ASUX("READ STATUS")-1
.E D
..S ASUX("READ STATUS")=$S($P(ASUW("TYPE LAST RUN"),U,2)=9:"X",1:"T")
..S ASUX("STATUS")=$S(ASUX("READ STATUS")="X":"Y",1:"U")
.S ASUX("RECORD #")=""
.S ASUG("FIND STATUS")=ASUG("TRAN GLOBAL")_"(ASUX(""SORT XREF""),ASUX(""READ STATUS""))"
.S ASUG("FIND RECORD")=ASUG("TRAN GLOBAL")_"(ASUX(""SORT XREF""),ASUX(""READ STATUS""),ASUX(""RECORD #""))"
.F S ASUX("READ STATUS")=$O(@ASUG("FIND STATUS")) Q:ASUX("READ STATUS")'=ASUX("STATUS") D
..F S ASUX("RECORD #")=$O(@ASUG("FIND RECORD")) Q:ASUX("RECORD #")="" D
...S DA=ASUX("RECORD #"),ASUX("EXTR FLAG")=1
...I ASUK("WAREHOUSE")<2 D ^ASUAWXT1
...Q:ASUX("SORT XREF")="AX"
...S ASUC("TOT PROC")=ASUC("TOT PROC")+1
...I ASUX("EXTR FLAG") S DR=".09///"_ASUX("EXTRACT DATE")_";.08///X" D ^DIE
.S ASUC(ASUG("FILE NUMBER"))=ASUC("TOT REC COUNT")-ASUC("ACCUMULATE COUNT")
.S $P(^ASUXCTRL(ASUG("FILE NUMBER"),0),U,5)=ASUC(ASUG("FILE NUMBER"))
.S $P(^ASUXCTRL(ASUG("FILE NUMBER"),0),U,6)=ASUX("EXTRACT DATE")
.S ASUC("ACCUMULATE COUNT")=ASUC("TOT REC COUNT")
.I ASUK("WAREHOUSE")<2 S ASUTRX="W !,"""_ASUX("FILE NAME")_" Record Count : "","_$P(^ASUXCTRL(ASUG("FILE NUMBER"),0),U,5) D LOG^ASUAUTIL
S ASUTRX="W !,*7,""Conversion Completed"",*7" D LOG^ASUAUTIL
S ASUTRX="W !,""Total records processed: "","_ASUC("TOT PROC") D LOG^ASUAUTIL
I ASUC("TOT REC COUNT")=0 D
.S ASUTRX="W !,""There were no current records converted"",*7,!"
.D LOG^ASUAUTIL
.I 1
E D
.S ASUTRX="W !,""Total records converted "","_ASUC("TOT REC COUNT")
.D SETAREA^ASUAUARE
.S ^ASUPDATA(0)=ASUK("ASUFAC")_U_ASUK("AREA NAME")_U_ASUX("EXTRACT DATE")_U_ASUX("EXTRACT DATE")_U_ASUX("EXTRACT DATE")_U_U_ASUC("TOT REC COUNT")
.I ASUK("WAREHOUSE") D
..I ASUW("RUN TYPE") S $P(^ASUTLRUN(1,0),U,8)=ASUX("EXTRACT DATE") D ^ASUAWXT2
.E D
..S $P(^ASUTLRUN(1,0),U,8)=ASUX("EXTRACT DATE") D ^ASUAWXT2
.S AUMED=$S(ASUW("SAVE MEDIUM")]"":ASUW("SAVE MEDIUM"),1:"F") D SAVE
I $G(ASUK("PRINT QUEUED"))'=1 S DIR(0)="E" D ^DIR
K ASUX,ASU0,ASU1,ASU2,ASUC,ASUG,ASUT,ASUNPAD,ASULNPAD,ASUFTAPE,AUGL
K DA,DR,DIE,DTOUT,DUOUT,DIROUT
K:$G(ASUW("RUN TYPE"))="" ASUV,ASUW
Q
SV1 ;EP ;
S AUMED="F",AUUF="/usr/spool/uucppublic"
S:'$D(ASUK("WAREHOUSE")) ASUK("WAREHOUSE")=1
SAVE ;EP; SAVE GLOBAL
I ASUK("WAREHOUSE")=2 Q
S AUGL="ASUPDATA" D ^AUGSAVE K AUGL
I AUFLG D
.S ASUTRX="W !!,""Save of ASUPDATA Unsucessful - """ D LOG^ASUAUTIL
.F ASU("AUFLG")=1:1 Q:'$D(AUFLG(ASU("AUFLG"))) D
..S ASUTRX="W """_AUFLG(ASU("AUFLG"))_""",!" D LOG^ASUAUTIL
K AUFLG
Q
S AUGL="ASUTRSV",AUMED="F" D ^AUGSAVE K AUGL
I AUFLG D
.S ASUTRX="W !!,""Save of ASUTRSV Unsucessful - """ D LOG^ASUAUTIL
.F ASU("AUFLG")=1:1 Q:'$D(AUFLG(ASU("AUFLG"))) D
..S ASUTRX="W """_AUFLG(ASU("AUFLG"))_""",!" D LOG^ASUAUTIL
K AUFLG
Q
ASUAWXT ;DSD/DFM - EXTRACT TRANS - CONVERT TO DDPS FORMAT ; [ 04/15/98 3:00 PM ]
+1 ;;3.0;SAMS;**1**;AUG 20, 1993
BEGIN ;EP;FOR RE-EXTRACT//^ASUAWXTW
+1 IF '$DATA(U)
DO ^XBKVAR
+2 IF '$DATA(IO(0))
SET IOP=$IO
DO ^%ZIS
+3 SET ASUW("RUN TYPE")=$GET(ASUW("RUN TYPE"))
+4 IF ASUW("RUN TYPE")']""
SET ASUW("RUN TYPE")=0
+5 SET ASUW("TYPE LAST RUN")=^ASUTLRUN(1,0)
+6 IF $PIECE(ASUW("TYPE LAST RUN"),U,2)=8
GOTO REXT2^ASUAWXTW
+7 SET ASUX("EXTRACT DATE")=DT
OPNHFS ;EP;FOR RE-EXTRACT//^ASUAWXTW
+1 SET ASUW("SAVE MEDIUM")=$PIECE(ASUW("TYPE LAST RUN"),U,9)
+2 SET ASUK("WAREHOUSE")=$GET(ASUK("WAREHOUSE"))
+3 IF ASUK("WAREHOUSE")<2
DO ^ASUAWBTS
+4 KILL ^ASUPDATA
+5 ;KILL OF UNSUBSCRIPTED GLOBAL - EXTRACT FOR AIB TO DATA CENTER - NEW EACH MONTH
+6 SET ASULNPAD=""
+7 SET (ASUC(0),ASUC("TOT REC COUNT"),ASUC("ACCUMULATE COUNT"),ASUC("TOT PROC"))=0
+8 FOR ASUG("FILE NUMBER")=1:1:7
Begin DoDot:1
+9 SET ASUC(0)=ASUC(0)+1
+10 SET ASUG("SAVE NODE")="^ASUTRSV("_ASUG("FILE NUMBER")_",ASUX(""RECORD #""),"
+11 SET ASUG("TRAN GLOBAL")=U_$PIECE(^ASUXCTRL(ASUG("FILE NUMBER"),0),U,2)
+12 SET ASUG("TRAN CODE PIECE #")=$PIECE(^ASUXCTRL(ASUG("FILE NUMBER"),0),U,4)
+13 SET ASUG("AREA CODE PIECE #")=$PIECE(^ASUXCTRL(ASUG("FILE NUMBER"),0),U,7)
+14 SET ASUG("ZERO NODE")=ASUG("TRAN GLOBAL")_"(0)"
+15 SET DIE=$EXTRACT($PIECE(@ASUG("ZERO NODE"),U,2),1,10)
+16 SET ASUX("FILE NAME")=$PIECE(@ASUG("ZERO NODE"),U)
+17 IF ASUK("WAREHOUSE")<2
SET ASUTRX="W !,""Now Processing "_ASUX("FILE NAME")_" Records"",!"
DO LOG^ASUAUTIL
+18 SET ASUX("SORT XREF")=$SELECT($PIECE(ASUW("TYPE LAST RUN"),U,2)=8:"AX",1:"C")
+19 IF ASUX("SORT XREF")="AX"
Begin DoDot:2
+20 SET (ASUX("STATUS"),ASUX("READ STATUS"))=ASUX("EXTRACT DATE")
+21 SET ASUX("READ STATUS")=ASUX("READ STATUS")-1
End DoDot:2
+22 IF '$TEST
Begin DoDot:2
+23 SET ASUX("READ STATUS")=$SELECT($PIECE(ASUW("TYPE LAST RUN"),U,2)=9:"X",1:"T")
+24 SET ASUX("STATUS")=$SELECT(ASUX("READ STATUS")="X":"Y",1:"U")
End DoDot:2
+25 SET ASUX("RECORD #")=""
+26 SET ASUG("FIND STATUS")=ASUG("TRAN GLOBAL")_"(ASUX(""SORT XREF""),ASUX(""READ STATUS""))"
+27 SET ASUG("FIND RECORD")=ASUG("TRAN GLOBAL")_"(ASUX(""SORT XREF""),ASUX(""READ STATUS""),ASUX(""RECORD #""))"
+28 FOR
SET ASUX("READ STATUS")=$ORDER(@ASUG("FIND STATUS"))
IF ASUX("READ STATUS")'=ASUX("STATUS")
QUIT
Begin DoDot:2
+29 FOR
SET ASUX("RECORD #")=$ORDER(@ASUG("FIND RECORD"))
IF ASUX("RECORD #")=""
QUIT
Begin DoDot:3
+30 SET DA=ASUX("RECORD #")
SET ASUX("EXTR FLAG")=1
+31 IF ASUK("WAREHOUSE")<2
DO ^ASUAWXT1
+32 IF ASUX("SORT XREF")="AX"
QUIT
+33 SET ASUC("TOT PROC")=ASUC("TOT PROC")+1
+34 IF ASUX("EXTR FLAG")
SET DR=".09///"_ASUX("EXTRACT DATE")_";.08///X"
DO ^DIE
End DoDot:3
End DoDot:2
+35 SET ASUC(ASUG("FILE NUMBER"))=ASUC("TOT REC COUNT")-ASUC("ACCUMULATE COUNT")
+36 SET $PIECE(^ASUXCTRL(ASUG("FILE NUMBER"),0),U,5)=ASUC(ASUG("FILE NUMBER"))
+37 SET $PIECE(^ASUXCTRL(ASUG("FILE NUMBER"),0),U,6)=ASUX("EXTRACT DATE")
+38 SET ASUC("ACCUMULATE COUNT")=ASUC("TOT REC COUNT")
+39 IF ASUK("WAREHOUSE")<2
SET ASUTRX="W !,"""_ASUX("FILE NAME")_" Record Count : "","_$PIECE(^ASUXCTRL(ASUG("FILE NUMBER"),0),U,5)
DO LOG^ASUAUTIL
End DoDot:1
+40 SET ASUTRX="W !,*7,""Conversion Completed"",*7"
DO LOG^ASUAUTIL
+41 SET ASUTRX="W !,""Total records processed: "","_ASUC("TOT PROC")
DO LOG^ASUAUTIL
+42 IF ASUC("TOT REC COUNT")=0
Begin DoDot:1
+43 SET ASUTRX="W !,""There were no current records converted"",*7,!"
+44 DO LOG^ASUAUTIL
+45 IF 1
End DoDot:1
+46 IF '$TEST
Begin DoDot:1
+47 SET ASUTRX="W !,""Total records converted "","_ASUC("TOT REC COUNT")
+48 DO SETAREA^ASUAUARE
+49 SET ^ASUPDATA(0)=ASUK("ASUFAC")_U_ASUK("AREA NAME")_U_ASUX("EXTRACT DATE")_U_ASUX("EXTRACT DATE")_U_ASUX("EXTRACT DATE")_U_U_ASUC("TOT REC COUNT")
+50 IF ASUK("WAREHOUSE")
Begin DoDot:2
+51 IF ASUW("RUN TYPE")
SET $PIECE(^ASUTLRUN(1,0),U,8)=ASUX("EXTRACT DATE")
DO ^ASUAWXT2
End DoDot:2
+52 IF '$TEST
Begin DoDot:2
+53 SET $PIECE(^ASUTLRUN(1,0),U,8)=ASUX("EXTRACT DATE")
DO ^ASUAWXT2
End DoDot:2
+54 SET AUMED=$SELECT(ASUW("SAVE MEDIUM")]"":ASUW("SAVE MEDIUM"),1:"F")
DO SAVE
End DoDot:1
+55 IF $GET(ASUK("PRINT QUEUED"))'=1
SET DIR(0)="E"
DO ^DIR
+56 KILL ASUX,ASU0,ASU1,ASU2,ASUC,ASUG,ASUT,ASUNPAD,ASULNPAD,ASUFTAPE,AUGL
+57 KILL DA,DR,DIE,DTOUT,DUOUT,DIROUT
+58 IF $GET(ASUW("RUN TYPE"))=""
KILL ASUV,ASUW
+59 QUIT
SV1 ;EP ;
+1 SET AUMED="F"
SET AUUF="/usr/spool/uucppublic"
+2 IF '$DATA(ASUK("WAREHOUSE"))
SET ASUK("WAREHOUSE")=1
SAVE ;EP; SAVE GLOBAL
+1 IF ASUK("WAREHOUSE")=2
QUIT
+2 SET AUGL="ASUPDATA"
DO ^AUGSAVE
KILL AUGL
+3 IF AUFLG
Begin DoDot:1
+4 SET ASUTRX="W !!,""Save of ASUPDATA Unsucessful - """
DO LOG^ASUAUTIL
+5 FOR ASU("AUFLG")=1:1
IF '$DATA(AUFLG(ASU("AUFLG")))
QUIT
Begin DoDot:2
+6 SET ASUTRX="W """_AUFLG(ASU("AUFLG"))_""",!"
DO LOG^ASUAUTIL
End DoDot:2
End DoDot:1
+7 KILL AUFLG
+8 QUIT
+9 SET AUGL="ASUTRSV"
SET AUMED="F"
DO ^AUGSAVE
KILL AUGL
+10 IF AUFLG
Begin DoDot:1
+11 SET ASUTRX="W !!,""Save of ASUTRSV Unsucessful - """
DO LOG^ASUAUTIL
+12 FOR ASU("AUFLG")=1:1
IF '$DATA(AUFLG(ASU("AUFLG")))
QUIT
Begin DoDot:2
+13 SET ASUTRX="W """_AUFLG(ASU("AUFLG"))_""",!"
DO LOG^ASUAUTIL
End DoDot:2
End DoDot:1
+14 KILL AUFLG
+15 QUIT
