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

ASURO80P.m

Go to the documentation of this file. 
  1. ASURO80P ; IHS/ITSC/LMH -RPT 80 ISS-ANAL STATION DRIVER ; 
  1.  ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
  1.  ;This routine formats and prints report 80, Analysis of Stock Issues
  1.  ;by selected criteria Report.
  1. EN ;EP;PRIMARY ENTRY POINT FOR REPORT 80
  1.  Q  ;WAR 5/21/99
  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.  D ^ASURO800
  1.  Q:$D(DTOUT)  Q:$D(DUOUT)  ;DFM P1 9/15/98
  1.  S ZTRTN="PSER^ASURO80P",ZTDESC="SAMS RPT 80" 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.  G:$D(DTOUT) K G:$D(DUOUT) K
  1.  D U^ASUUZIS
  1.  S ASUF("HDR")=1
  1.  S ASUX("STA")=$O(^XTMP("ASUR","R80",2,"")) I ASUX("STA")']"" W !,"NO DATA FOR REPORT 80" Q
  1.  S Y=$P(^XTMP("ASUR","R80",2),U),ASUV("FY")=$S($E(Y,4,5)>9:$E(Y,1,3)+1,1:$E(Y,1,3))
  1.  X ^DD("DD") S ASUV("DT")=Y,ASUC("PG")=0
  1.  ;S ASUX("STA")=""
  1.  ;F  S ASUX("STA")=$O(^XTMP("ASUR","R80",2,ASUX("STA"))) Q:ASUX("STA")=""  D
  1.  S ASUX("STA")=$G(ASUL(2,"STA","E#")) I ASUX("STA")']"" D  Q
  1.  .W !,"Station not selected at logon - can't determine Station to print"
  1.  E  D
  1.  .S ASUA("AR")=$E(ASUX("STA"),1,2),ASUV("ARE")=ASUA("AR")
  1.  .I ASUA("AR")'=ASUL(1,"AR","AP") D ARE^ASULARST(ASUV("ARE"))
  1.  .S ASUA("STA")=$P(^XTMP("ASUR","R80",2,ASUX("STA")),U)
  1.  .;S ASUL(2,"E#","STA")=ASUX("STA") D STA^ASULARST(ASUL(2,"E#","STA"))
  1.  .S ASUX("ACC")=""
  1.  .F  S ASUX("ACC")=$O(^XTMP("ASUR","R80",2,ASUX("STA"),ASUX("ACC"))) Q:ASUX("ACC")'?1N  D P1
  1.  I $D(DUOUT)!($D(DTOUT)) G K
  1.  I ('$D(ASUV("ACC")))!('$D(ASUV("OBJ")))!('$D(ASUV("CAT"))) G K
  1.  S ASUV("LEV")=5 D PRTOTL
  1.  D CLS^ASUUHDG
  1. K ;
  1.  K ASUC,ASUF,ASUT,ASUV,ASUP,ASUS,ASUX,ASUT
  1.  F X=3:1:22 K ASUL(X) ;Clear Table Lookup fields
  1.  K DFOUT,DIR,DLOUT,DTOUT,DUOUT
  1.  K X,X1,X2,X3,X4,Y
  1.  I ASUK("PTRSEL")]"" Q
  1.  D C^ASUUZIS
  1.  Q
  1. P1 ;
  1.  S ASUA("ACC")=^XTMP("ASUR","R80",0,ASUX("ACC")),ASUV("ACC")=ASUX("ACC")
  1.  S ASUX("OBJ")=""
  1.  F  S ASUX("OBJ")=$O(^XTMP("ASUR","R80",2,ASUX("STA"),ASUX("ACC"),ASUX("OBJ"))) Q:ASUX("OBJ")=""  Q:$D(DTOUT)  Q:$D(DUOUT)  D
  1.  .S ASUA("OBJ")=^XTMP("ASUR","R80",0,ASUX("ACC"),ASUX("OBJ")),ASUV("OBJ")=ASUX("OBJ")
  1.  .S ASUX("CAT")=""
  1.  .F  S ASUX("CAT")=$O(^XTMP("ASUR","R80",2,ASUX("STA"),ASUX("ACC"),ASUX("OBJ"),ASUX("CAT"))) Q:ASUX("CAT")=""  Q:$D(DTOUT)  Q:$D(DUOUT)  D
  1.  ..S ASUA("CAT")=^XTMP("ASUR","R80",0,ASUX("ACC"),ASUX("OBJ"),ASUX("CAT")),ASUV("CAT")=ASUX("CAT")
  1.  ..D P4
  1.  .Q:$D(DTOUT)  Q:$D(DUOUT)
  1.  .S ASUV("LEV")=3 D PRTOTL
  1.  Q:$D(DTOUT)  Q:$D(DUOUT)
  1.  S ASUV("LEV")=4 D PRTOTL
  1.  Q
  1. P2 ;
  1. PRLINE ;PRINT LINE
  1.  W !?5,$P(ASUA(ASUV("LEV"),ASUV("SST")),U)
  1.  S ASUC("LN")=ASUC("LN")+1
  1.  D PRLIN2,PRLIN3,P3
  1.  Q
  1. PRLI2 ;
  1.  S:ASUC("LN")>ASUK(ASUK("PTR"),"IOSL") ASUF("HDR")=1
  1. PRLIN2 ;
  1.  F ASUV("PIECE")=2:1:4 D
  1.  .W ?30+((ASUV("PIECE")-2)*9),$J($FN($P(ASUA(ASUV("LEV"),ASUV("SST")),U,ASUV("PIECE")),"+T",0),9) D:ASUV("SST")>0
  1.  ..S ASUV("%TOT")=$P(ASUA(ASUV("LEV"),0),U,ASUV("PIECE"))
  1.  ..I ASUV("%TOT")<1 D
  1.  ...S ASUV("%")="0.0"
  1.  ..E  D
  1.  ...S ASUV("%SST")=$P(ASUA(ASUV("LEV"),ASUV("SST")),U,ASUV("PIECE"))*100
  1.  ...S ASUV("%")=ASUV("%SST")/ASUV("%TOT")
  1.  ..S $P(ASUA(ASUV("LEV"),ASUV("SST")),U,ASUV("PIECE")+3)=$FN(ASUV("%"),"-",1)_"%"
  1.  Q
  1. PRLIN3 ;
  1.  F ASUV("PIECE")=5:1:7 W ?55+((ASUV("PIECE")-5)*7),$J($P(ASUA(ASUV("LEV"),ASUV("SST")),U,ASUV("PIECE")),7)
  1.  Q
  1. PRTOTL ;EP; -PRINT TOTALS
  1.  D:ASUF("HDR") HEADER
  1.  W !,$P($T(TOTNAM+ASUV("LEV")),";",4)
  1.  S ASUC("LN")=ASUC("LN")+1
  1.  D:ASUV("LEV")<5 ROLLTOT
  1.  I ASUV("LEV")=1 D
  1.  .D PRDASH
  1.  .W !?7,$P($T(TOTNAM+ASUV("LEV")),";",3)
  1.  .S ASUU(2)=ASUV("SST"),ASUV("SST")=0
  1.  .D PRLI2 D:ASUF("HDR") HEADER
  1.  .F  S ASUV("SST")=$O(ASUA(ASUV("LEV"),ASUV("SST"))) Q:ASUV("SST")'?1N.N  D P3
  1.  .S ASUV("SST")=ASUU(2)
  1.  E  D
  1.  .S ASUF("HDR")=1
  1.  .S ASUU(2)=ASUV("SST"),ASUV("SST")=0
  1.  .W ! S ASUC("LN")=ASUC("LN")+1
  1.  .F  S ASUV("SST")=$O(ASUA(ASUV("LEV"),ASUV("SST"))) Q:ASUV("SST")'?1N.N  D
  1.  ..W !?5,$P(ASUA(ASUV("LEV"),ASUV("SST")),U)
  1.  ..S ASUC("LN")=ASUC("LN")+1
  1.  ..D PRLIN2,PRLIN3
  1.  ..D P3
  1.  .W ! D PRDASH
  1.  .S ASUC("LN")=ASUC("LN")+1
  1.  .W !!?12,$P($T(TOTNAM+ASUV("LEV")),";",3)
  1.  .S ASUC("LN")=ASUC("LN")+1
  1.  .S ASUV("SST")=0
  1.  .D PRLI2
  1.  .S ASUV("SST")=ASUU(2)
  1.  S ASUC("LN")=ASUC("LN")+1
  1.  W !
  1.  S ASUC("LN")=ASUC("LN")+1
  1.  F ASUU(4)=0:1:2 S X=(ASUU(4)*9)+30 W ?X," ========"
  1.  S ASUC("LN")=ASUC("LN")+1
  1.  K ASUA(ASUV("LEV"))
  1.  Q
  1. PRDASH ;
  1.  F ASUU(4)=0:1:2 S X=(ASUU(4)*9)+30 W ?X," ________"
  1.  W ! S ASUC("LN")=ASUC("LN")+1
  1.  Q
  1.  S ASUC("PG")=ASUC("PG")+1
  1.  D:ASUC("PG")>1 PAZ^ASUURHDR
  1.  W @IOF,!,"REPORT #80 ANALYSIS OF ISSUE VALUES BY ITEM/LOCATION/CATEGORY",?71,"PAGE :",$J(ASUC("PG"),3)
  1.  W !,"AREA: ",ASUL(1,"AR","AP")," -",ASUL(1,"AR","NM"),?35,"DATE : ",ASUV("DT")
  1.  W !,"STAT: ",ASUL(2,"STA","CD")," -",ASUL(2,"STA","NM")
  1.  W ?40,"GL ACCOUNT : ",ASUV("ACC")," ",$P(ASUA("ACC"),U,2)
  1.  W !,"OBJECT/SUBOBJECT CODE: ",$E(ASUV("OBJ"),1,2),".",$E(ASUV("OBJ"),3,4)," -",$P(ASUA("OBJ"),U,2),!
  1.  W !,"CATEGORY: ",ASUV("CAT")," -",$P(ASUA("CAT"),U,2),!
  1.  W !?3,"INDEX  ITEM                                               PERCENT OF TOTAL"
  1.  W !?2,"NUMBER  DESCRIPTION            STORES STOCK ISSUE VALUES     ISSUE VALUE",?78,"U"
  1.  W !?6,"USING LOCATION",?32,"FY-",$E(ASUV("FY"),2,3),?42,"FY-",$E((ASUV("FY")-1),2,3),?52,"FY-",$E((ASUV("FY")-2),2,3)
  1.  W ?59,"FY-",$E(ASUV("FY"),2,3),?66,"FY-",$E((ASUV("FY")-1),2,3),?73,"FY-",$E((ASUV("FY")-2),2,3)
  1.  W ! F ASUU(3)=1:1:80 W "_"
  1.  W !!
  1.  S ASUC("LN")=13,ASUF("HDR")=0
  1.  Q
  1. TOTNAM ;;
  1.  ;;ITEM TOTAL
  1.  ;;CATEGORY TOTAL;SUMMARY BY CATEGORY
  1.  ;;OBJ/SUB OBJ TOTAL;SUMMARY BY OBJ/SUB OBJ
  1.  ;;ACCOUNT TOTAL;SUMMARY BY ACCOUNT
  1.  ;;AREA TOTAL;SUMMARY BY AREA
  1. P3 ;
  1.  S $P(ASUA(ASUV("LEV")+1,ASUV("SST")),U)=$P(ASUA(ASUV("LEV"),ASUV("SST")),U)
  1.  F ASUU(1)=2:1:4 D
  1.  .S $P(ASUA(ASUV("LEV")+1,ASUV("SST")),U,ASUU(1))=$P(ASUA(ASUV("LEV")+1,ASUV("SST")),U,ASUU(1))+$P(ASUA(ASUV("LEV"),ASUV("SST")),U,ASUU(1))
  1.  K ASUA(ASUV("LEV"),ASUV("SST"))
  1.  Q
  1. ROLLTOT ;EP ;ACCUMULATE TOTALS
  1.  S ASUA(ASUV("LEV")+1,0)=$G(ASUA(ASUV("LEV")+1,0))
  1.  F ASUU(1)=2:1:4 D
  1.  .S $P(ASUA(ASUV("LEV")+1,0),U,ASUU(1))=$P(ASUA(ASUV("LEV")+1,0),U,ASUU(1))+$P(ASUA(ASUV("LEV"),0),U,ASUU(1))
  1.  Q
  1. ZEROTOT ;
  1.  K ASUA(ASUV("LEV"))
  1.  Q
  1. P4 ;
  1.  S ASUX("DSC")=""
  1.  F  S ASUX("DSC")=$O(^XTMP("ASUR","R80",2,ASUX("STA"),ASUX("ACC"),ASUX("OBJ"),ASUX("CAT"),ASUX("DSC"))) Q:ASUX("DSC")=""  Q:$D(DTOUT)  Q:$D(DUOUT)  D
  1.  .S ASUX(0,"DSC")=^XTMP("ASUR","R80",2,ASUX("STA"),ASUX("ACC"),ASUX("OBJ"),ASUX("CAT"),ASUX("DSC"))
  1.  .S ASUA(0,0)=""
  1.  .F ASUU(1)=1:1:3 S ASUA(0,0)=ASUA(0,0)_U_$P(ASUX(0,"DSC"),U,ASUU(1))
  1.  .S ASUA("IDX")=$P(ASUX(0,"DSC"),U,5)
  1.  .S ASUA("DS2")=$P(ASUX(0,"DSC"),U,6)
  1.  .D:ASUF("HDR") HEADER
  1.  .W !!,$E(ASUA("IDX"),1,5),".",$E(ASUA("IDX"),6,6),?8,ASUX("DSC")," ",ASUA("DS2"),!
  1.  .S ASUC("LN")=ASUC("LN")+3
  1.  .D P5 ;SUBSTATION
  1.  Q:$D(DTOUT)  Q:$D(DUOUT)
  1.  S ASUV("LEV")=2 D PRTOTL
  1.  Q
  1. P5 ;
  1.  S ASUX("SST")=""
  1.  F  S ASUX("SST")=$O(^XTMP("ASUR","R80",2,ASUX("STA"),ASUX("ACC"),ASUX("OBJ"),ASUX("CAT"),ASUX("DSC"),ASUX("SST"))) Q:ASUX("SST")=""  Q:$D(DTOUT)  Q:$D(DUOUT)  D
  1.  .S ASUV("LEV")=0
  1.  .S ASUV("SST")=ASUX("SST")
  1.  .S ASUA(0,ASUV("SST"))=^XTMP("ASUR","R80",2,ASUX("STA"),ASUX("ACC"),ASUX("OBJ"),ASUX("CAT"),ASUX("DSC"),ASUX("SST"))
  1.  .D ACC^ASULDIRF(ASUX("ACC"))
  1.  .S:ASUC("LN")>ASUK(ASUK("PTR"),"IOSL") ASUF("HDR")=1
  1.  .D:ASUF("HDR") HEADER
  1.  .D PRLINE
  1.  D ROLLTOT
  1.  S ASUV("LEV")=1 D PRTOTL
  1.  Q