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
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
+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
