ASURD700.m

ASURD700 ; IHS/ITSC/LMH -RPT 8 IDX MAST REC CHGS/DELS ;  [ 08/02/2000  1:27 PM ]

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

 ;This routine formats and prints report 8, Index Change/Delete

 ;Transaction List.

CMPT ;EP;COMPUTE REPORT CONTENTS

 K ^XTMP("ASUR","R70") S ^XTMP("ASUR","R70",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM") N Z

 D:$G(ASUN("TYP"))']"" ^ASUURANG

 ;E  S ASUHDA=$G(ASUN("B#"))-1; working of $T from ^ASUURANG

 S ASUHDA=$G(ASUN("B#"))-1

 F Z="32" D

 .F  S ASUHDA=$O(^ASUH("T",Z,ASUHDA)) Q:ASUHDA>$G(ASUN("E#"))  Q:ASUHDA']""  D

 ..D READ^ASU0TRRD(.ASUHDA,"H") Q:$G(ASUT)']""  S ASUMS("E#","STA")=ASUT(ASUT,"PT","STA"),ASUMS("E#","IDX")=ASUT(ASUT,"PT","IDX") D ^ASUMSTRD S ASUV("SLC")=ASUMS("SLC") S:ASUV("SLC")']"" ASUV("SLC")="*"

 ..I $G(ASUT(ASUT,"PST"))]"" S ^XTMP("ASUR","R7I",ASUT(ASUT,"PT","STA"),ASUT(ASUT,"PT","SST"),ASUT(ASUT,"VOU"),ASUV("SLC"),ASUT(ASUT,"PT","IDX"),ASUHDA)=ASUHDA Q

 ..S ^XTMP("ASUR","R70",ASUT(ASUT,"PT","STA"),ASUT(ASUT,"PT","SST"),ASUT(ASUT,"VOU"),ASUV("SLC"),ASUT(ASUT,"PT","IDX"),ASUHDA)=ASUHDA Q

 Q

ASURD700  ; IHS/ITSC/LMH -RPT 8 IDX MAST REC CHGS/DELS ;  [ 08/02/2000  1:27 PM ]

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

 +2       ;This routine formats and prints report 8, Index Change/Delete

 +3       ;Transaction List.

CMPT      ;EP;COMPUTE REPORT CONTENTS

 +1        KILL ^XTMP("ASUR","R70")

           SET ^XTMP("ASUR","R70",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")

           NEW Z

 +2        IF $GET(ASUN("TYP"))']""

               DO ^ASUURANG

 +3       ;E  S ASUHDA=$G(ASUN("B#"))-1; working of $T from ^ASUURANG

 +4        SET ASUHDA=$GET(ASUN("B#"))-1

 +5        FOR Z="32"

               Begin DoDot:1

 +6                FOR 

                       SET ASUHDA=$ORDER(^ASUH("T",Z,ASUHDA))

                       IF ASUHDA>$GET(ASUN("E#"))

                           QUIT 

                       IF ASUHDA']""

                           QUIT 

                       Begin DoDot:2

 +7                        DO READ^ASU0TRRD(.ASUHDA,"H")

                           IF $GET(ASUT)']""

                               QUIT 

                           SET ASUMS("E#","STA")=ASUT(ASUT,"PT","STA")

                           SET ASUMS("E#","IDX")=ASUT(ASUT,"PT","IDX")

                           DO ^ASUMSTRD

                           SET ASUV("SLC")=ASUMS("SLC")

                           IF ASUV("SLC")']""

                               SET ASUV("SLC")="*"

 +8                        IF $GET(ASUT(ASUT,"PST"))]""

                               SET ^XTMP("ASUR","R7I",ASUT(ASUT,"PT","STA"),ASUT(ASUT,"PT","SST"),ASUT(ASUT,"VOU"),ASUV("SLC"),ASUT(ASUT,"PT","IDX"),ASUHDA)=ASUHDA

                               QUIT 

 +9                        SET ^XTMP("ASUR","R70",ASUT(ASUT,"PT","STA"),ASUT(ASUT,"PT","SST"),ASUT(ASUT,"VOU"),ASUV("SLC"),ASUT(ASUT,"PT","IDX"),ASUHDA)=ASUHDA

                           QUIT 

                       End DoDot:2

               End DoDot:1

 +10       QUIT