ASURO3UT.m

ASURO3UT ; IHS/ITSC/LMH -FILEMAN UTILITY REPORTS 3* ; 

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

 ;This routine is a utility used by FileMan templates which create

 ;the 30's series report.  It provides entry points for Printing Totals

 ;and Printing Index Description fields

 Q:'$D(D0)  Q:'$D(D1)

 Q:D0'?1N.N  Q:D1'?1N.N

 S ASUC("MSTRS")=$G(ASUC("MSTRS"))+1 ;COUNT TIMES ENTERED

 I $P(^ASUMS(D0,1,D1,0),U,3)?13N.AN S ASUC("NSN")=$G(ASUC("NSN"))+1

 Q

PRINT ;EP;PRINT TOTALS

 I $D(IOF) W @IOF

 W "REPORT #",$E($P(XQY0,U,2),2,$L($P(XQY0,U,2)))

 W ?80,"DATE ",ASUK("DT")

 W !,"AREA",?9,ASUL(1,"AR","NM"),!!

 F ASUC=1:1:132 W "_"

 W !!?50,"REPORT TOTAL STATISTICS",!!

 W !!?25,"NUMBER OF AREA/STATION MASTERS PROCESSED      : ",$J($FN($S($G(ASUC("MSTRS"))="":0,1:ASUC("MSTRS")),","),9)

 W !!?25,"NUMBER OF MASTERS WITH NATIONAL STOCK NUMBERS : ",$J($FN($S($G(ASUC("NSN"))="":0,1:ASUC("NSN")),","),9)

 K ASUC("MSTRS"),ASUC("NSN")

 Q

DESC ;EP;SET UP DESCRIPTION

 I $D(^ASUMX(D1,1,0)) D

 .K ^UTILITY($J,"W")

 .S DIWL=1,DIWR=20,DIWF="C30"

 .S ASUC("D1")=$P(^ASUMX(D1,1,0),U,3)

 .F ASUC("D2")=1:1:ASUC("D1") S X=^ASUMX(D1,1,ASUC("D2"),0) D

 ..D ^DIWP

 .F ASUC("D3")=0:0 S ASUC("D3")=$O(^UTILITY($J,"W",DIWL,ASUC("D3"))) Q:ASUC("D3")']""  D

 ..S ASU1(ASUC("D3"))=^UTILITY($J,"W",DIWL,ASUC("D3"),0)

 .S ASUC("D")=$G(ASUC("D"))+ASUC("D3")

 E  D

 .S ASU1(1)=$P(^ASUMX(D1,0),U,2)

 .S ASU1(2)=$P(^ASUMX(D1,0),U,3)

 .S ASUC("D")=2

 K ASUC("D2")

 W ?10,ASU1(1)

 K ASUC("D1"),ASUC("D2"),ASUC("D3"),DIWL,DIWR

 Q

WDESC ;EP;WRITE WORD PROCESSING DESCRIPTION

 Q:ASUC("D")<3

 F ASUC("D2")=3:1:ASUC("D") W !?10,ASU1(ASUC("D2"))

 K ASUC("D"),ASUC("D2"),ASU1

 Q

ASURO3UT  ; IHS/ITSC/LMH -FILEMAN UTILITY REPORTS 3* ; 

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

 +2       ;This routine is a utility used by FileMan templates which create

 +3       ;the 30's series report.  It provides entry points for Printing Totals

 +4       ;and Printing Index Description fields

 +5        IF '$DATA(D0)

               QUIT 

           IF '$DATA(D1)

               QUIT 

 +6        IF D0'?1N.N

               QUIT 

           IF D1'?1N.N

               QUIT 

 +7       ;COUNT TIMES ENTERED

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

 +8        IF $PIECE(^ASUMS(D0,1,D1,0),U,3)?13N.AN

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

 +9        QUIT 

PRINT     ;EP;PRINT TOTALS

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        WRITE "REPORT #",$EXTRACT($PIECE(XQY0,U,2),2,$LENGTH($PIECE(XQY0,U,2)))

 +3        WRITE ?80,"DATE ",ASUK("DT")

 +4        WRITE !,"AREA",?9,ASUL(1,"AR","NM"),!!

 +5        FOR ASUC=1:1:132

               WRITE "_"

 +6        WRITE !!?50,"REPORT TOTAL STATISTICS",!!

 +7        WRITE !!?25,"NUMBER OF AREA/STATION MASTERS PROCESSED      : ",$JUSTIFY($FNUMBER($SELECT($GET(ASUC("MSTRS"))="":0,1:ASUC("MSTRS")),","),9)

 +8        WRITE !!?25,"NUMBER OF MASTERS WITH NATIONAL STOCK NUMBERS : ",$JUSTIFY($FNUMBER($SELECT($GET(ASUC("NSN"))="":0,1:ASUC("NSN")),","),9)

 +9        KILL ASUC("MSTRS"),ASUC("NSN")

 +10       QUIT 

DESC      ;EP;SET UP DESCRIPTION

 +1        IF $DATA(^ASUMX(D1,1,0))

               Begin DoDot:1

 +2                KILL ^UTILITY($JOB,"W")

 +3                SET DIWL=1

                   SET DIWR=20

                   SET DIWF="C30"

 +4                SET ASUC("D1")=$PIECE(^ASUMX(D1,1,0),U,3)

 +5                FOR ASUC("D2")=1:1:ASUC("D1")

                       SET X=^ASUMX(D1,1,ASUC("D2"),0)

                       Begin DoDot:2

 +6                        DO ^DIWP

                       End DoDot:2

 +7                FOR ASUC("D3")=0:0

                       SET ASUC("D3")=$ORDER(^UTILITY($JOB,"W",DIWL,ASUC("D3")))

                       IF ASUC("D3")']""

                           QUIT 

                       Begin DoDot:2

 +8                        SET ASU1(ASUC("D3"))=^UTILITY($JOB,"W",DIWL,ASUC("D3"),0)

                       End DoDot:2

 +9                SET ASUC("D")=$GET(ASUC("D"))+ASUC("D3")

               End DoDot:1

 +10      IF '$TEST

               Begin DoDot:1

 +11               SET ASU1(1)=$PIECE(^ASUMX(D1,0),U,2)

 +12               SET ASU1(2)=$PIECE(^ASUMX(D1,0),U,3)

 +13               SET ASUC("D")=2

               End DoDot:1

 +14       KILL ASUC("D2")

 +15       WRITE ?10,ASU1(1)

 +16       KILL ASUC("D1"),ASUC("D2"),ASUC("D3"),DIWL,DIWR

 +17       QUIT 

WDESC     ;EP;WRITE WORD PROCESSING DESCRIPTION

 +1        IF ASUC("D")<3

               QUIT 

 +2        FOR ASUC("D2")=3:1:ASUC("D")

               WRITE !?10,ASU1(ASUC("D2"))

 +3        KILL ASUC("D"),ASUC("D2"),ASU1

 +4        QUIT