ASURM77P.m

ASURM77P ; IHS/ITSC/LMH -ANALYSIS OF ISSUES BY SUB STATION ; 

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

 ;This routine formats and prints report 77, Analysis of Issues by

 ;Sub Station Report.

EN ;EP;PRIMARY ENTRY POINT FOR REPORT 77

 Q  ;WAR 5/21/99

 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^ASURM77P",ZTDESC="SAMS RPT 77" D O^ASUUZIS

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

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

PSER ;EP;FOR TASKMAN QUEUE OF PRINT

 D U^ASUUZIS

 S ASUV("RPT")="R77",ASUC("PG")=""

 D EN1

 I ($D(ASUK("DT"))#10)'=1 D DATE^ASUUDATE

 D P1^ASURO76P S (ASUX("SST"),ASUX("USR"),ASUX("ACC"))=""

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

 .F  S ASUX("USR")=$O(^XTMP("ASUR","R76",ASUX("SST"),ASUX("USR"))) Q:'ASUX("USR")  D

 ..S ASUX("REQ")=ASUX("SST")_$E(ASUX("USR"),3,6)

 ..F ASUX("ACC")=0:0 S ASUX("ACC")=$O(^XTMP("ASUR","R76",ASUX("SST"),ASUX("USR"),ASUX("ACC"))) Q:'ASUX("ACC")  S ASUC("TR")=^(ASUX("ACC")) D

 ...F ASUV("FIELD")=2:1:22 D

 ....S ASUC(ASUV("FIELD"),1,ASUX("ACC"))=ASUC(ASUV("FIELD"),1,ASUX("ACC"))+$P(ASUC("TR"),U,ASUV("FIELD"))

 .D SBK,P3^ASURO76P

 .D HEADER^ASURO76P Q:$D(DUOUT)

 .D P1^ASURO76P,EN1

 D ZAP0^ASURO76P

K ;

 D PAZ^ASUURHDR

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

 D C^ASUUZIS

 Q

SBK ;

 F ASUV("ACC")=1,2,3,4,5,9 D

 .F ASUV("FIELD")=2:1:22 D

 ..S ASUC(ASUV("FIELD"),0,ASUV("ACC"))=ASUC(ASUV("FIELD"),1,ASUV("ACC"))

 Q

EN1 ;Initialize Array for accumulating data from extracts

 F ASUV("ACC")=1,2,3,4,5,9 D

 .F ASUV("FIELD")=2:1:26 D

 ..S ASUC(ASUV("FIELD"),1,ASUV("ACC"))=0

 Q

ASURM77P  ; IHS/ITSC/LMH -ANALYSIS OF ISSUES BY SUB STATION ; 

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

 +2       ;This routine formats and prints report 77, Analysis of Issues by

 +3       ;Sub Station Report.

EN        ;EP;PRIMARY ENTRY POINT FOR REPORT 77

 +1       ;WAR 5/21/99

           QUIT 

 +2        IF '$DATA(IO)

               DO HOME^%ZIS

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

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

               QUIT 

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

               DO SETAREA^ASULARST

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

           IF ASUK("PTRSEL")]""

               GOTO PSER

 +6        SET ZTRTN="PSER^ASURM77P"

           SET ZTDESC="SAMS RPT 77"

           DO O^ASUUZIS

 +7        IF POP

               SET IOP=$IO

               DO ^%ZIS

               QUIT 

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

               QUIT 

PSER      ;EP;FOR TASKMAN QUEUE OF PRINT

 +1        DO U^ASUUZIS

 +2        SET ASUV("RPT")="R77"

           SET ASUC("PG")=""

 +3        DO EN1

 +4        IF ($DATA(ASUK("DT"))#10)'=1

               DO DATE^ASUUDATE

 +5        DO P1^ASURO76P

           SET (ASUX("SST"),ASUX("USR"),ASUX("ACC"))=""

 +6        FOR 

               SET ASUX("SST")=$ORDER(^XTMP("ASUR","R76",ASUX("SST")))

               IF ASUX("SST")=""

                   QUIT 

               Begin DoDot:1

 +7                FOR 

                       SET ASUX("USR")=$ORDER(^XTMP("ASUR","R76",ASUX("SST"),ASUX("USR")))

                       IF 'ASUX("USR")

                           QUIT 

                       Begin DoDot:2

 +8                        SET ASUX("REQ")=ASUX("SST")_$EXTRACT(ASUX("USR"),3,6)

 +9                        FOR ASUX("ACC")=0:0

                               SET ASUX("ACC")=$ORDER(^XTMP("ASUR","R76",ASUX("SST"),ASUX("USR"),ASUX("ACC")))

                               IF 'ASUX("ACC")

                                   QUIT 

                               SET ASUC("TR")=^(ASUX("ACC"))

                               Begin DoDot:3

 +10                               FOR ASUV("FIELD")=2:1:22

                                       Begin DoDot:4

 +11                                       SET ASUC(ASUV("FIELD"),1,ASUX("ACC"))=ASUC(ASUV("FIELD"),1,ASUX("ACC"))+$PIECE(ASUC("TR"),U,ASUV("FIELD"))

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

 +12               DO SBK

                   DO P3^ASURO76P

 +13               DO HEADER^ASURO76P

                   IF $DATA(DUOUT)

                       QUIT 

 +14               DO P1^ASURO76P

                   DO EN1

               End DoDot:1

               IF $DATA(DUOUT)

                   QUIT 

 +15       DO ZAP0^ASURO76P

K         ;

 +1        DO PAZ^ASUURHDR

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

               WRITE @IOF

               QUIT 

 +3        DO C^ASUUZIS

 +4        QUIT 

SBK       ;

 +1        FOR ASUV("ACC")=1,2,3,4,5,9

               Begin DoDot:1

 +2                FOR ASUV("FIELD")=2:1:22

                       Begin DoDot:2

 +3                        SET ASUC(ASUV("FIELD"),0,ASUV("ACC"))=ASUC(ASUV("FIELD"),1,ASUV("ACC"))

                       End DoDot:2

               End DoDot:1

 +4        QUIT 

EN1       ;Initialize Array for accumulating data from extracts

 +1        FOR ASUV("ACC")=1,2,3,4,5,9

               Begin DoDot:1

 +2                FOR ASUV("FIELD")=2:1:26

                       Begin DoDot:2

 +3                        SET ASUC(ASUV("FIELD"),1,ASUV("ACC"))=0

                       End DoDot:2

               End DoDot:1

 +4        QUIT