ASURD01P.m

ASURD01P ; IHS/ITSC/LMH -TRANS COUNTS REPORT ; 

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

 ;This routine formats and prints report 1 from sorted extracts.

EN ;EP;PRIMARY ENTRY POINT FOR REPORT 01

 ; JDH

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

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

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

PSER ;EP;FOR TASKMAN QUEUE OF PRINT

 ; JDH

 D U^ASUUZIS

 I ($D(ASUK("DT"))#10)=0 D ^ASUUDATE

 ;N X,Y S (X,Y)=$P(^XTMP("ASUR","R01",0),U,2) I Y'=ASUK("DT","FM") D SETDT^ASUUDATE(X)

 ; JDH N X,Y S (X,Y)=$P(^XTMP("ASUR01",0),U,2) I Y'=ASUK("DT","FM") D SETDT^ASUUDATE(X)

 D HEADER

 S ASUR("TR")="",ASUV("TY")=""

 F  S ASUR("TR")=$O(^XTMP("ASUR","R01",3,ASUR("TR"))) Q:ASUR("TR")']""  D

 .D TRN^ASULARST(ASUR("TR"))

 .I ASUL(11,"TRN","TYPE")'=ASUV("TY") D

 ..I $G(ASUC(1))]"" W !?50,"_______",?60,"_______",?70,"_______",!?33,"SUB TOT:",?50,$J($FN($P(ASUC(1),U,1),",",0),7),?60,$J($FN($P(ASUC(1),U,2),",",0),7),?70,$J($FN($P(ASUC(1),U,3),",",0),7)

 ..F X=1:1:3 S $P(ASUC(2),U,X)=$P($G(ASUC(2)),U,X)+$P($G(ASUC(1)),U,X)

 ..K ASUC(1)

 ..W !!?2,ASUL(11,"TRN","TYPN") S ASUV("TY")=ASUL(11,"TRN","TYPE")

 .E  D

 ..W !

 .W ?14,ASUL(11,"TRN","DBCR"),?22,ASUL(11,"TRN","EXTN")," ",$S(ASUL(11,"TRN","REV")=1:"REVERSAL",1:"")

 .S ASUC(0)=$P($G(^XTMP("ASUR","R01",1,ASUR("TR"))),U,2)_U_$P($G(^XTMP("ASUR","R01",2,ASUR("TR"))),U,2)_U_$P($G(^XTMP("ASUR","R01",3,ASUR("TR"))),U,2)

 .W ?50,$J($FN($P(ASUC(0),U,1),",",0),7),?60,$J($FN($P(ASUC(0),U,2),",",0),7),?70,$J($FN($P(ASUC(0),U,3),",",0),7)

 .F X=1:1:3 S $P(ASUC(1),U,X)=$P($G(ASUC(1)),U,X)+$P($G(ASUC(0)),U,X)

 I $G(ASUC(1))]"" W !?50,"_______",?60,"_______",?70,"_______",!?33,"SUB TOT:",?50,$J($FN($P(ASUC(1),U,1),",",0),7),?60,$J($FN($P(ASUC(1),U,2),",",0),7),?70,$J($FN($P(ASUC(1),U,3),",",0),7)

 F X=1:1:3 S $P(ASUC(2),U,X)=$P($G(ASUC(2)),U,X)+$P($G(ASUC(1)),U,X)

 W !!?50,"_______",?60,"_______",?70,"_______",!?30,"TOTAL:",?50,$J($FN($P($G(ASUC(2)),U,1),",",0),7),?60,$J($FN($P($G(ASUC(2)),U,2),",",0),7),?70,$J($FN($P($G(ASUC(2)),U,3),",",0),7)

 D PAZ^ASUURHDR

 K ASUX("E#"),ASUR,ASUR,ASUTR,ASUT,ASUC

 K DA,ASUX(0),DI,DIC,DIE,DQ,DR,X

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

 D C^ASUUZIS

 Q

HEADER ;

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

 D CLS^ASUUHDG

 W !?2,"REPORT #1.    TRANSACTION COUNTS",?50,"DATE: ",ASUK("DT","MO"),"/",ASUK("DT","DA"),"/",ASUK("DT","YR"),?65,"PAGE: ",ASUC("PG")

 W !?2,"TYPE",?13,"Db/Cr",?21,"TRANSACTION",?54,"DAILY   MONTHLY  YR TO DT",!?54,"COUNT     COUNT     COUNT"

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

 Q

ASURD01P  ; IHS/ITSC/LMH -TRANS COUNTS REPORT ; 

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

 +2       ;This routine formats and prints report 1 from sorted extracts.

