Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ASURM23P

ASURM23P.m

Go to the documentation of this file.
  1. ASURM23P ; IHS/ITSC/LMH -RPT 23 LIST OVERSTOCK/INACTV ;
  1. ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
  1. ;This routine formats and prints report 23, List Overstocked and
  1. ;Inactive Items from sorted extracts.
  1. EN ;EP;PRIMARY ENTRY POINT FOR REPORT 21
  1. I '$D(IO) D HOME^%ZIS
  1. I '$D(DUZ(2)) W !,"Report must be run from Kernel option" Q
  1. I '$D(ASUL(1,"AR","AP")) D SETAREA^ASULARST
  1. S ASUK("PTRSEL")=$G(ASUK("PTRSEL")) I ASUK("PTRSEL")]"" G PSER
  1. S ZTRTN="PSER^ASUD23P",ZTDESC="SAMS RPT 23" D O^ASUUZIS
  1. I POP S IOP=$I D ^%ZIS Q
  1. I ASUK(ASUK("PTR"),"Q") Q
  1. PSER ;EP;FOR TASKMAN QUEUE OF PRINT
  1. N X,Y,Z
  1. D:'$D(^XTMP("ASUR","R23")) SORT
  1. Q:$O(^XTMP("ASUR","R23",0))="" ;WAR 10/1/99 no data for Dir Issue
  1. D U^ASUUZIS
  1. S (ASUC("PG"),ASUMS("E#","ARE"))=0
  1. S ASUMS("E#","ARE")=$O(^XTMP("ASUR","R23",0)) D ARE^ASULARST($E(ASUMS("E#","ARE"),1,2))
  1. S ASURX("ACC")=$O(^XTMP("ASUR","R23",ASUMS("E#","ARE"),0)) D ACC^ASULDIRF(ASURX("ACC")),ACCTGP
  1. S ASUV("RPT")="R23",ASUQ("HDR")="HEADER^ASURM23P"
  1. D ^ASUUDATA I ASUX("NDTA") G K
  1. S (ASUC("PG"),ASUMS("E#","ARE"))=0
  1. F S ASUMS("E#","ARE")=$O(^XTMP("ASUR","R23",ASUMS("E#","ARE"))) Q:ASUMS("E#","ARE")']"" D Q:$D(DUOUT) Q:$D(DTOUT)
  1. .D ARE^ASULARST($E(ASUMS("E#","ARE"),1,2))
  1. .S ASURX("ACC")=0
  1. .F S ASURX("ACC")=$O(^XTMP("ASUR","R23",ASUMS("E#","ARE"),ASURX("ACC"))) Q:ASURX("ACC")']"" D Q:$D(DUOUT) Q:$D(DTOUT)
  1. ..D ACC^ASULDIRF(ASURX("ACC")),ACCTGP
  1. ..S ASUV("ACCGP")=$G(ASUL(9,"ACC","GP"))
  1. ..S ASUMS("E#","IDX")=0
  1. ..D:ASUC("LINE")>(IOSL-2) HEADER Q:$D(DTOUT) Q:$D(DUOUT)
  1. ..F S ASUMS("E#","IDX")=$O(^XTMP("ASUR","R23",ASUMS("E#","ARE"),ASURX("ACC"),ASUMS("E#","IDX"))) Q:ASUMS("E#","IDX")']"" D Q:$D(DUOUT) Q:$D(DTOUT)
  1. ...S ASUMX("E#","IDX")=ASUMS("E#","IDX")
  1. ...D READ^ASUMXDIO
  1. ...W !?2,$E(ASUMX("IDX"),1,5),".",$E(ASUMX("IDX"),6),?15,ASUMX("DESC",1)," ",ASUMX("DESC",2),?85,ASUMX("AR U/I")
  1. ...S ASUC("LINE")=ASUC("LINE")+2
  1. ...S ASUMS("E#","STA")=0
  1. ...F S ASUMS("E#","STA")=$O(^XTMP("ASUR","R23",ASUMS("E#","ARE"),ASURX("ACC"),ASUMS("E#","IDX"),ASUMS("E#","STA"))) Q:ASUMS("E#","STA")']"" D Q:$D(DUOUT) Q:$D(DTOUT)
  1. ....S ASUX(0)=^XTMP("ASUR","R23",ASUMS("E#","ARE"),ASURX("ACC"),ASUMS("E#","IDX"),ASUMS("E#","STA"))
  1. ....S ASUC(0,0,"QTY")=$P(ASUX(0),U),ASUV("AST")=$P(ASUX(0),U,2)
  1. ....D STA^ASULARST(ASUMS("E#","STA")),^ASUMSTRD
  1. ....S ASUC(1,ASUMS("E#","STA"))=$E(ASUL(2,"STA","NM"),1,22)
  1. ....W !?4,$E(ASUL(2,"STA","NM"),1,22),?26,ASUMS("SLC")
  1. ....D NSNFMT W ?28,ASUV("NSN"),?48,ASUMS("VENAM"),?65,ASUMS("EOQ","TP")
  1. ....W ?68,$J($FN(ASUC(0,0,"QTY"),","),7),ASUV("AST"),?80,$J($FN(ASUMS("CST/U"),",",2),8)
  1. ....S ASUC(0,0,"VAL")=(ASUC(0,0,"QTY")*(+ASUMS("CST/U")))
  1. ....W ?90,$J($FN(ASUC(0,0,"VAL"),",",2),10),?101,$G(ASUL(2,"STA","CTP")),?116,$G(ASUL(2,"STA","TP#"))
  1. ....S ASUC("LINE")=ASUC("LINE")+1
  1. ....S ASUC(0,0,"LI")=1
  1. ....S ASUV("STA")=ASUMS("E#","STA") D ROLL(0)
  1. ...Q:$D(DTOUT) Q:$D(DUOUT)
  1. ...D STALOOP(0,"ITEM") Q:$D(DTOUT) Q:$D(DUOUT)
  1. ...D:ASUC("LINE")>(IOSL-2) HEADER
  1. ..Q:$D(DTOUT) Q:$D(DUOUT)
  1. ..W !! S Y="ACCOUNT "_ASUV("ACCGP") D STALOOP(1,Y) Q:$D(DTOUT) Q:$D(DUOUT)
  1. ..D HEADER Q:$D(DUOUT) Q:$D(DTOUT)
  1. .Q:$D(DTOUT) Q:$D(DUOUT)
  1. .W !!! S Y="AREA "_ASUL(1,"AR","NM") D STALOOP(2,Y) Q:$D(DTOUT) Q:$D(DUOUT)
  1. .S ASUC("LINE")=IOSL
  1. K ;
  1. D PAZ^ASUURHDR I ASUK("PTRSEL")']"" D
  1. .D C^ASUUZIS
  1. K ASUMX,ASUMS,ASURX,ASUX,ASUC
  1. Q
  1. ACCTGP ;
  1. S ASUL(9,"ACC","GP")=$S(ASURX("ACC")=1:ASUL(9,"ACC","NM"),ASURX("ACC")=3:ASUL(9,"ACC","NM"),1:"GENERAL SUPPLIES")
  1. S ASUV("PRTACC")=$S(ASUL(9,"ACC","GP")="GENERAL SUPPLIES":"*",1:ASURX("ACC"))
  1. Q
  1. NSNFMT ;
  1. I ASUMS("ORD#")]"" D
  1. .I $E(ASUMS("ORD#"))="M" S ASUV("NSN")=ASUMS("ORD#") Q
  1. .I ASUMS("ORD#")]"" S ASUV("NSN")=ASUMS("ORD#")
  1. .E S ASUV("NSN")=ASUMX("NSN")
  1. .I $L(ASUV("NSN"))=4 Q
  1. .S ASUV("NSN")=$E(ASUV("NSN"),1,4)_"-"_$E(ASUV("NSN"),5,$L(ASUV("NSN")))
  1. .I $L(ASUV("NSN"))>7 S ASUV("NSN")=$E(ASUV("NSN"),1,7)_"-"_$E(ASUV("NSN"),8,$L(ASUV("NSN")))
  1. .I $L(ASUV("NSN"))>11 S ASUV("NSN")=$E(ASUV("NSN"),1,11)_"-"_$E(ASUV("NSN"),12,$L(ASUV("NSN")))
  1. Q
  1. N X,Y
  1. S ASUC("PG")=$G(ASUC("PG"))+1,ASUC("LINE")=6
  1. I ASUC("PG")>1 D PAZ^ASUURHDR
  1. Q:$D(DTOUT) Q:$D(DUOUT)
  1. W @(IOF),"REPORT #23 LISTING OF OVERSTOCKED SUPPLIES",?90,ASUK("DT"),?110,"PAGE",?115,$J($FN(ASUC("PG"),","),7)
  1. W !,"AREA",?6,ASUL(1,"AR","AP"),?9,ASUL(1,"AR","NM")
  1. W !,?50,"G L ACCOUNT 125.",ASUV("PRTACC"),?68,ASUL(9,"ACC","GP"),!
  1. W !?4,"INDEX",?20,"DESCRIPTION",?84,"UI"
  1. W !?6,"STATION",?25,"SLC",?29,"ORDER NUMBER",?50,"VENDOR NAME",?65,"TC",?70,"QTY",?83,"U/COST",?93,"T-VALUE",?101,"CONTACT PERSON TELEPHONE #",!
  1. Q
  1. STALOOP(X,Y) ;
  1. S ASUV("STA")=""
  1. F ASUC=1:1 S ASUV("STA")=$O(ASUC(X,ASUV("STA"))) Q:ASUV("STA")']"" D Q:$D(DUOUT) Q:$D(DTOUT)
  1. .I ASUC'>1 W !?20,"STATIONS TOTALS FOR ",Y S ASUC("LINE")=$G(ASUC("LINE"))+1 I X>0 W ! S ASUC("LINE")=$G(ASUC("LINE"))+2
  1. .I X>0 D
  1. ..D ROLL(X)
  1. ..W ?30,ASUC(X,ASUV("STA"))
  1. ..W ?68,$J($FN(ASUC(X,ASUV("STA"),"QTY"),","),7),?90,$J($FN(ASUC(X,ASUV("STA"),"VAL"),",",2),10),?105,"LI - ",$J($FN($G(ASUC(X,ASUV("STA"),"LI")),","),8),!
  1. ..S ASUC("LINE")=$G(ASUC("LINE"))+1
  1. .S ASUC("TQTY")=$G(ASUC("TQTY"))+ASUC(X,ASUV("STA"),"QTY")
  1. .S ASUC("TVAL")=$G(ASUC("TVAL"))+ASUC(X,ASUV("STA"),"VAL")
  1. .S ASUC("TLI")=$G(ASUC("TLI"))+ASUC(X,ASUV("STA"),"LI")
  1. .K ASUC(X,ASUV("STA"))
  1. W ?68,"_______ __________"
  1. W:X>0 ?110,"________"
  1. W !?68,$J($FN(ASUC("TQTY"),","),7),?90,$J($FN(ASUC("TVAL"),",",2),10)
  1. I X>0 W ?110,$J($FN($G(ASUC("TLI")),","),8)
  1. W !
  1. D:ASUC("LINE")>(IOSL-2) HEADER
  1. Q:$D(DTOUT) Q:$D(DUOUT)
  1. K ASUC("TQTY"),ASUC("TVAL")
  1. S ASUC("LINE")=$G(ASUC("LINE"))+2
  1. Q
  1. ROLL(X) ;
  1. S ASUV("STF")=$S(X=0:0,1:ASUV("STA"))
  1. I X>0 S ASUC(X+1,ASUV("STA"))=ASUC(X,ASUV("STF"))
  1. S ASUC(X+1,ASUV("STA"),"QTY")=$G(ASUC(X+1,ASUV("STA"),"QTY"))+$G(ASUC(X,ASUV("STF"),"QTY"))
  1. S ASUC(X+1,ASUV("STA"),"VAL")=$G(ASUC(X+1,ASUV("STA"),"VAL"))+$G(ASUC(X,ASUV("STF"),"VAL"))
  1. S ASUC(X+1,ASUV("STA"),"LI")=$G(ASUC(X+1,ASUV("STA"),"LI"))+$G(ASUC(X,ASUV("STF"),"LI"))
  1. Q
  1. SORT ;EP ;
  1. K ^XTMP("ASUR","R23")
  1. S ^XTMP("ASUR","R23",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
  1. S ASUMS("E#","STA")=0
  1. F S ASUMS("E#","STA")=$O(^ASUMS(ASUMS("E#","STA"))) Q:ASUMS("E#","STA")'?1N.N D
  1. .F ASUMS("E#","IDX")=0:0 S ASUMS("E#","IDX")=$O(^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX"))) Q:ASUMS("E#","IDX")'?1N.N D
  1. ..S ASUMS("LSTISS")=$P(^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX"),0),U,13)
  1. ..S ASUV("LIMOS")=$E(ASUK("DT","FM"),1,5)-$E(ASUMS("LSTISS"),1,5)
  1. ..D ^ASUMSTRD
  1. ..Q:ASUMS("QTY","O/H")'>0
  1. ..S ASUMX("ACC")=$P($G(^ASUMX(ASUMS("E#","IDX"),0)),U,6)
  1. ..Q:ASUMX("ACC")']""
  1. ..S ASUMX("ACCTYP")=$S(ASUMX("ACC")=1:1,ASUMX("ACC")=3:3,1:4)
  1. ..I ASUV("LIMOS")>12 D
  1. ...S ASUC(0,0,"QTY")=ASUMS("QTY","O/H"),ASUV("AST")="*"
  1. ..E D Q:ASUC(0,0,"QTY")']""
  1. ...I "PN"[ASUMS("EOQ","TP") S ASUC(0,0,"QTY")="" Q
  1. ...S ASUV("QTYNEED")=(ASUMS("PMIQ")*12)+ASUMS("RPQ"),ASUC(0,0,"QTY")=ASUMS("QTY","O/H")-ASUV("QTYNEED")
  1. ...I ASUC(0,0,"QTY")<1 S ASUC(0,0,"QTY")="" Q
  1. ...S ASUV("AST")=""
  1. ..S ASUMS("E#","ARE")=$E(ASUMS("E#","STA"),1,2)
  1. ..S ^XTMP("ASUR","R23",ASUMS("E#","ARE"),ASUMX("ACCTYP"),ASUMS("E#","IDX"),ASUMS("E#","STA"))=ASUC(0,0,"QTY")_U_ASUV("AST")
  1. Q