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

ASU3IUPD.m

Go to the documentation of this file. 
  1. ASU3IUPD ; IHS/ITSC/LMH -POST REPLENISHMENT ISS TRANS ;  
  1.  ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
  1.  ;This routine provides logic to post (process) ISSUE transactions
  1.  ;to the SAMS master files.
  1.  Q:$G(DDSERROR)>0  Q:$G(ASUT(ASUT,"QTY","REQ"))=""
  1.  S ASUF("SV")=2 D SETMOIS,UPDATE,^ASUMKBPS,^ASUMYDPS
  1.  G EXIT
  1. RVIS ;EP ;REVERSAL ISSUE
  1.  Q:$G(DDSERROR)>0
  1.  S:'$D(ASUT(ASUT,"QTY","ISS")) ASUT(ASUT,"QTY","ISS")=$G(ASUT(ASUT,"QTY"))
  1.  S ASUF("SV")=2 D SETMOIS,UPDATE
  1.  D:ASUT("TRCD")="3K" ^ASUMKBPS,^ASUMYDPS D:ASUT("TRCD")="3L" ^ASUMYDPS
  1. EXIT ;
  1.  ;K ASUT,ASUF("SV") D PSTKL^ASUCOKIL  ;WAR 5/11/99 INCLUDED IF STMT
  1.  I '$D(ASU("DA CNT")) K ASUT,ASUF("SV") D PSTKL^ASUCOKIL
  1.  Q
  1. TXFIS ;EP ;TRANSFER ISSUE
  1.  Q:$G(DDSERROR)>0
  1.  S:$G(ASUT(ASUT,"QTY","ISS"))="" ASUT(ASUT,"QTY","ISS")=$G(ASUT(ASUT,"QTY"))
  1.  S:$G(DDSREFT)="" DDSREFT=$G(ASUV("DDSREFT"))
  1.  ;D SETMOIS
  1.  D UPDATE Q
  1. SETMOIS ;EP;
  1.  S:$G(DDSREFT)="" DDSREFT=$G(ASUV("DDSREFT"))
  1.  N X
  1.  ;Note the following date manipulation should pass requirement for Y2K
  1.  ;two digit voucher year greater than 85 = 1900+yr all others, 2000+yr
  1.  ;beginning Y2K fix 
  1.  ;I $E(ASUT("TRCD"),2)?1N S X=$S($P(ASUT(ASUT,"VOU"),"-")>85:2,1:3)_$P(ASUT(ASUT,"VOU"),"-")_$P(ASUT(ASUT,"VOU"),"-",2)_"00" S:X>ASUMS("LSTISS") ASUMS("LSTISS")=X
  1.  I $E(ASUT("TRCD"),2)?1N D                                 ;Y2000
  1.  .S X=$P(ASUT(ASUT,"VOU"),"-",2)_$P(ASUT(ASUT,"VOU"),"-")  ;Y2000
  1.  .D START^ASUUY2K(.X,1,U,"N")                                   ;Y2000
  1.  .S X=Y                                                    ;Y2000
  1.  .S:X>ASUMS("LSTISS") ASUMS("LSTISS")=X                    ;Y2000
  1.  ;end Y2K fix block
  1.  S X=$P(ASUT(ASUT,"VOU"),"-",2),Y=(ASUT(ASUT,"SIGN")*-1) S:$E(X)=0 X=$E(X,2)
  1.  S ASUMS("DMD","CALL",X)=$G(ASUMS("DMD","CALL",X))+Y
  1.  S:$G(ASUT(ASUT,"QTY","ISS"))="" ASUT(ASUT,"QTY","ISS")=$G(ASUT(ASUT,"QTY"))
  1.  S ASUMS("DMD","QTY",X)=$G(ASUMS("DMD","QTY",X))+(ASUT(ASUT,"QTY","ISS")*Y)
  1.  Q
  1. UPDATE ;EP;
  1.  S ASUMS("VAL","O/H")=ASUMS("VAL","O/H")+(ASUT(ASUT,"VAL")*ASUT(ASUT,"SIGN"))
  1.  S ASUMS("QTY","O/H")=ASUMS("QTY","O/H")+(ASUT(ASUT,"QTY","ISS")*ASUT(ASUT,"SIGN"))
  1.  S ASUS("ADD")=2 D ^ASUMSTWR K ASUS("ADD")
  1.  S:ASUT(ASUT,"FPN")="B" ASUT(ASUT,"FPN")="N"
  1.  D ^ASUJHIST ;Move transaction to History file
  1.  Q
  1. FILLSTAT(X) ;EP ;CALCULATE FILL STATUS (F=FULL, P=PART, N=NONE)
  1.  ; X=Quantity Requested
  1.  Q:$E(ASUT("TRCD"),2)?1A
  1.  N Z
  1.  S (ASUT(ASUT,"B/O"),ASUT(ASUT,"FPN"),ASUT(ASUT,"QTY","ADJ"))=""
  1.  S ASUF("ERR")=0
  1.  ;WAR 5/7/99S ASUF("ERR")=0,ASUT(ASUT,"B/O")="",ASUT(ASUT,"QTY","ADJ")=""
  1.  I $G(ASUT(ASUT,"PST"))="I" D
  1.  .I X=0!(ASUMS("QTY","O/H")=0) D
  1.  ..I ASUMS("QTY","O/H")'>0,X>0 D
  1.  ...S ASUF("ERR")=1,DDSERROR=1,Z="No Quantity On Hand - Issuing "_X_" would cause a credit balance"
  1.  ...S ASUT(ASUT,"FPN")="",ASUT(ASUT,"QTY","ISS")=""
  1.  ...D HLP^ASUJHELP(Z),QTY^ASUJCLER,QTYI^ASUJSAVE(ASUT(ASUT,"QTY","ISS")),FPN^ASUJSAVE(ASUT(ASUT,"FPN"))
  1.  ..S (ASUT(ASUT,"QTY","ISS"),ASUT(ASUT,"QTY"),ASUT(ASUT,"QTY","REQ"))=0
  1.  ..S ASUT(ASUT,"FPN")="N",ASUT(ASUT,"VAL")=0
  1.  .E  D
  1.  ..I ASUMS("QTY","O/H")<X D  Q
  1.  ...S ASUF("ERR")=1,DDSERROR=1,Z="Not enough Quantity On Hand - Issuing "_X_" would cause a credit balance"
  1.  ...S ASUT(ASUT,"FPN")="",ASUT(ASUT,"QTY","ISS")=""
  1.  ...D HLP^ASUJHELP(Z),QTY^ASUJCLER,QTYI^ASUJSAVE(ASUT(ASUT,"QTY","ISS")),FPN^ASUJSAVE(ASUT(ASUT,"FPN"))
  1.  ..S ASUT(ASUT,"FPN")=$G(ASUT(ASUT,"FPN")) S:ASUT(ASUT,"FPN")="" ASUT(ASUT,"FPN")="F"  ;DFM 4/7/99
  1.  ..I $G(ASUT(ASUT,"FPN"))="F" D
  1.  ...S ASUT(ASUT,"QTY","ISS")=X S (Z,Y)="" D MSUNCST(.Z,.Y) S ASUT(ASUT,"VAL")=Y
  1.  ..E  D
  1.  ...I $G(ASUT(ASUT,"FPN"))="P" D
  1.  ....I ASUT(ASUT,"QTY","ISS")]"" D
  1.  .....S (Z,Y)="" D MSUNCST(.Z,.Y) S ASUT(ASUT,"VAL")=Y
  1.  ....E  D
  1.  .....S ASUT(ASUT,"QTY","ISS")=X
  1.  .....S (Z,Y)="" D MSUNCST(.Z,.Y) S ASUT(ASUT,"VAL")=Y
  1.  E  D
  1.  .I ASUT(ASUT,"FPN")="" D
  1.  ..S ASUT(ASUT,"QTY","ADJ")="",ASUS("QTYAJ")=0
  1.  ..S Z=ASUT(ASUT,"QTY","REQ"),Y="" D SPQ^ASU3ISQA(.Z,.Y) S ASUT(ASUT,"QTY","ISS")=Y
  1.  ..I ASUT(ASUT,"QTY","ISS")'=ASUT(ASUT,"QTY","REQ") D
  1.  ...S Z="Requested quantity adjusted to comply with Standard Pack Quantity" D HLP^ASUJHELP(Z) ;DFM P1 9/1/98 WAR 5/3/99
  1.  ...S ASUT(ASUT,"QTY","ADJ")="A",ASUS("QTYAJ")=1
  1.  ..E  D
  1.  ...S ASUT(ASUT,"QTY","ADJ")="",ASUS("QTYAJ")=0
  1.  .;I ASUMS("QTY","O/H")=ASUT(ASUT,"QTY","ISS")!(ASUMS("QTY","O/H")>ASUT(ASUT,"QTY","ISS")) D
  1.  .I ASUMS("QTY","O/H")'<ASUT(ASUT,"QTY","ISS") D  ;WAR 5/5/99
  1.  ..S ASUT(ASUT,"FPN")="F"
  1.  .E  D
  1.  ..I ASUT("TRCD")'=32 D  Q
  1.  ...S ASUF("ERR")=1,DDSERROR=1
  1.  ...S Z="Not enough Quantity On Hand - would cause credit balance" D HLP^ASUJHELP(Z) ;DFM P1 9/1/98 WAR 5/3/99
  1.  ...D QTY^ASUJCLER
  1.  ..;I ASUMS("QTY","O/H")=0!(ASUMS("QTY","O/H")<0) D
  1.  ..I ASUMS("QTY","O/H")'>0 D                         ;WAR 5/5/99
  1.  ...S ASUT(ASUT,"FPN")="N",ASUT(ASUT,"QTY","ISS")=0
  1.  ..E  D
  1.  ...S ASUT(ASUT,"FPN")="P"
  1.  ...S ASUT(ASUT,"QTY","ISS")=ASUMS("QTY","O/H")
  1.  .I ASUT(ASUT,"FPN")="N" S ASUF("ERR")=0 D  ;Q:ASUF("ERR")
  1.  ..;D QTYREQ^ASUJHELP  ;WAR 5/5/99 and the next 5 lines
  1.  ..S Z="No Quantity On Hand - will attempt to Backorder" D HLP^ASUJHELP(Z) ;DFM P1 9/1/98 WAR 5/3/99
  1.  ..S X=ASUT(ASUT,"QTY","REQ")
  1.  ..N Q S Q=X D BKORDR(.Q)
  1.  ..I ASUF("ERR") S:ASUF("ERR")=7 ASUT(ASUT,"FPN")="B" S ASUT(ASUT,"QTY","ISS")=0,ASUT(ASUT,"VAL")=0 D QTY^ASUJCLER,VAL^ASUJCLER Q
  1.  ..S ASUV("CST/U")=0,ASUMS("D/O","QTY")=Q
  1.  .I ASUT(ASUT,"FPN")="P" D
  1.  ..;D QTYREQ^ASUJHELP  ;WAR 5/5/99 and next 10 lines
  1.  ..S X=ASUT(ASUT,"QTY","REQ")-ASUMS("QTY","O/H"),ASUT(ASUT,"QTY","ISS")=ASUMS("QTY","O/H")
  1.  ..S Z="Not enough Quantity to fill order - will attempt to Backorder "_X D HLP^ASUJHELP(Z) ;DFM P1 9/1/98 WAR 5/3/99
  1.  ..N Q S Q=X,ASUF("ERR")=0 D BKORDR(.Q)
  1.  ..I ASUF("ERR") D VAL^ASUJCLER,QTY^ASUJCLER Q
  1.  ..S ASUT(ASUT,"B/O")="B"
  1.  ..S ASUMS("D/O","QTY")=ASUMS("D/O","QTY")+Q
  1.  ..S:'$D(ASUT(ASUT,"PON")) ASUT(ASUT,"PON")=""
  1.  ..S:'$D(ASUT(ASUT,"SUI")) ASUT(ASUT,"SUI")=""
  1.  ..S:'$D(ASUT(ASUT,"SRC")) ASUT(ASUT,"SRC")=""
  1.  ..S:'$D(ASUT(ASUT,"REQ TYP")) ASUT(ASUT,"REQ TYP")=""
  1.  .I ASUMS("QTY","O/H")'>0 D
  1.  ..S ASUT(ASUT,"VAL")=0 D VAL^ASUJCLER
  1.  .E  D
  1.  ..I ASUT(ASUT,"FPN")'="N" S (Z,Y)="" D MSUNCST(.Z,.Y) S ASUT(ASUT,"VAL")=Y
  1.  S:$G(DA)="" DA=ASUHDA
  1.  S DDSERROR="",Z=ASUT(ASUT,"VAL") D VAL^ASUJVALF(.Z,.DDSERROR)
  1.  S Z=ASUT(ASUT,"FPN") D FPN^ASUJSAVE(.Z)
  1.  Q:"2P37"[ASUT("TRCD")
  1.  S DDSERROR="",Z=ASUT(ASUT,"QTY","ISS") D EN^ASUJVALD(.Z,.DDSERROR,"QTYI","N")
  1.  Q
  1. MSUNCST(X,Y) ;EP; -Calculate Unit cost for issue from Station Master QTY & VAL
  1.  N Z S Z=ASUT(ASUT,"QTY","ISS") D UCSVAL(.Z,.X,.Y)
  1.  I ASUMS("QTY","O/H")-ASUT(ASUT,"QTY","ISS")=0 S Y=ASUMS("VAL","O/H")
  1.  I Y>ASUMS("VAL","O/H") S Y=ASUMS("VAL","O/H")
  1.  Q
  1. UCSVAL(Z,X,Y) ;EP
  1.  ;Z - Quantity
  1.  ;X - Returns Unit Cost
  1.  ;Y - Returns value of (Unit cost X Quantity)
  1.  S X=$S(ASUMS("VAL","O/H")=0!(ASUMS("VAL","O/H")=""):0,ASUMS("QTY","O/H")=0!(ASUMS("QTY","O/H")=""):0,1:$FN((ASUMS("VAL","O/H")/ASUMS("QTY","O/H")),"",2))
  1.  I $G(ASUT("TRCD"))=27 S:X=0 X=$G(ASUMS("LPP"))
  1.  I $G(ASUT("TRCD"))=31 S:X=0 X=$G(ASUMS("LPP"))
  1.  S Y=+$G(X)*(+$G(Z)),ASUMB("UCS")=$G(X)
  1.  Q
  1. BKORDR(Q) ;CREATE ISSUE BACKORDER
  1.  ;Q - QUANTITY TO BACKORDER
  1.  S ASUVQBO=Q
  1.  I $G(ASUT(ASUT,"SST"))="" D  Q
  1.  .S Z="Can't Backorder - No Sub Station Code" D HLP^ASUJHELP(Z) S ASUF("ERR")=1 ;DFM P1 9/1/98
  1.  I $G(ASUT(ASUT,"USR"))="" D  Q
  1.  .S Z="Can't Backorder - No User Code" D HLP^ASUJHELP(Z) S ASUF("ERR")=2 ;DFM P1 9/1/98
  1.  S ASUMB("E#","USR")=$G(ASUT(ASUT,"PT","USR")),ASUMB("E#","REQ")=$G(ASUT(ASUT,"PT","REQ")),ASUMB("E#","IDX")=$G(ASUT(ASUT,"PT","IDX"))
  1.  S ASUF("ERR")=0
  1.  ;D REQ^ASUMBOIO(ASUMB("E#","USR")) ;Lookup REQ in Backorder master
  1.  D REQ^ASUMBOIO(ASUMB("E#","REQ"))  ;WAR 5/4/99 line above is incorrect
  1.  I Y<1 D  Q:ASUF("ERR")
  1.  .I Y=0 D  ;No backorders on file for Requsitioner
  1.  ..D REQADD^ASUMBOIO(ASUMB("E#","REQ")) ;Add REQ to Backorder master
  1.  ..N Z I Y<0 D  ;Error in add
  1.  ...S Z="Backorder for Requsitioner : "_ASUMB("E#","REQ")_" not created - error code="_Y D HLP^ASUJHELP(Z) S ASUF("ERR")=3
  1.  .E  D  ;Error -requsitioner not in lookup table
  1.  ..S Z="Requsitioner : "_ASUMB("E#","REQ")_" not valid - error code="_Y D HLP^ASUJHELP(Z) S ASUF("ERR")=4
  1.  N Z S Z(0)=ASUT("TRCD") S ASUT("TRCD")=31 D UCSVAL(.ASUVQBO,.ASUVUCS,.ASUVAL) S ASUT("TRCD")=Z(0) S ASUMB("VAL")=ASUVAL,ASUMB("UCS")=ASUVUCS,ASUMB("QTYB/O")=ASUVQBO
  1.  K ASUVAL,ASUVUCS,ASUVQBO
  1.  S ASUMB("QTYISS")=ASUT(ASUT,"QTY","ISS")
  1.  D IDX^ASUMBOIO(ASUMB("E#","IDX")) ;Lookup IDX in Backorder master
  1.  N Z I Y<1 D  Q:$D(ASUM("ERR"))
  1.  .I Y=0 D  ;No backorder on file for this item for this requsitioner
  1.  ..D IDXADD^ASUMBOIO(ASUMB("E#","IDX")) ;Add IDX to Backorder master
  1.  ..I Y<0 D  ;Error Index master not on file
  1.  ...S Z="Index : "_ASUMB("E#","IDX")_" not valid - error code="_Y D HLP^ASUJHELP(Z) S ASUF("ERR")=5
  1.  .E  D  ;Error Index master not on file
  1.  ..S Z="Index : "_ASUMB("E#","IDX")_" not valid - error code="_Y D HLP^ASUJHELP(Z) S ASUF("ERR")=6
  1.  E  D  Q
  1.  .S Z="Backorder already on file for Vou# "_ASUVOU_" w/this Requsitoner and Index" D HLP^ASUJHELP(Z) S ASUF("ERR")=7
  1.  .S ASUT(ASUT,"VAL")=0,X=0
  1.  D READBO^ASUMBOIO ;Read Backorder master into variables
  1.  D:$G(ASUSB)'=1 PUT^DDSVALF("BOQTY","","",Q)
  1.  S ASUMB("DT")=ASUT(ASUT,"DTR"),ASUMB("DTPS")=ASUK("DT","FM")
  1.  N V S V=ASUT(ASUT,"VOU") D
  1.  .I V["-" D
  1.  ..S ASUMB("VOU")=$P(V,"-")_"-"_$P(V,"-",2)_"-",V("#")=$P(V,"-",3)
  1.  .E  D
  1.  ..S ASUMB("VOU")=$E(V,1,2)_"-"_$E(V,3,4)_"-",V("#")=$E(V,5,8)
  1.  I V("#")<5000 D
  1.  .S V("#")=V("#")+5000
  1.  E  D
  1.  .S V("#")="5"_$E(V("#"),2,4)
  1.  S ASUMB("VOU")=ASUMB("VOU")_V("#")
  1.  I $G(ASUSB)'=1 D PUT^DDSVALF("BOVOU","","",ASUMB("VOU")),PUT^DDSVALF("BOQTY","","",Q)
  1.  E  W "B.O. Vou:",V
  1.  D UPDTBO^ASUMBOIO ;Write Backorder master from variables
  1.  Q