EN        ;EP;PRIMARY ENTRY POINT FOR REPORT 01

 +1       ; JDH

 +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^ASURD01P"

           SET ZTDESC="SAMS RPT 01"

           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       ; JDH

 +2        DO U^ASUUZIS

 +3        IF ($DATA(ASUK("DT"))#10)=0

               DO ^ASUUDATE

 +4       ;N X,Y S (X,Y)=$P(^XTMP("ASUR","R01",0),U,2) I Y'=ASUK("DT","FM") D SETDT^ASUUDATE(X)

 +5       ; JDH N X,Y S (X,Y)=$P(^XTMP("ASUR01",0),U,2) I Y'=ASUK("DT","FM") D SETDT^ASUUDATE(X)

 +6        DO HEADER

 +7        SET ASUR("TR")=""

           SET ASUV("TY")=""

 +8        FOR 

               SET ASUR("TR")=$ORDER(^XTMP("ASUR","R01",3,ASUR("TR")))

               IF ASUR("TR")']""

                   QUIT 

               Begin DoDot:1

 +9                DO TRN^ASULARST(ASUR("TR"))

 +10               IF ASUL(11,"TRN","TYPE")'=ASUV("TY")

                       Begin DoDot:2

 +11                       IF $GET(ASUC(1))]""

                               WRITE !?50,"_______",?60,"_______",?70,"_______",!?33,"SUB TOT:",?50,$JUSTIFY($FNUMBER($PIECE(ASUC(1),U,1),",",0),7),?60,$JUSTIFY($FNUMBER($PIECE(ASUC(1),U,2),",",0),7),?70,$JUSTIFY($FNUMBER($PIECE(ASUC(1),U,3),",",0),7)

 +12                       FOR X=1:1:3

                               SET $PIECE(ASUC(2),U,X)=$PIECE($GET(ASUC(2)),U,X)+$PIECE($GET(ASUC(1)),U,X)

 +13                       KILL ASUC(1)

 +14                       WRITE !!?2,ASUL(11,"TRN","TYPN")

                           SET ASUV("TY")=ASUL(11,"TRN","TYPE")

                       End DoDot:2

 +15              IF '$TEST

                       Begin DoDot:2

 +16                       WRITE !

                       End DoDot:2

 +17               WRITE ?14,ASUL(11,"TRN","DBCR"),?22,ASUL(11,"TRN","EXTN")," ",$SELECT(ASUL(11,"TRN","REV")=1:"REVERSAL",1:"")

 +18               SET ASUC(0)=$PIECE($GET(^XTMP("ASUR","R01",1,ASUR("TR"))),U,2)_U_$PIECE($GET(^XTMP("ASUR","R01",2,ASUR("TR"))),U,2)_U_$PIECE($GET(^XTMP("ASUR","R01",3,ASUR("TR"))),U,2)

 +19               WRITE ?50,$JUSTIFY($FNUMBER($PIECE(ASUC(0),U,1),",",0),7),?60,$JUSTIFY($FNUMBER($PIECE(ASUC(0),U,2),",",0),7),?70,$JUSTIFY($FNUMBER($PIECE(ASUC(0),U,3),",",0),7)

 +20               FOR X=1:1:3

                       SET $PIECE(ASUC(1),U,X)=$PIECE($GET(ASUC(1)),U,X)+$PIECE($GET(ASUC(0)),U,X)

               End DoDot:1

 +21       IF $GET(ASUC(1))]""

               WRITE !?50,"_______",?60,"_______",?70,"_______",!?33,"SUB TOT:",?50,$JUSTIFY($FNUMBER($PIECE(ASUC(1),U,1),",",0),7),?60,$JUSTIFY($FNUMBER($PIECE(ASUC(1),U,2),",",0),7),?70,$JUSTIFY($FNUMBER($PIECE(ASUC(1),U,3),",",0),7)

 +22       FOR X=1:1:3

               SET $PIECE(ASUC(2),U,X)=$PIECE($GET(ASUC(2)),U,X)+$PIECE($GET(ASUC(1)),U,X)

 +23       WRITE !!?50,"_______",?60,"_______",?70,"_______",!?30,"TOTAL:",?50,$JUSTIFY($FNUMBER($PIECE($GET(ASUC(2)),U,1),",",0),7),?60,$JUSTIFY($FNUMBER($PIECE($GET(ASUC(2)),U,2),",",0),7),?70,$JUSTIFY($FNUMBER($PIECE($GET(ASUC(2)),U,3),",",0),7)

 +24       DO PAZ^ASUURHDR

 +25       KILL ASUX("E#"),ASUR,ASUR,ASUTR,ASUT,ASUC

 +26       KILL DA,ASUX(0),DI,DIC,DIE,DQ,DR,X

 +27       IF $GET(ASUK("PTRSEL"))]""

               WRITE @IOF

               QUIT 

 +28       DO C^ASUUZIS

 +29       QUIT 

HEADER    ;

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

 +2        DO CLS^ASUUHDG

 +3        WRITE !?2,"REPORT #1.    TRANSACTION COUNTS",?50,"DATE: ",ASUK("DT","MO"),"/",ASUK("DT","DA"),"/",ASUK("DT","YR"),?65,"PAGE: ",ASUC("PG")

 +4        WRITE !?2,"TYPE",?13,"Db/Cr",?21,"TRANSACTION",?54,"DAILY   MONTHLY  YR TO DT",!?54,"COUNT     COUNT     COUNT"

 +5        WRITE !,"-------------------------------------------------------------------------------",!!

 +6        QUIT