ASURD07A.m

ASURD07A ; IHS/ITSC/LMH -RPT 7A USRLVL CHGS/DELS/ESTAB ; 

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

 ;This routine formats and prints report 7A, User Level Change/Delete

 ;/Establish Transaction List.

EN ;EP;PRIMARY ENTRY POINT FOR REPORT 07A

 I '$D(IO) D HOME^%ZIS

 I '$D(DUZ(2)) W !,"Report must be run from Kernel option" Q

 I '$D(ASUL(1,"AR","AP")) D SETAREA^ASULARST

 S ASUK("PTRSEL")=$G(ASUK("PTRSEL")) I ASUK("PTRSEL")]"" G PSER

 S ZTRTN="PSER^ASURD07A",ZTDESC="SAMS RPT 07A" D O^ASUUZIS

 I POP S IOP=$I D ^%ZIS Q

 I ASUK(ASUK("PTR"),"Q") Q

PSER ;EP;FOR TASKMAN QUEUE OF PRINT

 S ASUT="ULV"

 D:'$D(^XTMP("ASUR","R7A")) CMPT

 D U^ASUUZIS

 S ASUV("RPT")="R7A",ASUQ("HDR")="HEADER^ASURD07A"

 D ^ASUUDATA I ASUX("NDTA") G K

 S (ASUX("AS"),ASUX("IX"),ASUX("SQ"))=""

 S ASUC("TOT")=0

 F  S ASUX("AS")=$O(^XTMP("ASUR","R7A",ASUX("AS"))) Q:ASUX("AS")=""  D  Q:$D(DUOUT)

 .F  S ASUX("IX")=$O(^XTMP("ASUR","R7A",ASUX("AS"),ASUX("IX"))) Q:ASUX("IX")=""  D  Q:$D(DUOUT)

 ..F  S ASUX("SQ")=$O(^XTMP("ASUR","R7A",ASUX("AS"),ASUX("IX"),ASUX("SQ"))) Q:ASUX("SQ")=""  D  Q:$D(DUOUT)

 ...S ASUHDA=^XTMP("ASUR","R7A",ASUX("AS"),ASUX("IX"),ASUX("SQ")),ASUC("LN")=ASUC("LN")+1

 ...D READ^ASU0TRRD(.ASUHDA,"H") Q:$G(ASUT)']""

 ...I ASUC("LN")>(IOSL-2) D HEADER S ASUC("LN")=3 Q:$D(DUOUT)

 ...S ASUC("TOT")=ASUC("TOT")+1

 ...W !?5,ASUT(ASUT,"AR"),?11,ASUT(ASUT,"STA")

 ...W ?16,$E(ASUT(ASUT,"DTS"),2,5)

 ...W ?23,ASUT("TRCD"),?30,ASUT(ASUT,"ULVQTY")

 ...W ?36,$E(ASUT(ASUT,"IDX"),1,5),".",$E(ASUT(ASUT,"IDX"),6)

 ...W ?44,$J(ASUT(ASUT,"USR"),3),?53,ASUT(ASUT,"SST")

 ...W ?61,ASUT(ASUT,"RMK")

 W !!?2,"NUMBER LINE ITEMS: ",ASUC("TOT")

K ;

 K ASUTX,ASUT,ASUHDA,ASUC,ASUV

 D PAZ^ASUURHDR

 I ASUK("PTRSEL")]"" W @IOF Q

 D C^ASUUZIS

 Q

CMPT ;EP;COMPUTE REPORT CONTENTS

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

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

 F  S ASUHDA=$O(^ASUH("T","5B",ASUHDA)) Q:ASUHDA>$G(ASUN("EKY"))  Q:ASUHDA']""  D

 .D READ^ASU0TRRD(.ASUHDA,"H") Q:$G(ASUT)']""

 .S ^XTMP("ASUR","R7A",ASUT(ASUT,"PT","STA"),ASUT(ASUT,"PT","IDX"),+($E(ASUHDA,10,15)))=ASUHDA

 Q

