ASUAWXT.m

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