- ASURD10P ; IHS/ITSC/LMH -RPT 10A -LST DIRECT ISSUE TRANS ; [ 07/18/2000 7:59 AM ]
- ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
- ;This routine formats and prints report 10, Direct Issues
- ;Transaction List.
- ;K ^XTMP("ASUR","R10A")
- ;S ^XTMP("ASUR","R10A",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
- EN ;EP;PRIMARY ENTRY POINT FOR REPORT 10
- 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^ASURD10P",ZTDESC="SAMS RPT 10A" 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 CMPT ;JDH D:'$D(^XTMP("ASUR","R10A")) CMPT
- D U^ASUUZIS
- S ASUV("RPT")="R10A",ASUQ("HDR")="HEADER^ASURD10P"
- D ^ASUUDATA I ASUX("NDTA") G K
- S (ASUX("VO"),ASUX("SQ"))="",(ASUC("TOT"),ASUC("VALTOT"))=0
- F S ASUX("AS")=$O(^XTMP("ASUR","R10A",ASUX("AS"))) Q:ASUX("AS")="" D Q:$D(DUOUT)
- .I ASUV("ARST")'=ASUX("AS") D HEADER Q:$D(DUOUT)
- .S ASUV("ARST")=ASUX("AS")
- .F S ASUX("VO")=$O(^XTMP("ASUR","R10A",ASUX("AS"),ASUX("VO"))) Q:ASUX("VO")="" D Q:$D(DUOUT)
- ..F S ASUX("SQ")=$O(^XTMP("ASUR","R10A",ASUX("AS"),ASUX("VO"),ASUX("SQ"))) Q:ASUX("SQ")="" D Q:$D(DUOUT)
- ...S ASUHDA=(^XTMP("ASUR","R10A",ASUX("AS"),ASUX("VO"),ASUX("SQ")))
- ...D READ^ASU0TRRD(.ASUHDA,"H") Q:$G(ASUT)']""
- ...I ASUC("LN")>(IOSL-2) D HEADER Q:$D(DUOUT)
- ...S ASUX("VAL")=ASUT(ASUT,"VAL")
- ...S ASUC("TOT")=ASUC("TOT")+1
- ...S:"0K0M0O0N"[ASUT("TRCD") ASUC("VALTOT")=ASUC("VALTOT")-ASUX("VAL")
- ...S:"02040506"[ASUT("TRCD") ASUC("VALTOT")=ASUC("VALTOT")+ASUX("VAL")
- ...W !?3,ASUT(ASUT,"VOU"),?15,ASUT("TRCD"),?21,$J(ASUT(ASUT,"QTY","ISS"),6)
- ...S ASUC("LN")=ASUC("LN")+1
- ...W ?29,$J($FN(ASUX("VAL"),",",2),9)
- ...W:"0K0M0O0N"[ASUT("TRCD") ?39,"-"
- ...W ?41,ASUT(ASUT,"ACC")
- ...S ASUV("SOBJ")=ASUT(ASUT,"SOBJ")
- ...W:ASUV("SOBJ")]"" ?47,$E(ASUV("SOBJ"),1,2)_"."_$E(ASUV("SOBJ"),3,4)
- ...W ?57,ASUT(ASUT,"SSA"),?62,ASUT(ASUT,"CAN")
- ...W ?70,ASUT(ASUT,"USR"),?75,ASUT(ASUT,"SST"),?82,ASUT(ASUT,"SRC"),?87,ASUT(ASUT,"PON")
- .D:ASUC("LN")>(IOSL-4) HEADER
- .W !!?2,"NUMBER LINE ITEMS: ",$J(ASUC("TOT"),6)
- .W !?2,"TOTAL VALUE:$ ",?29,$J($FN(ASUC("VALTOT"),",",2),9)
- .S ASUC("VALTOT")=0
- K ;
- K ASUX,ASUV,ASUC,ASUQ,ASUL(2),^XTMP("ASUR","R10A")
- D PAZ^ASUURHDR
- I ASUK("PTRSEL")]"" Q
- D C^ASUUZIS
- Q
- CMPT ;EP;COMPUTE REPORT CONTENTS
- K ^XTMP("ASUR","R10A") S ^XTMP("ASUR","R10A",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM") N Z
- D:$G(ASUN("TYP"))']"" ^ASUURANG
- F Z="02","04","05","06","0K","0M","0N","0O" D
- .S ASUHDA=$G(ASUN("B#"))-1
- .F S ASUHDA=$O(^ASUH("T",Z,ASUHDA)) Q:ASUHDA>$G(ASUN("E#")) Q:ASUHDA']"" D
- ..D READ^ASU0TRRD(.ASUHDA,"H") Q:$G(ASUT)']"" Q:$P(ASUT(ASUT,"TRKY"),"-")'=ASUL(2,"STA","E#")
- ..;S ^XTMP("ASUR","R10A",ASUT(ASUT,"PT","STA"),ASUT(ASUT,"VOU"),ASUHDA)=ASUHDA
- Q
- DUMB ;
- F Z="5C","5D" D
- S ASUC("PG")=$G(ASUC("PG"))+1
- I ASUC("PG")>1 D PAZ^ASUURHDR Q:$D(DUOUT) W @IOF
- W !?5,"REPORT #10A. LIST DIRECT ISSUE TRANSACTIONS"
- 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,"VOUCHER",?14,"TRAN",?22,"NUMBER",?32,"VALUE",?39,"ACCOUNT",?47,"OBJECT",?54,"SUB SUB",?63,"CAN",?69,"USER",?75,"SUB",?80,"SOURCE",?88,"PURCHASE"
- W !?3,"NUMBER",?14,"CODE",?20,"LINE ITEMS",?40,"CODE",?46,"SUB OBJ",?56,"ACT",?69,"CODE",?75,"STAT",?81,"CODE",?89,"ORDER"
- W !,"------------------------------------------------------------------------------------------------------------------------------------",!!
- S ASUC("LN")=9
- Q
- ASURD10P ; IHS/ITSC/LMH -RPT 10A -LST DIRECT ISSUE TRANS ; [ 07/18/2000 7:59 AM ]
- +1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
- +2 ;This routine formats and prints report 10, Direct Issues
- +3 ;Transaction List.
- +4 ;K ^XTMP("ASUR","R10A")
- +5 ;S ^XTMP("ASUR","R10A",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
- EN ;EP;PRIMARY ENTRY POINT FOR REPORT 10
- +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^ASURD10P"
- SET ZTDESC="SAMS RPT 10A"
- 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 ;JDH D:'$D(^XTMP("ASUR","R10A")) CMPT
- DO CMPT
- +2 DO U^ASUUZIS
- +3 SET ASUV("RPT")="R10A"
- SET ASUQ("HDR")="HEADER^ASURD10P"
- +4 DO ^ASUUDATA
- IF ASUX("NDTA")
- GOTO K
- +5 SET (ASUX("VO"),ASUX("SQ"))=""
- SET (ASUC("TOT"),ASUC("VALTOT"))=0
- +6 FOR
- SET ASUX("AS")=$ORDER(^XTMP("ASUR","R10A",ASUX("AS")))
- IF ASUX("AS")=""
- QUIT
- Begin DoDot:1
- +7 IF ASUV("ARST")'=ASUX("AS")
- DO HEADER
- IF $DATA(DUOUT)
- QUIT
- +8 SET ASUV("ARST")=ASUX("AS")
- +9 FOR
- SET ASUX("VO")=$ORDER(^XTMP("ASUR","R10A",ASUX("AS"),ASUX("VO")))
- IF ASUX("VO")=""
- QUIT
- Begin DoDot:2
- +10 FOR
- SET ASUX("SQ")=$ORDER(^XTMP("ASUR","R10A",ASUX("AS"),ASUX("VO"),ASUX("SQ")))
- IF ASUX("SQ")=""
- QUIT
- Begin DoDot:3
- +11 SET ASUHDA=(^XTMP("ASUR","R10A",ASUX("AS"),ASUX("VO"),ASUX("SQ")))
- +12 DO READ^ASU0TRRD(.ASUHDA,"H")
- IF $GET(ASUT)']""
- QUIT
- +13 IF ASUC("LN")>(IOSL-2)
- DO HEADER
- IF $DATA(DUOUT)
- QUIT
- +14 SET ASUX("VAL")=ASUT(ASUT,"VAL")
- +15 SET ASUC("TOT")=ASUC("TOT")+1
- +16 IF "0K0M0O0N"[ASUT("TRCD")
- SET ASUC("VALTOT")=ASUC("VALTOT")-ASUX("VAL")
- +17 IF "02040506"[ASUT("TRCD")
- SET ASUC("VALTOT")=ASUC("VALTOT")+ASUX("VAL")
- +18 WRITE !?3,ASUT(ASUT,"VOU"),?15,ASUT("TRCD"),?21,$JUSTIFY(ASUT(ASUT,"QTY","ISS"),6)
- +19 SET ASUC("LN")=ASUC("LN")+1
- +20 WRITE ?29,$JUSTIFY($FNUMBER(ASUX("VAL"),",",2),9)
- +21 IF "0K0M0O0N"[ASUT("TRCD")
- WRITE ?39,"-"
- +22 WRITE ?41,ASUT(ASUT,"ACC")
- +23 SET ASUV("SOBJ")=ASUT(ASUT,"SOBJ")
- +24 IF ASUV("SOBJ")]""
- WRITE ?47,$EXTRACT(ASUV("SOBJ"),1,2)_"."_$EXTRACT(ASUV("SOBJ"),3,4)
- +25 WRITE ?57,ASUT(ASUT,"SSA"),?62,ASUT(ASUT,"CAN")
- +26 WRITE ?70,ASUT(ASUT,"USR"),?75,ASUT(ASUT,"SST"),?82,ASUT(ASUT,"SRC"),?87,ASUT(ASUT,"PON")
- End DoDot:3
- IF $DATA(DUOUT)
- QUIT
- End DoDot:2
- IF $DATA(DUOUT)
- QUIT
- +27 IF ASUC("LN")>(IOSL-4)
- DO HEADER
- +28 WRITE !!?2,"NUMBER LINE ITEMS: ",$JUSTIFY(ASUC("TOT"),6)
- +29 WRITE !?2,"TOTAL VALUE:$ ",?29,$JUSTIFY($FNUMBER(ASUC("VALTOT"),",",2),9)
- +30 SET ASUC("VALTOT")=0
- End DoDot:1
- IF $DATA(DUOUT)
- QUIT
- K ;
- +1 KILL ASUX,ASUV,ASUC,ASUQ,ASUL(2),^XTMP("ASUR","R10A")
- +2 DO PAZ^ASUURHDR
- +3 IF ASUK("PTRSEL")]""
- QUIT
- +4 DO C^ASUUZIS
- +5 QUIT
- CMPT ;EP;COMPUTE REPORT CONTENTS
- +1 KILL ^XTMP("ASUR","R10A")
- SET ^XTMP("ASUR","R10A",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
- NEW Z
- +2 IF $GET(ASUN("TYP"))']""
- DO ^ASUURANG
- +3 FOR Z="02","04","05","06","0K","0M","0N","0O"
- Begin DoDot:1
- +4 SET ASUHDA=$GET(ASUN("B#"))-1
- +5 FOR
- SET ASUHDA=$ORDER(^ASUH("T",Z,ASUHDA))
- IF ASUHDA>$GET(ASUN("E#"))
- QUIT
- IF ASUHDA']""
- QUIT
- Begin DoDot:2
- +6 DO READ^ASU0TRRD(.ASUHDA,"H")
- IF $GET(ASUT)']""
- QUIT
- IF $PIECE(ASUT(ASUT,"TRKY"),"-")'=ASUL(2,"STA","E#")
- QUIT
- +7 ;S ^XTMP("ASUR","R10A",ASUT(ASUT,"PT","STA"),ASUT(ASUT,"VOU"),ASUHDA)=ASUHDA
- End DoDot:2
- End DoDot:1
- +8 QUIT
- DUMB ;
- +1 FOR Z="5C","5D"
- Begin DoDot:1
- End DoDot:1
- +1 SET ASUC("PG")=$GET(ASUC("PG"))+1
- +2 IF ASUC("PG")>1
- DO PAZ^ASUURHDR
- IF $DATA(DUOUT)
- QUIT
- WRITE @IOF
- +3 WRITE !?5,"REPORT #10A. LIST DIRECT ISSUE TRANSACTIONS"
- +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,"VOUCHER",?14,"TRAN",?22,"NUMBER",?32,"VALUE",?39,"ACCOUNT",?47,"OBJECT",?54,"SUB SUB",?63,"CAN",?69,"USER",?75,"SUB",?80,"SOURCE",?88,"PURCHASE"
- +11 WRITE !?3,"NUMBER",?14,"CODE",?20,"LINE ITEMS",?40,"CODE",?46,"SUB OBJ",?56,"ACT",?69,"CODE",?75,"STAT",?81,"CODE",?89,"ORDER"
- +12 WRITE !,"------------------------------------------------------------------------------------------------------------------------------------",!!
- +13 SET ASUC("LN")=9
- +14 QUIT