HEADER ;PRINT REPORT HEADING LINES

 S ASUC("PG")=$G(ASUC("PG"))+1

 I ASUC("PG")>1 D PAZ^ASUURHDR Q:$D(DUOUT)  W @(IOF)

 W !?3,"REPORT #7A.   USER LEVEL CHANGES/DELETES/ESTABLISHED TRANS"

 W ?100,"DATE: ",ASUX("DT"),?120,"PAGE: ",ASUC("PG")

 S X=ASUL(1,"AR","AP") W !?3,"AREA: ",ASUL(1,"AR","AP")

 W ?15,ASUL(1,"AR","NM")

 I ASUX("AS")'=$G(ASUL(2,"STA","E#")) D STA^ASULARST(ASUX("AS"))

 W !?3,"STATION: ",$G(ASUL(2,"STA","CD"))

 W ?15,$G(ASUL(2,"STA","NM"))

 W !!?3,"AREA",?8,"STATION",?16,"DATE",?22,"TRAN",?28,"USER LEV",?37,"INDEX",?43,"USER",?50,"SUB STA",?60,"REMARKS"

 W !?3,"CODE",?10,"CODE",?16,"FYCM",?22,"CODE",?30,"QTY",?37,"NUM",?43,"CODE",?52,"CODE"

 W !,"------------------------------------------------------------------------------------------------------------------------------------",!!

 S ASUC("LN")=6

 Q

ASURD07A  ; IHS/ITSC/LMH -RPT 7A USRLVL CHGS/DELS/ESTAB ; 

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

 +2       ;This routine formats and prints report 7A, User Level Change/Delete

 +3       ;/Establish Transaction List.

EN        ;EP;PRIMARY ENTRY POINT FOR REPORT 07A

 +1        IF '$DATA(IO)

               DO HOME^%ZIS

 +2        IF '$DATA(DUZ(2))

               WRITE !,"Report must be run from Kernel option"

               QUIT 

 +3        IF '$DATA(ASUL(1,"AR","AP"))

               DO SETAREA^ASULARST

 +4        SET ASUK("PTRSEL")=$GET(ASUK("PTRSEL"))

           IF ASUK("PTRSEL")]""

               GOTO PSER

 +5        SET ZTRTN="PSER^ASURD07A"

           SET ZTDESC="SAMS RPT 07A"

           DO O^ASUUZIS

 +6        IF POP

               SET IOP=$IO

               DO ^%ZIS

               QUIT 

 +7        IF ASUK(ASUK("PTR"),"Q")

               QUIT 

PSER      ;EP;FOR TASKMAN QUEUE OF PRINT

 +1        SET ASUT="ULV"

 +2        IF '$DATA(^XTMP("ASUR","R7A"))

               DO CMPT

 +3        DO U^ASUUZIS

 +4        SET ASUV("RPT")="R7A"

           SET ASUQ("HDR")="HEADER^ASURD07A"

 +5        DO ^ASUUDATA

           IF ASUX("NDTA")

               GOTO K

 +6        SET (ASUX("AS"),ASUX("IX"),ASUX("SQ"))=""

 +7        SET ASUC("TOT")=0

 +8        FOR 

               SET ASUX("AS")=$ORDER(^XTMP("ASUR","R7A",ASUX("AS")))

               IF ASUX("AS")=""

                   QUIT 

               Begin DoDot:1

 +9                FOR 

                       SET ASUX("IX")=$ORDER(^XTMP("ASUR","R7A",ASUX("AS"),ASUX("IX")))

                       IF ASUX("IX")=""

                           QUIT 

                       Begin DoDot:2

 +10                       FOR 

                               SET ASUX("SQ")=$ORDER(^XTMP("ASUR","R7A",ASUX("AS"),ASUX("IX"),ASUX("SQ")))

                               IF ASUX("SQ")=""

                                   QUIT 

                               Begin DoDot:3

 +11                               SET ASUHDA=^XTMP("ASUR","R7A",ASUX("AS"),ASUX("IX"),ASUX("SQ"))

                                   SET ASUC("LN")=ASUC("LN")+1

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

                                   IF $GET(ASUT)']""

                                       QUIT 

 +13                               IF ASUC("LN")>(IOSL-2)

                                       DO HEADER

                                       SET ASUC("LN")=3

                                       IF $DATA(DUOUT)

                                           QUIT 

 +14                               SET ASUC("TOT")=ASUC("TOT")+1

 +15                               WRITE !?5,ASUT(ASUT,"AR"),?11,ASUT(ASUT,"STA")

 +16                               WRITE ?16,$EXTRACT(ASUT(ASUT,"DTS"),2,5)

 +17                               WRITE ?23,ASUT("TRCD"),?30,ASUT(ASUT,"ULVQTY")

 +18                               WRITE ?36,$EXTRACT(ASUT(ASUT,"IDX"),1,5),".",$EXTRACT(ASUT(ASUT,"IDX"),6)

 +19                               WRITE ?44,$JUSTIFY(ASUT(ASUT,"USR"),3),?53,ASUT(ASUT,"SST")

 +20                               WRITE ?61,ASUT(ASUT,"RMK")

                               End DoDot:3

                               IF $DATA(DUOUT)

                                   QUIT 

                       End DoDot:2

                       IF $DATA(DUOUT)

                           QUIT 

               End DoDot:1

               IF $DATA(DUOUT)

                   QUIT 

 +21       WRITE !!?2,"NUMBER LINE ITEMS: ",ASUC("TOT")

