- 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
