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

ASURD73P.m

Go to the documentation of this file. 
  1. ASURD73P ; IHS/ITSC/LMH -RPT 73 OUTAGE/LOW INV/DUE OUT ; 
  1.  ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
  1.  ;This routine formats and prints report 73, Outage - Low Inventory -
  1.  ;Due Out Report.
  1. EN ;EP;PRIMARY ENTRY POINT FOR REPORT 73
  1.  D:'$D(IO) HOME^%ZIS 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^ASURD73P",ZTDESC="SAMS RPT 73" 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.  D U^ASUUZIS D:'$D(ASUK("DT")) ^ASUUDATE
  1.  S Y=$P($G(^XTMP("ASUR","R73",0)),U,2) X ^DD("DD")
  1.  S ASUX("DT")=Y S:ASUX("DT")']"" ASUX("DT")=$G(ASUK("DT"))
  1.  I Y']"" D CMPT
  1.  S Y=$O(^XTMP("ASUR","R73",0)) I Y']"" W !,"NO DATA FOR REPORT #73",?27,ASUK("DT") G K
  1.  S ASUC("LN")=IOSL+1,(ASUC("QTY","D/I","TOT"),ASUC("B/O"),ASUMS("E#","STA"),ASUC("ACCTOT"),ASUC("GTOT"))=0
  1.  S (ASUV("D/I","PO#"),ASUV("QTY","D/I"))=""
  1.  S (ASUX("ACC"),ASUX("IDX"),ASUX("STA"))=0
  1.  ;F ASUC("TR")=1:1 S ASUX("STA")=$O(^XTMP("ASUR","R73",ASUX("STA"))) Q:ASUX("STA")=""  D  Q:$D(DUOUT)
  1.  S ASUX("STA")=$G(ASUL(2,"STA","E#")) Q:ASUX("STA")']""  D
  1.  .Q:$E(ASUX("STA"),1,2)'=ASUL(1,"AR","AP")
  1.  .F  S ASUX("ACC")=$O(^XTMP("ASUR","R73",ASUX("STA"),ASUX("ACC"))) Q:ASUX("ACC")=""  D  Q:$D(DUOUT)
  1.  ..F ASUU(12)=1:1 S ASUX("IDX")=$O(^XTMP("ASUR","R73",ASUX("STA"),ASUX("ACC"),ASUX("IDX"))) Q:ASUX("IDX")=""  D  Q:$D(DUOUT)
  1.  ...S ASUX(0,"IDX")=^XTMP("ASUR","R73",ASUX("STA"),ASUX("ACC"),ASUX("IDX"),0)
  1.  ...S ASUC("LN")=ASUC("LN")+2
  1.  ...I ASUC("LN")>(IOSL-4) D HEADER Q:$D(DUOUT)
  1.  ...W !!?1,$E($P(ASUX(0,"IDX"),U,3),1,5),".",$E($P(ASUX(0,"IDX"),U,3),6,6),?10,$P(ASUX(0,"IDX"),U,4)
  1.  ...W ?46,$P(ASUX(0,"IDX"),U,6),?50,$J($P(ASUX(0,"IDX"),U,7),4),?60,$J($P(ASUX(0,"IDX"),U,8),4)
  1.  ...S ASUX("TRL")=0
  1.  ...F ASUU(13)=1:1 S ASUX("TRL")=$O(^XTMP("ASUR","R73",ASUX("STA"),ASUX("ACC"),ASUX("IDX"),ASUX("TRL"))) Q:ASUX("TRL")=""  D  S ASUC("LI")=ASUU(13)
  1.  ....S ASUX(0,"TRL")=^XTMP("ASUR","R73",ASUX("STA"),ASUX("ACC"),ASUX("IDX"),ASUX("TRL"))
  1.  ....D P2
  1.  ...I $G(ASUC("LI"))=1 S ASUX(0,"TRL")="",ASUU(13)=2 D P2
  1.  ...W ! I $P(ASUX(0,"IDX"),U,10)]"" D
  1.  ....W ?8,":",$P(ASUX(0,"IDX"),U,11)
  1.  ....W ?19,":",$P(ASUX(0,"IDX"),U,10)
  1.  ....W ?118,":",$P(ASUX(0,"IDX"),U,12),":"
  1.  ...D PRINTTOT Q:$D(DUOUT)
  1.  ..K ASUV("B/O"),ASUV("D/I") S ASUC("ACCTOT")=ASUU(12)-1
  1.  ..W !!,"TOTAL GL ACCOUNT 125.",ASUX("ACC")," LINE ITMES: ",$J(ASUC("ACCTOT"),8) S ASUC("GTOT")=ASUC("GTOT")+ASUC("ACCTOT")
  1.  ..S ASUC("LN")=IOSL-4
  1.  .W !!,"TOTAL LINE ITEMS ALL GL ACCOUNTS:  ",$J(ASUC("GTOT"),8),!
  1. K ;
  1.  K ASUU(12),ASUU(13),ASUMX,ASUMS,ASUX,ASUC,ASUV
  1.  K ASUC("LI"),ASUC("ACCTOT"),ASUC("GTOT")
  1.  F X=3:1:22 K ASUL(X) ;Clear Table Lookup fields
  1.  K ASUMS,X,Y
  1.  D PAZ^ASUURHDR
  1.  I ASUK("PTRSEL")]"" W @(IOF) Q
  1.  D C^ASUUZIS
  1.  Q
  1.  S ASUC("PG")=$G(ASUC("PG"))+1,ASUC("LN")=0
  1.  D:ASUC("PG")>1 PAZ^ASUURHDR Q:$D(DUOUT)  W @IOF
  1.  W !?5,"REPORT #73  STOCK OUTAGE -LOW INVENTORY -DUE OUT REPORT"
  1.  W ?70,ASUX("DT"),?85,"PAGE",?90,ASUC("PG")  ;; CHG 03-21-95 CSC
  1.  D STA^ASULARST(ASUX("STA"))
  1.  W !?5,"STATION: ",ASUL(2,"STA","CD"),?23,ASUL(2,"STA","NM")
  1.  D ACC^ASULDIRF(ASUX("ACC"))
  1.  W !?5,"GL ACCOUNT 125.",ASUL(9,"ACC"),?23,ASUL(9,"ACC","NM")
  1.  W !!?60,"QTY     DUE",?85,"DUE     DUE   DUE OUT    EOQ"
  1.  W !?7,"INDEX",?61,"ON",?68,"IN       PO",?85,"IN",?93,"OUT",?102,"TO      TYPE"
  1.  W !?2,"NUMBER  DESCRIPTION",?46,"UI",?50,"PAMIQ",?59,"HAND",?68,"QTY"
  1.  W ?77,"NO.",?85,"DATE    QTY",?99,"LOC  USER  CODE",!
  1.  S ASUC("LN")=10
  1.  Q
  1. P2 ;Print Totals and Lines
  1.  S ASUV("QTY","D/I")=$P(ASUX(0,"TRL"),U)
  1.  S ASUV("D/I","PO#")=$P(ASUX(0,"TRL"),U,2)
  1.  S ASUV("D/I","DT")=$P(ASUX(0,"TRL"),U,3)
  1.  S ASUV("B/O","QTY")=$P(ASUX(0,"TRL"),U,4)
  1.  S ASUV("B/O","LOC")=$E($P(ASUX(0,"TRL"),U,5),4,5)
  1.  I $P(ASUX(0,"TRL"),U,6)]"" D
  1.  .S ASUV("B/O","RQN")=$P(^ASUL(20,$P(ASUX(0,"TRL"),U,6),0),U,2)
  1.  .S ASUV("B/O","USR")=$P(^ASUL(19,ASUV("B/O","RQN"),1),U)
  1. PRINTLIN ;EP; PRINT TRANS LINE
  1.  S ASUC("QTY","D/I","TOT")=ASUC("QTY","D/I","TOT")+ASUV("QTY","D/I")
  1.  S ASUC("B/O")=ASUC("B/O")+ASUV("B/O","QTY")
  1.  I ASUU(13)>1 D  Q:$D(DUOUT)
  1.  .W ! S ASUC("LN")=ASUC("LN")+1
  1.  .I ASUC("LN")>(IOSL-2) D HEADER Q:$D(DUOUT)
  1.  W:ASUU(13)=2 ?10,$P(ASUX(0,"IDX"),U,5)
  1.  W ?67,$J(ASUV("QTY","D/I"),5)
  1.  W ?75,ASUV("D/I","PO#")
  1.  W:ASUV("D/I","DT")]"" ?84,$E(ASUV("D/I","DT"),4,5)_"-"_$E(ASUV("D/I","DT"),6,7)_"-"_$E(ASUV("D/I","DT"),2,3)
  1.  W:ASUV("B/O","QTY")]"" ?92,$J($FN(ASUV("B/O","QTY"),",",0),5),?100,ASUV("B/O","LOC"),?104,ASUV("B/O","USR")
  1.  W:ASUU(13)=1 ?111,$P(ASUX(0,"IDX"),U,9)
  1.  Q
  1. PRINTTOT ;EP; PRINT TOTAL LINE
  1.  S ASUC("LN")=ASUC("LN")+2 I ASUC("LN")>(IOSL-6) D HEADER Q:$D(DUOUT)
  1.  W !?40,"TOTAL",?59,$J($P(ASUX(0,"IDX"),U,8),5)
  1.  W:ASUC("QTY","D/I","TOT")>0 ?67,$J(ASUC("QTY","D/I","TOT"),5)
  1.  W:ASUC("B/O")>0 ?92,$J(ASUC("B/O"),5)
  1.  S (ASUC("QTY","D/I","TOT"),ASUC("B/O"))=0
  1.  Q
  1. CMPT ;EP ;SORT,DUEIN,BKORDER RTN;
  1.  K ^XTMP("ASUR","R73") S ^XTMP("ASUR","R73",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
  1.  S ASUMS("E#","STA")=$G(ASUL(2,"STA","E#")) Q:ASUMS("E#","STA")']""
  1.  S ASUMS("E#","IDX")=0 F  S ASUMS("E#","IDX")=$O(^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX")))  Q:ASUMS("E#","IDX")'?1N.N  D
  1.  .Q:$P(^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX"),0),U)[999999
  1.  .S ASUV("IDX")=ASUMS("E#","IDX") D ^ASUMSTRD I ASUF("DLIDX") S ASUMS("E#","IDX")=ASUV("IDX") Q
  1.  .Q:ASUMS("EOQ","TP")="S"
  1.  .S ASUMX("E#","IDX")=ASUMS("E#","IDX") D READ^ASUMXDIO
  1.  .I ASUMS("QTY","O/H")<ASUMS("PMIQ")!(ASUMS("QTY","O/H")<1) D
  1.  ..S (ASUV("D/I"),ASUV("B/O"))=0 S:ASUMS("QTY","O/H")="" ASUMS("QTY","O/H")=0
  1.  ..F ASUV("DI#")=1:1:3 I ASUMS("D/I","QTY",ASUV("DI#"))>0 D
  1.  ...S ASUV("D/I")=ASUV("D/I")+1,$P(ASUAD(ASUV("D/I")),U)=ASUMS("D/I","QTY",ASUV("DI#"))
  1.  ...S $P(ASUAD(ASUV("D/I")),U,2)=ASUMS("D/I","PO#",ASUV("DI#")),$P(ASUAD(ASUV("D/I")),U,3)=ASUMS("D/I","DT",ASUV("DI#"))
  1.  ..S (ASUMB("E#","REQ"),ASUV("B/O"))="0"
  1.  ..F  S ASUMB("E#","REQ")=$O(^ASUMB("C",ASUMX("E#","IDX"),ASUMB("E#","REQ"))) Q:ASUMB("E#","REQ")=""   D
  1.  ...S ASUV("B/O")=$G(ASUV("B/O"))+1,ASUMB(1)=^ASUMB(ASUMB("E#","REQ"),1,ASUMX("E#","IDX"),1)
  1.  ...S ASUMB("USR")=ASUMB("E#","REQ"),ASUMB("QTYB/O")=$P(ASUMB(1),U,3),ASUMB("LOC")=$P(ASUMB(1),U,14)
  1.  ...S ASUAB(ASUV("B/O"))=ASUMB("QTYB/O")_U_ASUMB("LOC")_U_ASUMB("USR")
  1.  ..S ASUX(0,"IDX")=ASUMS("STA")_U_ASUMX("ACC")_U_ASUMX("IDX")_U_ASUMX("DESC",1)_U_ASUMX("DESC",2)_U
  1.  ..S ASUX(0,"IDX")=ASUX(0,"IDX")_ASUMX("AR U/I")_U_ASUMS("PMIQ")_U_ASUMS("QTY","O/H")_U_ASUMS("EOQ","TP")_U
  1.  ..S ASUX(0,"IDX")=ASUX(0,"IDX")_ASUMS("R73","REM")_U_ASUMS("R73","PER")_U_ASUMS("R73","DT")
  1.  ..S ^XTMP("ASUR","R73",ASUMS("STA"),ASUMX("ACC"),"0"_ASUMX("IDX"),0)=ASUX(0,"IDX"),ASUX(0,"IDX")=""
  1.  ..I ASUV("D/I")>ASUV("B/O") D
  1.  ...S ASUX("TRL")=ASUV("D/I")
  1.  ..E  D
  1.  ...S ASUX("TRL")=ASUV("B/O")
  1.  ..I ASUX("TRL")=0 S ASUX("TRL")=1
  1.  ..F ASUU(12)=1:1:ASUX("TRL") D
  1.  ..I '$D(ASUAD(ASUU(12))) S ASUX(0,"IDX")="^^"
  1.  ..E  S ASUX(0,"IDX")=ASUAD(ASUU(12))
  1.  ..I $D(ASUAB(ASUU(12))) S ASUX(0,"IDX")=ASUX(0,"IDX")_U_ASUAB(ASUU(12))
  1.  ..S ^XTMP("ASUR","R73",ASUMS("STA"),ASUMX("ACC"),"0"_ASUMX("IDX"),ASUU(12))=ASUX(0,"IDX"),ASUX(0,"IDX")=""
  1.  .K ASUAB,ASUAD
  1.  E  D
  1.  .;S ^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX"),3)=""
  1.  K ASUAB,ASUAD
  1.  K ASUMX,ASUMS,ASUV("D/I"),ASUV("B/O"),ASUU(12)
  1.  Q
  1. REMARKS ;EP ;ENTER REMARKS FOR REPORT 73
  1.  I '$D(DUZ) W !!,"USER NOT DEFINED -USE KERNEL" Q
  1.  I '$D(U) D ^XBKVAR
  1.  S ASUMS("E#","STA")="",DIR(0)="S^",ASUV("R73PER")=$P(^VA(200,DUZ,0),U),X=DT,ASUV("ST")="",ASUU(10)="",ASUU(11)=""
  1.  D H^%DTC,YX^%DTC S ASUV("R73DTE")=Y
  1.  F ASUC("TR")=1:1 S ASUV("ST")=$O(^ASUMS("B",ASUV("ST"))) Q:ASUV("ST")=""  D CHECKI
  1.  I ASUU(11)=1 S ASUMS("E#","STA")=$O(^ASUMS("B",ASUU(10),"")) G FINDIDX
  1.  G READSTA
  1. CHECKI ;
  1.  S ASUMS("E#","STA")=$O(^ASUMS("B",ASUV("ST"),"")) Q:$P(^ASUMS(ASUMS("E#","STA"),1,0),U,4)=0
  1.  S ASUU(11)=ASUU(11)+1,DIR(0)=DIR(0)_ASUU(11)_":"_ASUV("ST")_";"
  1.  S ASUU(10)=ASUV("ST")
  1.  Q
  1. READSTA ;
  1.  S DIR("A")="ENTER STATION FOR REMARKS " D ^DIR Q:$D(DUOUT)  Q:$D(DTOUT)  Q:X=""
  1.  S ASUMS("E#","STA")=$O(^ASUMS("B",Y(0),""))
  1. FINDIDX ;
  1.  S DIC="^ASUMS(ASUMS(""E#"",""STA""),1,"
  1.  S DIC(0)="ANMQ",DIC("A")="ENTER INDEX NUMBER FOR REMARKS "
  1.  D ^DIC
  1.  G:$D(DUOUT) ASK G:$D(DTOUT) ASK G:'$D(Y) ASK G:Y<0 ASK
  1.  S DA=+Y,DIE="^ASUMS(ASUMS(""E#"",""STA""),1,"
  1.  S DR=".09;.091///^S X=ASUV(""R73PER"");.092///^S X=ASUV(""R73DTE"")"
  1.  D ^DIE
  1. ASK ;
  1.  K DIR S DIR(0)="Y",DIR("B")="Y",DIR("A")="ENTER ANOTHER REPORT 73 REMARK " D ^DIR
  1.  G:$D(DUOUT) DONE G:$D(DTOUT) DONE
  1.  I Y=1 G FINDIDX
  1. DONE ;
  1.  K ASUMS("E#","STA"),ASUV("R73PER"),ASUV("ST"),ASUV("R73DTE"),ASUC("TR"),DIR,DIC,DIE,DR
  1.  Q