ASU2RUPD ; IHS/ITSC/LMH -POST RECEIPTS ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;;This routine posts Receipt transaction data to SAMS masters.
;;It is invoked after the transaction is saved in Screenman.
;; Requires local arrays ASUT, ASUS and ASUM
S:$G(DDSREFT)']"" DDSREFT=$G(ASUV("DDSREFT"))
I $G(ASUS("PO#"))']"" N Z S Z=$G(ASUT(ASUT,"PON")) D POCK(.Z) Q:$G(DDSERROR)
;I ASUT(ASUT,"FPN")="P"!(ASUT("TRCD")="26") D:$G(ASUS("QVP"))="" POM I $G(DDSERROR) D QTY^ASUJCLER Q
S ASUS("PO#")=$G(ASUS("PO#")),ASUS("PO#")=+ASUS("PO#")
I ASUS("PO#")>0 D
.I ASUS("PO#")=2 D
..S ASUMS("D/I","QTY",ASUV("PO#"))=""
..S ASUMS("D/I","VAL",ASUV("PO#"))=""
..S ASUMS("D/I","PO#",ASUV("PO#"))=""
..S ASUMS("D/I","DT",ASUV("PO#"))=""
..S ASUMS("D/I","SSA",ASUV("PO#"))=""
..S ASUMS("D/I","DTR72",ASUV("PO#"))=""
.E D
..S ASUMS("D/I","QTY",ASUV("PO#"))=ASUMS("D/I","QTY",ASUV("PO#"))-ASUT(ASUT,"QTY")
..S ASUMS("D/I","VAL",ASUV("PO#"))=ASUMS("D/I","VAL",ASUV("PO#"))-ASUT(ASUT,"VAL")
I $E(ASUT("TRCD"),2)?1A D Q:$G(ASUF("ERR"))>0
.I ASUMS("QTY","O/H")<ASUT(ASUT,"QTY") D Q
..S ASUF("ERR")=1,DDSERROR=1,Z="Not enough Quantity On Hand - Receipt reversal of "_ASUT(ASUT,"QTY")_" would cause credit balance"
..S ASUT(ASUT,"QTY")=0 S:$G(DIE)']"" DIE=$G(ASUJ("GLOB"))
..D MSG^ASUJHELP(Z),QTY^ASUJSAVE(ASUT(ASUT,"QTY"))
.I ASUMS("VAL","O/H")<ASUT(ASUT,"VAL") D Q
..S ASUF("ERR")=1,DDSERROR=1,Z="Not enough Value On Hand - Receipt reversal of "_ASUT(ASUT,"VAL")_" would cause credit balance"
..S ASUT(ASUT,"VAL")=0 S:$G(DIE)']"" DIE=$G(ASUJ("GLOB"))
..D MSG^ASUJHELP(Z),VAL^ASUJSAVE(ASUT(ASUT,"VAL"))
S ASUMS("VAL","O/H")=ASUMS("VAL","O/H")+(ASUT(ASUT,"VAL")*ASUT(ASUT,"SIGN"))
S ASUMS("QTY","O/H")=ASUMS("QTY","O/H")+(ASUT(ASUT,"QTY")*ASUT(ASUT,"SIGN"))
I ASUT("TRCD")=22,ASUT(ASUT,"SRC")=ASUMS("SRC") D
.I +ASUT(ASUT,"QTY")>0,+ASUT(ASUT,"VAL")>0 D
..S ASUMS("LPP")=$FN((ASUT(ASUT,"VAL")/ASUT(ASUT,"QTY")),"-",2)
S ASUF("SV")=2 D ^ASUJHIST ;Move transaction to History file
I ASUMS("QTY","O/H")>0,ASUMS("D/O","QTY")>0 D
.D EN^ASU3BKOR(ASUMS("E#","IDX"))
S ASUS("ADD")=0 D ^ASUMSTWR
K ASUV("PO#"),ASUS("PO#")
Q
POCK(X) ;EP; PO# Check
Q:ASUT(ASUT,"FPN")']"" Q:X']""
S:'$L($G(ASUS("PO#"))) ASUS("PO#")=0
Q:X=$G(ASUV("PON")) S ASUV("PON")=X
D POCK^ASUJHELP
I ASUT(ASUT,"FPN")="F" D
.F ASUV("PO#")=1:1:3 D
..I ASUMS("D/I","PO#",ASUV("PO#"))=X D
...D POMATCH^ASUJHELP
...S ASUS("PO#")=2
...S ASUT(ASUT,"D/IF")=ASUMS("D/I","QTY",ASUV("PO#"))*-1
...I ASUT("TRCD")'=26 D POM
E D
.F ASUV("PO#")=1:1:3 D
..I ASUMS("D/I","PO#",ASUV("PO#"))=X D
...D POMATCH^ASUJHELP
...S ASUT(ASUT,"D/IF")=0
...I ASUT("TRCD")'=26 D POM
D PLSCONT^ASUJHELP
Q
POM ;Purchase order match
I (ASUT(ASUT,"QTY")'="")&(ASUT(ASUT,"VAL")'="") D ;any valu & any valu
.S ASUS("QVP")=1
.I ASUMS("D/I","QTY",ASUV("PO#"))-ASUT(ASUT,"QTY")>0&((ASUMS("D/I","VAL",ASUV("PO#"))-ASUT(ASUT,"VAL"))>0) D ;Value
..S ASUT(ASUT,"D/IF")=0
..I ASUMS("D/I","QTY",ASUV("PO#"))-ASUT(ASUT,"QTY")=0 D ;Qty
...S ASUS("PO#")=2
..E D
...S ASUS("PO#")=1
.E D
..D RECQTY^ASUJHELP,QTY^ASUJCLER,VAL^ASUJCLER
Q
ASU2RUPD ; IHS/ITSC/LMH -POST RECEIPTS ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;;This routine posts Receipt transaction data to SAMS masters.
+3 ;;It is invoked after the transaction is saved in Screenman.
+4 ;; Requires local arrays ASUT, ASUS and ASUM
+5 IF $GET(DDSREFT)']""
SET DDSREFT=$GET(ASUV("DDSREFT"))
+6 IF $GET(ASUS("PO#"))']""
NEW Z
SET Z=$GET(ASUT(ASUT,"PON"))
DO POCK(.Z)
IF $GET(DDSERROR)
QUIT
+7 ;I ASUT(ASUT,"FPN")="P"!(ASUT("TRCD")="26") D:$G(ASUS("QVP"))="" POM I $G(DDSERROR) D QTY^ASUJCLER Q
+8 SET ASUS("PO#")=$GET(ASUS("PO#"))
SET ASUS("PO#")=+ASUS("PO#")
+9 IF ASUS("PO#")>0
Begin DoDot:1
+10 IF ASUS("PO#")=2
Begin DoDot:2
+11 SET ASUMS("D/I","QTY",ASUV("PO#"))=""
+12 SET ASUMS("D/I","VAL",ASUV("PO#"))=""
+13 SET ASUMS("D/I","PO#",ASUV("PO#"))=""
+14 SET ASUMS("D/I","DT",ASUV("PO#"))=""
+15 SET ASUMS("D/I","SSA",ASUV("PO#"))=""
+16 SET ASUMS("D/I","DTR72",ASUV("PO#"))=""
End DoDot:2
+17 IF '$TEST
Begin DoDot:2
+18 SET ASUMS("D/I","QTY",ASUV("PO#"))=ASUMS("D/I","QTY",ASUV("PO#"))-ASUT(ASUT,"QTY")
+19 SET ASUMS("D/I","VAL",ASUV("PO#"))=ASUMS("D/I","VAL",ASUV("PO#"))-ASUT(ASUT,"VAL")
End DoDot:2
End DoDot:1
+20 IF $EXTRACT(ASUT("TRCD"),2)?1A
Begin DoDot:1
+21 IF ASUMS("QTY","O/H")<ASUT(ASUT,"QTY")
Begin DoDot:2
+22 SET ASUF("ERR")=1
SET DDSERROR=1
SET Z="Not enough Quantity On Hand - Receipt reversal of "_ASUT(ASUT,"QTY")_" would cause credit balance"
+23 SET ASUT(ASUT,"QTY")=0
IF $GET(DIE)']""
SET DIE=$GET(ASUJ("GLOB"))
+24 DO MSG^ASUJHELP(Z)
DO QTY^ASUJSAVE(ASUT(ASUT,"QTY"))
End DoDot:2
QUIT
+25 IF ASUMS("VAL","O/H")<ASUT(ASUT,"VAL")
Begin DoDot:2
+26 SET ASUF("ERR")=1
SET DDSERROR=1
SET Z="Not enough Value On Hand - Receipt reversal of "_ASUT(ASUT,"VAL")_" would cause credit balance"
+27 SET ASUT(ASUT,"VAL")=0
IF $GET(DIE)']""
SET DIE=$GET(ASUJ("GLOB"))
+28 DO MSG^ASUJHELP(Z)
DO VAL^ASUJSAVE(ASUT(ASUT,"VAL"))
End DoDot:2
QUIT
End DoDot:1
IF $GET(ASUF("ERR"))>0
QUIT
+29 SET ASUMS("VAL","O/H")=ASUMS("VAL","O/H")+(ASUT(ASUT,"VAL")*ASUT(ASUT,"SIGN"))
+30 SET ASUMS("QTY","O/H")=ASUMS("QTY","O/H")+(ASUT(ASUT,"QTY")*ASUT(ASUT,"SIGN"))
+31 IF ASUT("TRCD")=22
IF ASUT(ASUT,"SRC")=ASUMS("SRC")
Begin DoDot:1
+32 IF +ASUT(ASUT,"QTY")>0
IF +ASUT(ASUT,"VAL")>0
Begin DoDot:2
+33 SET ASUMS("LPP")=$FNUMBER((ASUT(ASUT,"VAL")/ASUT(ASUT,"QTY")),"-",2)
End DoDot:2
End DoDot:1
+34 ;Move transaction to History file
SET ASUF("SV")=2
DO ^ASUJHIST
+35 IF ASUMS("QTY","O/H")>0
IF ASUMS("D/O","QTY")>0
Begin DoDot:1
+36 DO EN^ASU3BKOR(ASUMS("E#","IDX"))
End DoDot:1
+37 SET ASUS("ADD")=0
DO ^ASUMSTWR
+38 KILL ASUV("PO#"),ASUS("PO#")
+39 QUIT
POCK(X) ;EP; PO# Check
+1 IF ASUT(ASUT,"FPN")']""
QUIT
IF X']""
QUIT
+2 IF '$LENGTH($GET(ASUS("PO#")))
SET ASUS("PO#")=0
+3 IF X=$GET(ASUV("PON"))
QUIT
SET ASUV("PON")=X
+4 DO POCK^ASUJHELP
+5 IF ASUT(ASUT,"FPN")="F"
Begin DoDot:1
+6 FOR ASUV("PO#")=1:1:3
Begin DoDot:2
+7 IF ASUMS("D/I","PO#",ASUV("PO#"))=X
Begin DoDot:3
+8 DO POMATCH^ASUJHELP
+9 SET ASUS("PO#")=2
+10 SET ASUT(ASUT,"D/IF")=ASUMS("D/I","QTY",ASUV("PO#"))*-1
+11 IF ASUT("TRCD")'=26
DO POM
End DoDot:3
End DoDot:2
End DoDot:1
+12 IF '$TEST
Begin DoDot:1
+13 FOR ASUV("PO#")=1:1:3
Begin DoDot:2
+14 IF ASUMS("D/I","PO#",ASUV("PO#"))=X
Begin DoDot:3
+15 DO POMATCH^ASUJHELP
+16 SET ASUT(ASUT,"D/IF")=0
+17 IF ASUT("TRCD")'=26
DO POM
End DoDot:3
End DoDot:2
End DoDot:1
+18 DO PLSCONT^ASUJHELP
+19 QUIT
POM ;Purchase order match
+1 ;any valu & any valu
IF (ASUT(ASUT,"QTY")'="")&(ASUT(ASUT,"VAL")'="")
Begin DoDot:1
+2 SET ASUS("QVP")=1
+3 ;Value
IF ASUMS("D/I","QTY",ASUV("PO#"))-ASUT(ASUT,"QTY")>0&((ASUMS("D/I","VAL",ASUV("PO#"))-ASUT(ASUT,"VAL"))>0)
Begin DoDot:2
+4 SET ASUT(ASUT,"D/IF")=0
+5 ;Qty
IF ASUMS("D/I","QTY",ASUV("PO#"))-ASUT(ASUT,"QTY")=0
Begin DoDot:3
+6 SET ASUS("PO#")=2
End DoDot:3
+7 IF '$TEST
Begin DoDot:3
+8 SET ASUS("PO#")=1
End DoDot:3
End DoDot:2
+9 IF '$TEST
Begin DoDot:2
+10 DO RECQTY^ASUJHELP
DO QTY^ASUJCLER
DO VAL^ASUJCLER
End DoDot:2
End DoDot:1
+11 QUIT
