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

ASUV4AL.m

Go to the documentation of this file. 
  1. ASUV4AL ; IHS/ITSC/LMH -RPT ADJUSTMENT DOC ;  
  1.  ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
  1.  ;This routine creates the Physical Inventory Adjustments Documents
  1.  ;report.
  1.  D:'$D(DT) ^XBKVAR S %H=$H D YX^%DTC S ASUK("RUN","DT")=$P(Y,"@") K X,Y,%H
  1.  D:'$D(IO(0)) HOME^%ZIS
  1.  S %DT="T",X="NOW" D ^%DT S ASUV("DT")=Y
  1.  D CLS^ASUUHDG
  1.  I $G(ASUL(2,"STA","E#"))']"" D STA^ASUV0NT I $D(DTOUT)!($D(DUOUT)) G EXIT
  1.  S DIC("A")="PRINT RPT 37C 'ADJUSTMENT DOCUMENT' FOR WHAT ACCOUNT?"
  1.  S DIC="9002039.09",DIC(0)="AMEZQ"
  1.  D ^DIC K DIC
  1.  I $D(DTOUT)!($D(DUOUT)) Q
  1.  Q:'$D(Y)  Q:Y=""
  1.  I Y>0 D
  1.  .S ASUMV("ACC")=$P(Y,U),ASUMV("E#","ASA")=ASUL(2,"STA","E#")_ASUMV("ACC")
  1.  .D ACC^ASULDIRF(ASUMV("ACC"))
  1.  E  D
  1.  .S ASUMV("E#","ASA")=ASUL(2,"STA","E#")
  1.  G:ASUMV("E#","ASA")="" EXIT
  1.  I $D(^ASUMV(ASUMV("E#","ASA"),0)) D
  1.  .D ACCOUNT^ASUV9IMR
  1.  E  D  G EXIT
  1.  .W !!,"NO INVENTORY IS ACTIVE FOR ACCOUNT ",ASUMV("ACC")," ",ASUL(9,"ACC","NM")
  1.  .S DIR(0)="E" D ^DIR K DIR
  1.  S ASUV("ASA")=ASUMV("E#","ASA")
  1.  S ASUF=$G(ASUF)
  1.  I ASUF=2 D
  1.  .S ASUF=0,ASUMV("MODE")=3
  1.  E  D
  1.  .S ASUV("MSG",1)="YOU HAVE REQUESTED AN ADJUSTMENT DOCUMENT BUT "
  1.  .D ASUV3AN0^ASUV3AN
  1.  G:ASUF EXIT
  1.  D ASUV4AL0
  1.  I '$D(IO) D HOME^%ZIS
  1.  I '$D(DUZ(2)) W !,"Report must be run from Kernel option" G EXIT
  1.  I '$D(ASUL(1,"AR","AP")) D SETAREA^ASULARST
  1.  S ASUV("ASA")=ASUMV("E#","ASA")
  1.  S ZTRTN="ASUV4AL1^ASUV4AL",ZTDESC="SAMS INVENTORY ADJUSTMENTS LIST" D O^ASUUZIS
  1.  I POP S IOP=$I D ^%ZIS G EXIT
  1.  I ASUK(ASUK("PTR"),"Q") K IOP,POP,ZTDESC,ZTRTN,ZTSK,ASUK(ASUK("PTR")),ASUK("PTR"),ASUK("PTR-Q") G EXIT
  1.  D ASUV4AL1
  1. EXIT ;
  1.  K ASUU(11),ASUC,ASUR,ASUSAV,ASUF,ASUMS,ASUMV,ASUV,ASUMX
  1.  K DTOUT,DUOUT,ZTRTN,ZTDESC,X,Y,X1
  1.  D:$D(ASUK("PTR")) C^ASUUZIS
  1.  Q
  1. ASUV4AL0 ;ADJUSTMENT DOCUMENT SORT
  1.  K ^ASUV("AJ")
  1.  S ASUMV("E#","SLC")=0
  1.  F  S ASUMV("E#","SLC")=$O(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"))) Q:ASUMV("E#","SLC")'?1N.N  D
  1.  .S ASUMV("E#","INDX")=0
  1.  .F  S ASUMV("E#","INDX")=$O(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),1,ASUMV("E#","INDX"))) Q:ASUMV("E#","INDX")'?1N.N  D
  1.  ..Q:$P(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),1,ASUMV("E#","INDX"),0),U,7)=0
  1.  ..S ASUL(2,"STA","E#")=$P(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),1,ASUMV("E#","INDX"),0),U,2)
  1.  ..S ^ASUV("AJ",ASUMV("E#","ASA"),ASUMV("E#","INDX"))=ASUMV("E#","SLC")
  1.  Q
  1. ASUV4AL1 ;
  1.  S ASUMV("E#","ASA")=ASUV("ASA")
  1.  D U^ASUUZIS
  1.  S (ASUC("PG"),ASUC("LN"))=0
  1.  S (ASUC("OVR","VAL"),ASUC("OVR","LI"))=0
  1.  S (ASUC("SHT","VAL"),ASUC("SHT","LI"))=0
  1.  I '$D(^ASUV("AJ",ASUMV("E#","ASA"))) D  G FLAGIT
  1.  .D ACCOUNT^ASUV9IMR
  1.  .S Y=ASUMV("INVBEG") X ^DD("DD") S ASUV("DTPRNT")=Y K Y
  1.  .D HEADING
  1.  .W !!,"NO ADJUSTMENTS TO BE MADE FOR ACCOUNT '",ASUMV("ACC"),"' -",ASUL(9,"ACC","NM")," INVENTORY"
  1.  S ASUMV("E#","SLC")=""
  1.  D ACCOUNT^ASUV9IMR
  1.  S Y=ASUMV("INVBEG") X ^DD("DD") S ASUV("DTPRNT")=Y K Y
  1.  S ASUMV("E#","INDX")=""
  1.  D:ASUC("LN")<1 HEADING
  1.  F ASUU(11)=1:1 S ASUMV("E#","INDX")=$O(^ASUV("AJ",ASUMV("E#","ASA"),ASUMV("E#","INDX"))) Q:ASUMV("E#","INDX")'?1N.N  D
  1.  .S ASUMV("E#","SLC")=^ASUV("AJ",ASUMV("E#","ASA"),ASUMV("E#","INDX"))
  1.  .D STORLOC^ASUV9IMR
  1.  .D:ASUC("LN")>55 HEADING
  1.  .D INDEX^ASUV9IMR
  1.  .Q:ASUMV("IDX")["*"  ;MASTER HAS BEEN DELETED
  1.  .S ASUV("CNT","LST")=$S(ASUMV("CNT","2ND"):ASUMV("CNT","2ND"),1:ASUMV("CNT","1ST"))
  1.  .S ASUV("ADJUST VAL")=$FN(ASUMV("QTY","DIF")*ASUMV("U/C"),"",2)
  1.  .D READ^ASUMXDIO
  1.  .S ASUMS("E#","IDX")=$O(^ASUMS(ASUL(2,"STA","E#"),1,"B",ASUMV("IDX"),""))
  1.  .W !?1,$J(ASUU(11),3),?6,$E(ASUMX("IDX"),1,5),".",$E(ASUMX("IDX"),6,6)
  1.  .W ?14,$E(ASUMX("DESC",1),1,20),?35,ASUMX("AR U/I"),?37,$J($FN(ASUMV("U/C"),",",2),6)
  1.  .S ASUT="GEN ADJ"
  1.  .S ASUT(ASUT,"VAL")=ASUV("ADJUST VAL")
  1.  .I ASUMV("QTY","DIF")<1 D
  1.  ..S ASUT("TRCD")=37
  1.  ..S ASUT(ASUT,"QTY")=(ASUMV("QTY","DIF")*-1)
  1.  ..S:ASUT(ASUT,"VAL")<0 ASUT(ASUT,"VAL")=(ASUT(ASUT,"VAL")*-1)
  1.  ..D ASUV4AL3
  1.  ..W ?62,$J(ASUMV("QTY","DIF"),6),?68,$J($FN(ASUV("ADJUST VAL"),",",2),10)
  1.  ..S ASUC("SHT","VAL")=ASUC("SHT","VAL")+ASUV("ADJUST VAL"),ASUC("SHT","LI")=ASUC("SHT","LI")+1
  1.  .E  D
  1.  ..S ASUT("TRCD")=27
  1.  ..S ASUT(ASUT,"QTY")=ASUMV("QTY","DIF")
  1.  ..D ASUV4AL3
  1.  ..W ?45,$J(ASUMV("QTY","DIF"),6),?52,$J($FN(ASUV("ADJUST VAL"),",",2),10)
  1.  ..S ASUC("OVR","VAL")=ASUC("OVR","VAL")+ASUV("ADJUST VAL"),ASUC("OVR","LI")=ASUC("OVR","LI")+1
  1.  .D SEPERATE
  1.  .S ASUC("LN")=ASUC("LN")+2
  1.  D:ASUC("LN")>7 FOOTING
  1. FLAGIT ;
  1.  U IO(0) D CLS^ASUUHDG
  1.  I '$G(ASUF("RPRN")) D FLAGIT4^ASUV3AN
  1.  D:$D(ASUK("PTR")) C^ASUUZIS
  1.  Q
  1. HEADING ;
  1.  D CLS^ASUUHDG S ASUC("PG")=ASUC("PG")+1,ASUC("LN")=7
  1.  W "REPORT 37C INVENTORY ADJUSTMENT DOUCMENT           DATE: ",ASUK("RUN","DT"),?70," PAGE: ",ASUC("PG")
  1.  W !,"AREA: ",ASUL(1,"AR","NM")
  1.  W !,"STAT: ",ASUL(2,"STA","NM"),?33,"ACCOUNT : ",ASUL(9,"ACC","NM"),?55,"INV. DATE ",ASUV("DTPRNT")
  1.  W !,"VOUCHER NO: ",$E(ASUMV("VOU"),1,2),"-",$E(ASUMV("VOU"),3,4),"-",$E(ASUMV("VOU"),5,8)
  1.  W !!,"ITEM  INDEX"
  1.  W ?34,"U    UNIT       OVERAGE          SHORTAGE"
  1.  W !,"  NO. NUMBER    DESCRIPTION"
  1.  W ?34," I   COST    QTY      VALUE    QTY      VALUE"
  1.  D SEPERATE
  1.  Q
  1. SEPERATE ;
  1.  W !,"_______________________________________________________________________________"
  1.  Q
  1. FOOTING ;
  1.  S ASUC("LN")=0
  1.  W !!?5,"TOTALS:  OVERAGES:  NO. LI: ",$J(ASUC("OVR","LI"),6),?45," VAL: ",$J($FN(ASUC("OVR","VAL"),",",2),10)
  1.  W !?13,"SHORTAGES:  NO. LI: ",$J(ASUC("SHT","LI"),6),?45," VAL: ",$J($FN(ASUC("SHT","VAL"),",",2),10)
  1.  ;I $D(IO("HOME")) HANG 60  ;;ADDED 3/14/95 CSC
  1.  Q
  1. ASUV4AL3 ;
  1.  Q:$G(ASUF("RPRN"))>0
  1.  I '$D(ASUV("TIME")) S ASUV("TIME")=$H G KEY
  1.  F  I ASUV("TIME")'=$H Q
  1.  S ASUV("TIME")=$H
  1. KEY ;
  1.  S ASUT(ASUT,"DTE")=$P(ASUV("DT"),".")_"."_$P(ASUV("TIME"),",",2)
  1.  S ASUT(ASUT,"TRKY")=ASUT(ASUT,"DTE")_"."_DUZ,ASUF("UPDT")=1,ASUC(0)=0
  1.  S ASUT(ASUT,"STA")=ASUL(2,"STA","CD")
  1.  S ASUT(ASUT,"VOU")=ASUMV("VOU")
  1.  S ASUT(ASUT,"IDX")=ASUMV("IDX")
  1.  S ASUC=$G(ASUC)
  1.  S ASUT(ASUT,"ENTR BY")=DUZ
  1.  S ASUT(ASUT,"DTE")=ASUK("DT","FM")
  1.  S ASUT(ASUT,"AR")=ASUL(1,"AR","AP")
  1.  S (ASUT(ASUT,"DTP"),ASUT(ASUT,"DTW"))="",ASUT(ASUT,"STATUS")="Y"
  1.  S ASUT(ASUT,"PT","AR")=ASUT(ASUT,"AR")
  1.  S ASUT(ASUT,"PT","STA")=ASUL(2,"STA","E#")
  1.  I ASUT(ASUT,"IDX")]"" D
  1.  .S ASUT(ASUT,"PT","IDX")=ASUT(ASUT,"AR")_ASUT(ASUT,"IDX")
  1.  E  D
  1.  .S ASUT(ASUT,"PT","IDX")=""
  1.  I $G(ASUT(ASUT,"ACC"))]"" D
  1.  .S ASUT(ASUT,"PT","ACC")=ASUT(ASUT,"ACC")
  1.  E  D
  1.  .I ASUT(ASUT,"PT","IDX")]"",$G(ASUL(1,"AR","WHSE"))>0 D
  1.  ..S ASUT(ASUT,"ACC")=$P($G(^ASUMX(ASUT(ASUT,"PT","IDX"),0)),U,6)
  1.  ..S ASUT(ASUT,"PT","ACC")=ASUT(ASUT,"ACC")
  1.  .E  D
  1.  ..S (ASUT(ASUT,"ACC"),ASUT(ASUT,"PT","ACC"))=""
  1.  S DIC=9002036.6,X=ASUT(ASUT,"TRKY"),DIC(0)="L" D ^DIC
  1.  I Y<0 D
  1.  .W *7,*7,!,"INVENTORY ADJUSTMENT CREATION UNSUCESSFUL",!
  1.  E  D
  1.  .S (DA,ASUHDA)=+Y
  1.  .S ASUC=ASUC+1
  1.  .S ASUF("SV")=1 D WRITE^ASU0TRWR(DA,6)
  1.  ;F X=3:1:22 K ASUL(X)   ;LMH 6/19/00
  1.  K DA,DR,DIC,DIE,ASUMSG,X,Y
  1.  K ASUT(ASUT),ASUC(0)
  1.  Q