K         ;

 +1        KILL ASUTX,ASUT,ASUHDA,ASUC,ASUV

 +2        DO PAZ^ASUURHDR

 +3        IF ASUK("PTRSEL")]""

               WRITE @IOF

               QUIT 

 +4        DO C^ASUUZIS

 +5        QUIT 

CMPT      ;EP;COMPUTE REPORT CONTENTS

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

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

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

               DO ^ASUURANG

 +3        FOR 

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

               IF ASUHDA>$GET(ASUN("EKY"))

                   QUIT 

               IF ASUHDA']""

                   QUIT 

               Begin DoDot:1

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

                   IF $GET(ASUT)']""

                       QUIT 

 +5                SET ^XTMP("ASUR","R7A",ASUT(ASUT,"PT","STA"),ASUT(ASUT,"PT","IDX"),+($EXTRACT(ASUHDA,10,15)))=ASUHDA

               End DoDot:1

 +6        QUIT 

HEADER    ;PRINT REPORT HEADING LINES

 +1        SET ASUC("PG")=$GET(ASUC("PG"))+1

 +2        IF ASUC("PG")>1

               DO PAZ^ASUURHDR

               IF $DATA(DUOUT)

                   QUIT 

               WRITE @(IOF)

 +3        WRITE !?3,"REPORT #7A.   USER LEVEL CHANGES/DELETES/ESTABLISHED TRANS"

 +4        WRITE ?100,"DATE: ",ASUX("DT"),?120,"PAGE: ",ASUC("PG")

 +5        SET X=ASUL(1,"AR","AP")

           WRITE !?3,"AREA: ",ASUL(1,"AR","AP")

 +6        WRITE ?15,ASUL(1,"AR","NM")

 +7        IF ASUX("AS")'=$GET(ASUL(2,"STA","E#"))

               DO STA^ASULARST(ASUX("AS"))

 +8        WRITE !?3,"STATION: ",$GET(ASUL(2,"STA","CD"))

 +9        WRITE ?15,$GET(ASUL(2,"STA","NM"))

 +10       WRITE !!?3,"AREA",?8,"STATION",?16,"DATE",?22,"TRAN",?28,"USER LEV",?37,"INDEX",?43,"USER",?50,"SUB STA",?60,"REMARKS"

 +11       WRITE !?3,"CODE",?10,"CODE",?16,"FYCM",?22,"CODE",?30,"QTY",?37,"NUM",?43,"CODE",?52,"CODE"

 +12       WRITE !,"------------------------------------------------------------------------------------------------------------------------------------",!!

 +13       SET ASUC("LN")=6

 +14       QUIT