ASU3BKOR ; IHS/ITSC/LMH -RELEASE BACKORDER ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;;This routine provides logic for checking all back orders to see if
;;they may be released during the update which calls it.
;; Requires local arrays ASUC, ASUL, ASUM, ASUMB, ASUT, ASUV
EN(X) ;EP; CHECK FOR BACKORDER FOR INDEX X
S ASUMB("E#","IDX")=X,ASUMB("E#","QTY")=""
F S ASUMB("E#","QTY")=$O(^ASUMB("AC",ASUMB("E#","IDX"),ASUMB("E#","QTY"))) Q:ASUMB("E#","QTY")="" D
.S ASUMB("E#","REQ")="" N Z
.F S ASUMB("E#","REQ")=$O(^ASUMB("AC",ASUMB("E#","IDX"),ASUMB("E#","QTY"),ASUMB("E#","REQ"))) Q:ASUMB("E#","REQ")="" D
..I '$D(^ASUMB(ASUMB("E#","REQ"),1,ASUMB("E#","IDX"),0)) Q
..S ASUM("RMK-B/O")="",ASUT("TRCD")="31",ASUT("TYPE")=3
..;S ASUV("TR")=$G(ASUT("TRCD")),ASUV("TP")=$G(ASUT("TYPE")),ASUV("DA")=ASUHDA
..D ^ASUMBOIO ;Read Backorder Master
..S ASUC("TR")=$G(ASUC("TR"))+1
..S ASUT="BOR"
..D GENBOR ;Copy Backorder Master fields into Transaction array
..S Z="Releasing Backorder for this item. Requested by: "_ASUL(22,"PGM","NM")_" - "_ASUL(20,"REQ","NM")_". For a quantity of: "_ASUMB("QTYB/O") W *7 D MSG^ASUJHELP(Z) ;DFM P1 9/1/98
..S X=ASUT(ASUT,"QTY"),Y="" D SPQ^ASU3ISQA(.X,.Y) ;Adjust quantity to standard pack, if aplicable
..S ASUT(ASUT,"QTY","ISS")=Y ;use adjusted qty if set
..I ASUT(ASUT,"QTY")'=Y D ;Quantity was adjusted
...S ASUT("RMK")="B/O-R ADJ"_ASUT(ASUT,"QTY")-ASUT(ASUT,"QTY","ISS")
..I ASUMS("QTY","O/H")<ASUT(ASUT,"QTY","ISS") D ;Only release qty available (partial)
...S ASUT(ASUT,"FPN")="P"
...S ASUT(ASUT,"QTY","ISS")=ASUMS("QTY","O/H")
...S ASUMS("D/O","QTY")=ASUMS("D/O","QTY")-ASUT(ASUT,"QTY","ISS")
...S ASUT(ASUT,"QTY","B/O")=ASUT(ASUT,"QTY","REQ")-ASUT(ASUT,"QTY","ISS")
...S ASUT("RMK")="B/O-R PAR"
...S Z="Unable to release requested quantity of "_ASUMB("QTYB/O") ;DFM P1 9/1/98
...S Z=Z_". A partial release of "_ASUT(ASUT,"QTY","ISS")_" will be made." ;DFM P1 9/1/98
...S Z=Z_" A quantity of "_ASUT(ASUT,"QTY","B/O")_" will remain on backorder." ;DFM P1 9/1/98
...W *7 D MSG^ASUJHELP(Z) ;DFM P1 9/1/98
...D BORESET
...S DA(1)=ASUMB("E#","REQ"),DA=ASUMB("E#","IDX")
...D KFAC^ASUMBOIO,KAC^ASUMBOIO ;Kill Master cross references
...D WRITEBO^ASUMBOIO ;Update Backorder Master from transaction array
...D SFAC^ASUMBOIO,SAC^ASUMBOIO ;Reset Master cross references
..E D ;Able to release full qty
...S Z="Full release of backorder for a quantity of "_ASUT(ASUT,"QTY","ISS")_" was posted." W *7 D MSG^ASUJHELP(Z) ;DFM P1 9/1/98
...S ASUT(ASUT,"FPN")="F" ;Update Master due out qty
...S ASUMS("D/O","QTY")=ASUMS("D/O","QTY")-ASUT(ASUT,"QTY","ISS")
...D BORESET
...S DA=ASUMB("E#","IDX"),DA(1)=ASUMB("E#","REQ"),DIK="^ASUMB("_DA(1)_",1," D ^DIK
...I $P(^ASUMB(DA(1),1,0),U,4)=0 D
....S DA=ASUMB("E#","REQ"),DIK="^ASUMB(" D ^DIK
..S X=ASUK("DT","FM")_"."_ASUK("TIME","F")_"."_DUZ,DIC(0)="L",DIC=9002036.3 D ^DIC
..S ASUV(ASUT,"E#")=+Y,ASUT(ASUT,"TRKY")=X
..S ASUM("TRTYP")="REGULAR"
..D ^ASUMKBPS,^ASUMYDPS
..D TR31(ASUV(ASUT,"E#")),UPDATE^ASU3IUPD
;K ASUT M ASUT=ASUTS S ASUT("TRCD")=ASUV("TR"),ASUT("TYPE")=ASUV("TP"),ASUHDA=ASUV("DA")
Q
BORESET ;EP; -RESETS TOTAL VALUE & TOTAL QUANTITY ON BACK ORDERS
N X S X="" D MSUNCST^ASU6JUPD(.X) S ASUT(ASUT,"UCS")=X,ASUT(ASUT,"VAL")=X*ASUT(ASUT,"QTY","ISS")
I ASUT(ASUT,"VAL")>ASUMS("VAL","O/H") S ASUT(ASUT,"VAL")=ASUMS("VAL","O/H")
S ASUT(ASUT,"SIGN")=-1 D SETMOIS^ASU3IUPD
I ASUT(ASUT,"VAL")>ASUMS("VAL","O/H")!(ASUMS("QTY","O/H")=ASUT(ASUT,"QTY","ISS")) S ASUT(ASUT,"VAL")=ASUMS("VAL","O/H")
Q
GENBOR ;EP ;GENERATE BACKORDER RELEASE TRANSACTION (31)
S ASUT("TRCD")=31,ASUT("TYPE")=3
S ASUT(ASUT,"AR")=ASUL(1,"AR","AP")
S ASUT(ASUT,"PT","AR")=ASUL(1,"AR","AP")
S ASUT(ASUT,"PT","STA")=$G(ASUL(2,"STA","E#"))
S ASUT(ASUT,"ACC")=ASUMB("ACC")
S ASUT(ASUT,"PT","ACC")=ASUMB("ACC")
S ASUT(ASUT,"IDX")=ASUMB("IDX")
S ASUT(ASUT,"PT","IDX")=ASUL(1,"AR","AP")_ASUT(ASUT,"IDX")
S ASUT(ASUT,"ENTR BY")=DUZ
S ASUT(ASUT,"DTE")=ASUK("DT","FM")
S ASUT(ASUT,"DTP")=ASUK("DT","FM")
S ASUT(ASUT,"DTW")=""
S ASUT(ASUT,"STATUS")="U"
S ASUT(ASUT,"SSA")=ASUMB("SSA") D:ASUT(ASUT,"SSA")]"" SSA^ASULDIRR(ASUT(ASUT,"SSA"))
S ASUT(ASUT,"PT","SSA")=$G(ASUL(17,"SSA","E#"))
S ASUT(ASUT,"SST")=ASUMB("SST") D:ASUT(ASUT,"SST")]"" SST^ASULDIRR(ASUT(ASUT,"SST"))
S:$L(ASUT(ASUT,"SST"))=5 ASUT(ASUT,"SST")=$E(ASUT(ASUT,"SST"),4,5)
S ASUT(ASUT,"PT","SST")=$G(ASUL(18,"SST","E#"))
S ASUT(ASUT,"USR")=ASUMB("USR") D:ASUT(ASUT,"USR")]"" USR^ASULDIRR(ASUT(ASUT,"USR"))
S ASUT(ASUT,"PT","USR")=$G(ASUL(19,"USR","E#"))
D:ASUT(ASUT,"PT","USR")]"" REQ^ASULDIRR(ASUT(ASUT,"PT","USR"))
S ASUT(ASUT,"PT","REQ")=$G(ASUL(20,"REQ","E#"))
S ASUT(ASUT,"REQ")=$G(ASUL(20,"REQ"))
S ASUT(ASUT,"PT","EOQ TYP")=""
S ASUT(ASUT,"CALCED")=1
S ASUT(ASUT,"DTR")=ASUK("DT","FM")
S ASUT(ASUT,"VOU")=ASUMB("VOU")
S (ASUT(ASUT,"QTY","REQ"),ASUT(ASUT,"QTY"))=ASUMB("QTYB/O")
S ASUT(ASUT,"VAL")=""
S ASUT(ASUT,"CAN")=ASUMB("CAN")
S ASUT(ASUT,"B/O")=ASUMB("B/O")
S ASUT(ASUT,"QTY","ADJ")=ASUMB("QTYAJ")
S ASUT(ASUT,"CTG")=ASUMB("CTG")
S ASUT(ASUT,"SLC")=ASUMB("SLC"),ASUT(ASUT,"PT","SLC")=ASUMB("E#","SLC")
S ASUT(ASUT,"RQN")=ASUMB("RQN")
S ASUT(ASUT,"REQ TYP")=ASUMB("REQTYP")
S ASUT(ASUT,"STA")=ASUMB("STA")
S ASUT(ASUT,"FPN")=ASUMB("FPN")
S ASUT(ASUT,"UCS")=ASUMB("UCS")
S ASUT(ASUT,"ORD")=""
S:'$D(ASUT(ASUT,"PON")) ASUT(ASUT,"PON")=""
S ASUT(ASUT,"EOQ TYP")=""
S ASUT(ASUT,"PST")=""
S ASUT(ASUT,"ISSTY")=3
S ASUT(ASUT,"SUI")=$G(ASUT(ASUT,"SUI"))
S ASUT(ASUT,"SRC")=$G(ASUT(ASUT,"SRC"))
Q
BKORDCAN ;EP;
;This routine provides for posting a Cancel Pending Backorder
;transaction to the Backorder file.
S DIC(0)="MXZ",DIC=9002035,X=ASUT(ASUT,"PT","REQ") D ^DIC
I Y<0 S ASUM("RMK")="B/O NOT MATCH" N Z S Z="Unable to cancel Back Order - no match" W *7 D MSG^ASUJHELP(.Z) S DDSERROR=1 Q ;DFM P1 9/1/98
I Y>0 S ASUMB("E#","REQ")=+Y D
.S ASUMB("E#","IDX")=ASUMX("E#","IDX")
.S ASUMB("QTYB/O")=$P(^ASUMB(ASUMB("E#","REQ"),1,ASUMB("E#","IDX"),0),U,4)
.S ASUMS("D/O","QTY")=ASUMS("D/O","QTY")-ASUMB("QTYB/O")
.S:ASUMS("D/O","QTY")'>0 ASUMS("D/O","QTY")=""
.S $P(^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX"),2),U,2)=ASUMS("D/O","QTY")
.S DIE="^ASUMB(ASUMB(""E#"",""REQ""),1,"
.S DR=".01///@"
.S DA(1)=ASUMB("E#","REQ")
.S DA=ASUMB("E#","IDX"),ASUMB(0)=^ASUMB(DA(1),1,DA,0),ASUMB(1)=$G(^ASUMB(DA(1),1,DA,1))
.K Y D ^DIE
.I $D(Y) S ASUM("RMK")="B/O NOT CANCELLED" N Z S Z="Unable to cancel Back Order" W *7 D MSG^ASUJHELP(.Z) S DDSERROR=2 ;DFM P1 9/1/98
.E S ASUM("RMK")="B/O CANCELLED"
Q:$G(DDSERROR)>0
D ^ASUJHIST ;Move transaction to History file
Q
TR31(X) ;EP ;ADD NEW BACKORDER RELEASE TRANSACTION
S ASUHDA=X
S ASUT(ASUT,"STATUS")="U"
S ASUT(ASUT,"DTW")=""
S ASUT(ASUT,"DTE")=""
S ASUT(ASUT,"DTP")=ASUK("DT","FM")
S ASUT(ASUT,"ISSTY")=3
S ASUT(ASUT,"PST")=""
S ASUT(ASUT,"PT","SSA")=$G(ASUL(17,"SSA","E#"))
S ASUT(ASUT,"PT","SST")=$G(ASUL(18,"SST","E#"))
S ASUT(ASUT,"PT","USR")=$G(ASUL(19,"USR","E#"))
S ASUT(ASUT,"PT","REQ")=$G(ASUL(20,"REQ","E#"))
S ASUT(ASUT,"PT","EOQ TYP")=$G(ASUL(6,"EOQTP","E#"))
S ASUT(ASUT,"PT","AR")=ASUT(ASUT,"AR")
S ASUT(ASUT,"PT","STA")=$G(ASUL(2,"STA","E#"))
S ASUT(ASUT,"PT","ACC")=ASUT(ASUT,"ACC")
S ASUT(ASUT,"PT","IDX")=ASUT(ASUT,"AR")_ASUT(ASUT,"IDX")
S ASUT(ASUT,"ENTR BY")=DUZ
S ASUT(ASUT,"CALCED")=""
S ASUF("SV")=2
Q
REINDX ;
F X=0:0 S X=$O(^ASUMB(X)) Q:X']"" D
.I X?1A.A K ^ASUMB(X) Q
.F Y=0:0 S Y=$O(^ASUMB(X,1,Y)) Q:Y']"" D
..I Y?1A.A K ^ASUMB(X,1,Y) Q
..S Z="AAA" F S Z=$O(^ASUMB(X,1,Y,1,Z)) Q:Z']"" K ^ASUMB(X,1,Y,1,Z)
S DIK="^ASUMB(" D IXALL^DIK
Q
ASU3BKOR ; IHS/ITSC/LMH -RELEASE BACKORDER ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;;This routine provides logic for checking all back orders to see if
+3 ;;they may be released during the update which calls it.
+4 ;; Requires local arrays ASUC, ASUL, ASUM, ASUMB, ASUT, ASUV
EN(X) ;EP; CHECK FOR BACKORDER FOR INDEX X
+1 SET ASUMB("E#","IDX")=X
SET ASUMB("E#","QTY")=""
+2 FOR
SET ASUMB("E#","QTY")=$ORDER(^ASUMB("AC",ASUMB("E#","IDX"),ASUMB("E#","QTY")))
IF ASUMB("E#","QTY")=""
QUIT
Begin DoDot:1
+3 SET ASUMB("E#","REQ")=""
NEW Z
+4 FOR
SET ASUMB("E#","REQ")=$ORDER(^ASUMB("AC",ASUMB("E#","IDX"),ASUMB("E#","QTY"),ASUMB("E#","REQ")))
IF ASUMB("E#","REQ")=""
QUIT
Begin DoDot:2
+5 IF '$DATA(^ASUMB(ASUMB("E#","REQ"),1,ASUMB("E#","IDX"),0))
QUIT
+6 SET ASUM("RMK-B/O")=""
SET ASUT("TRCD")="31"
SET ASUT("TYPE")=3
+7 ;S ASUV("TR")=$G(ASUT("TRCD")),ASUV("TP")=$G(ASUT("TYPE")),ASUV("DA")=ASUHDA
+8 ;Read Backorder Master
DO ^ASUMBOIO
+9 SET ASUC("TR")=$GET(ASUC("TR"))+1
+10 SET ASUT="BOR"
+11 ;Copy Backorder Master fields into Transaction array
DO GENBOR
+12 ;DFM P1 9/1/98
SET Z="Releasing Backorder for this item. Requested by: "_ASUL(22,"PGM","NM")_" - "_ASUL(20,"REQ","NM")_". For a quantity of: "_ASUMB("QTYB/O")
WRITE *7
DO MSG^ASUJHELP(Z)
+13 ;Adjust quantity to standard pack, if aplicable
SET X=ASUT(ASUT,"QTY")
SET Y=""
DO SPQ^ASU3ISQA(.X,.Y)
+14 ;use adjusted qty if set
SET ASUT(ASUT,"QTY","ISS")=Y
+15 ;Quantity was adjusted
IF ASUT(ASUT,"QTY")'=Y
Begin DoDot:3
+16 SET ASUT("RMK")="B/O-R ADJ"_ASUT(ASUT,"QTY")-ASUT(ASUT,"QTY","ISS")
End DoDot:3
+17 ;Only release qty available (partial)
IF ASUMS("QTY","O/H")<ASUT(ASUT,"QTY","ISS")
Begin DoDot:3
+18 SET ASUT(ASUT,"FPN")="P"
+19 SET ASUT(ASUT,"QTY","ISS")=ASUMS("QTY","O/H")
+20 SET ASUMS("D/O","QTY")=ASUMS("D/O","QTY")-ASUT(ASUT,"QTY","ISS")
+21 SET ASUT(ASUT,"QTY","B/O")=ASUT(ASUT,"QTY","REQ")-ASUT(ASUT,"QTY","ISS")
+22 SET ASUT("RMK")="B/O-R PAR"
+23 ;DFM P1 9/1/98
SET Z="Unable to release requested quantity of "_ASUMB("QTYB/O")
+24 ;DFM P1 9/1/98
SET Z=Z_". A partial release of "_ASUT(ASUT,"QTY","ISS")_" will be made."
+25 ;DFM P1 9/1/98
SET Z=Z_" A quantity of "_ASUT(ASUT,"QTY","B/O")_" will remain on backorder."
+26 ;DFM P1 9/1/98
WRITE *7
DO MSG^ASUJHELP(Z)
+27 DO BORESET
+28 SET DA(1)=ASUMB("E#","REQ")
SET DA=ASUMB("E#","IDX")
+29 ;Kill Master cross references
DO KFAC^ASUMBOIO
DO KAC^ASUMBOIO
+30 ;Update Backorder Master from transaction array
DO WRITEBO^ASUMBOIO
+31 ;Reset Master cross references
DO SFAC^ASUMBOIO
DO SAC^ASUMBOIO
End DoDot:3
+32 ;Able to release full qty
IF '$TEST
Begin DoDot:3
+33 ;DFM P1 9/1/98
SET Z="Full release of backorder for a quantity of "_ASUT(ASUT,"QTY","ISS")_" was posted."
WRITE *7
DO MSG^ASUJHELP(Z)
+34 ;Update Master due out qty
SET ASUT(ASUT,"FPN")="F"
+35 SET ASUMS("D/O","QTY")=ASUMS("D/O","QTY")-ASUT(ASUT,"QTY","ISS")
+36 DO BORESET
+37 SET DA=ASUMB("E#","IDX")
SET DA(1)=ASUMB("E#","REQ")
SET DIK="^ASUMB("_DA(1)_",1,"
DO ^DIK
+38 IF $PIECE(^ASUMB(DA(1),1,0),U,4)=0
Begin DoDot:4
+39 SET DA=ASUMB("E#","REQ")
SET DIK="^ASUMB("
DO ^DIK
End DoDot:4
End DoDot:3
+40 SET X=ASUK("DT","FM")_"."_ASUK("TIME","F")_"."_DUZ
SET DIC(0)="L"
SET DIC=9002036.3
DO ^DIC
+41 SET ASUV(ASUT,"E#")=+Y
SET ASUT(ASUT,"TRKY")=X
+42 SET ASUM("TRTYP")="REGULAR"
+43 DO ^ASUMKBPS
DO ^ASUMYDPS
+44 DO TR31(ASUV(ASUT,"E#"))
DO UPDATE^ASU3IUPD
End DoDot:2
End DoDot:1
+45 ;K ASUT M ASUT=ASUTS S ASUT("TRCD")=ASUV("TR"),ASUT("TYPE")=ASUV("TP"),ASUHDA=ASUV("DA")
+46 QUIT
BORESET ;EP; -RESETS TOTAL VALUE & TOTAL QUANTITY ON BACK ORDERS
+1 NEW X
SET X=""
DO MSUNCST^ASU6JUPD(.X)
SET ASUT(ASUT,"UCS")=X
SET ASUT(ASUT,"VAL")=X*ASUT(ASUT,"QTY","ISS")
+2 IF ASUT(ASUT,"VAL")>ASUMS("VAL","O/H")
SET ASUT(ASUT,"VAL")=ASUMS("VAL","O/H")
+3 SET ASUT(ASUT,"SIGN")=-1
DO SETMOIS^ASU3IUPD
+4 IF ASUT(ASUT,"VAL")>ASUMS("VAL","O/H")!(ASUMS("QTY","O/H")=ASUT(ASUT,"QTY","ISS"))
SET ASUT(ASUT,"VAL")=ASUMS("VAL","O/H")
+5 QUIT
GENBOR ;EP ;GENERATE BACKORDER RELEASE TRANSACTION (31)
+1 SET ASUT("TRCD")=31
SET ASUT("TYPE")=3
+2 SET ASUT(ASUT,"AR")=ASUL(1,"AR","AP")
+3 SET ASUT(ASUT,"PT","AR")=ASUL(1,"AR","AP")
+4 SET ASUT(ASUT,"PT","STA")=$GET(ASUL(2,"STA","E#"))
+5 SET ASUT(ASUT,"ACC")=ASUMB("ACC")
+6 SET ASUT(ASUT,"PT","ACC")=ASUMB("ACC")
+7 SET ASUT(ASUT,"IDX")=ASUMB("IDX")
+8 SET ASUT(ASUT,"PT","IDX")=ASUL(1,"AR","AP")_ASUT(ASUT,"IDX")
+9 SET ASUT(ASUT,"ENTR BY")=DUZ
+10 SET ASUT(ASUT,"DTE")=ASUK("DT","FM")
+11 SET ASUT(ASUT,"DTP")=ASUK("DT","FM")
+12 SET ASUT(ASUT,"DTW")=""
+13 SET ASUT(ASUT,"STATUS")="U"
+14 SET ASUT(ASUT,"SSA")=ASUMB("SSA")
IF ASUT(ASUT,"SSA")]""
DO SSA^ASULDIRR(ASUT(ASUT,"SSA"))
+15 SET ASUT(ASUT,"PT","SSA")=$GET(ASUL(17,"SSA","E#"))
+16 SET ASUT(ASUT,"SST")=ASUMB("SST")
IF ASUT(ASUT,"SST")]""
DO SST^ASULDIRR(ASUT(ASUT,"SST"))
+17 IF $LENGTH(ASUT(ASUT,"SST"))=5
SET ASUT(ASUT,"SST")=$EXTRACT(ASUT(ASUT,"SST"),4,5)
+18 SET ASUT(ASUT,"PT","SST")=$GET(ASUL(18,"SST","E#"))
+19 SET ASUT(ASUT,"USR")=ASUMB("USR")
IF ASUT(ASUT,"USR")]""
DO USR^ASULDIRR(ASUT(ASUT,"USR"))
+20 SET ASUT(ASUT,"PT","USR")=$GET(ASUL(19,"USR","E#"))
+21 IF ASUT(ASUT,"PT","USR")]""
DO REQ^ASULDIRR(ASUT(ASUT,"PT","USR"))
+22 SET ASUT(ASUT,"PT","REQ")=$GET(ASUL(20,"REQ","E#"))
+23 SET ASUT(ASUT,"REQ")=$GET(ASUL(20,"REQ"))
+24 SET ASUT(ASUT,"PT","EOQ TYP")=""
+25 SET ASUT(ASUT,"CALCED")=1
+26 SET ASUT(ASUT,"DTR")=ASUK("DT","FM")
+27 SET ASUT(ASUT,"VOU")=ASUMB("VOU")
+28 SET (ASUT(ASUT,"QTY","REQ"),ASUT(ASUT,"QTY"))=ASUMB("QTYB/O")
+29 SET ASUT(ASUT,"VAL")=""
+30 SET ASUT(ASUT,"CAN")=ASUMB("CAN")
+31 SET ASUT(ASUT,"B/O")=ASUMB("B/O")
+32 SET ASUT(ASUT,"QTY","ADJ")=ASUMB("QTYAJ")
+33 SET ASUT(ASUT,"CTG")=ASUMB("CTG")
+34 SET ASUT(ASUT,"SLC")=ASUMB("SLC")
SET ASUT(ASUT,"PT","SLC")=ASUMB("E#","SLC")
+35 SET ASUT(ASUT,"RQN")=ASUMB("RQN")
+36 SET ASUT(ASUT,"REQ TYP")=ASUMB("REQTYP")
+37 SET ASUT(ASUT,"STA")=ASUMB("STA")
+38 SET ASUT(ASUT,"FPN")=ASUMB("FPN")
+39 SET ASUT(ASUT,"UCS")=ASUMB("UCS")
+40 SET ASUT(ASUT,"ORD")=""
+41 IF '$DATA(ASUT(ASUT,"PON"))
SET ASUT(ASUT,"PON")=""
+42 SET ASUT(ASUT,"EOQ TYP")=""
+43 SET ASUT(ASUT,"PST")=""
+44 SET ASUT(ASUT,"ISSTY")=3
+45 SET ASUT(ASUT,"SUI")=$GET(ASUT(ASUT,"SUI"))
+46 SET ASUT(ASUT,"SRC")=$GET(ASUT(ASUT,"SRC"))
+47 QUIT
BKORDCAN ;EP;
+1 ;This routine provides for posting a Cancel Pending Backorder
+2 ;transaction to the Backorder file.
+3 SET DIC(0)="MXZ"
SET DIC=9002035
SET X=ASUT(ASUT,"PT","REQ")
DO ^DIC
+4 ;DFM P1 9/1/98
IF Y<0
SET ASUM("RMK")="B/O NOT MATCH"
NEW Z
SET Z="Unable to cancel Back Order - no match"
WRITE *7
DO MSG^ASUJHELP(.Z)
SET DDSERROR=1
QUIT
+5 IF Y>0
SET ASUMB("E#","REQ")=+Y
Begin DoDot:1
+6 SET ASUMB("E#","IDX")=ASUMX("E#","IDX")
+7 SET ASUMB("QTYB/O")=$PIECE(^ASUMB(ASUMB("E#","REQ"),1,ASUMB("E#","IDX"),0),U,4)
+8 SET ASUMS("D/O","QTY")=ASUMS("D/O","QTY")-ASUMB("QTYB/O")
+9 IF ASUMS("D/O","QTY")'>0
SET ASUMS("D/O","QTY")=""
+10 SET $PIECE(^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX"),2),U,2)=ASUMS("D/O","QTY")
+11 SET DIE="^ASUMB(ASUMB(""E#"",""REQ""),1,"
+12 SET DR=".01///@"
+13 SET DA(1)=ASUMB("E#","REQ")
+14 SET DA=ASUMB("E#","IDX")
SET ASUMB(0)=^ASUMB(DA(1),1,DA,0)
SET ASUMB(1)=$GET(^ASUMB(DA(1),1,DA,1))
+15 KILL Y
DO ^DIE
+16 ;DFM P1 9/1/98
IF $DATA(Y)
SET ASUM("RMK")="B/O NOT CANCELLED"
NEW Z
SET Z="Unable to cancel Back Order"
WRITE *7
DO MSG^ASUJHELP(.Z)
SET DDSERROR=2
+17 IF '$TEST
SET ASUM("RMK")="B/O CANCELLED"
End DoDot:1
+18 IF $GET(DDSERROR)>0
QUIT
+19 ;Move transaction to History file
DO ^ASUJHIST
+20 QUIT
TR31(X) ;EP ;ADD NEW BACKORDER RELEASE TRANSACTION
+1 SET ASUHDA=X
+2 SET ASUT(ASUT,"STATUS")="U"
+3 SET ASUT(ASUT,"DTW")=""
+4 SET ASUT(ASUT,"DTE")=""
+5 SET ASUT(ASUT,"DTP")=ASUK("DT","FM")
+6 SET ASUT(ASUT,"ISSTY")=3
+7 SET ASUT(ASUT,"PST")=""
+8 SET ASUT(ASUT,"PT","SSA")=$GET(ASUL(17,"SSA","E#"))
+9 SET ASUT(ASUT,"PT","SST")=$GET(ASUL(18,"SST","E#"))
+10 SET ASUT(ASUT,"PT","USR")=$GET(ASUL(19,"USR","E#"))
+11 SET ASUT(ASUT,"PT","REQ")=$GET(ASUL(20,"REQ","E#"))
+12 SET ASUT(ASUT,"PT","EOQ TYP")=$GET(ASUL(6,"EOQTP","E#"))
+13 SET ASUT(ASUT,"PT","AR")=ASUT(ASUT,"AR")
+14 SET ASUT(ASUT,"PT","STA")=$GET(ASUL(2,"STA","E#"))
+15 SET ASUT(ASUT,"PT","ACC")=ASUT(ASUT,"ACC")
+16 SET ASUT(ASUT,"PT","IDX")=ASUT(ASUT,"AR")_ASUT(ASUT,"IDX")
+17 SET ASUT(ASUT,"ENTR BY")=DUZ
+18 SET ASUT(ASUT,"CALCED")=""
+19 SET ASUF("SV")=2
+20 QUIT
REINDX ;
+1 FOR X=0:0
SET X=$ORDER(^ASUMB(X))
IF X']""
QUIT
Begin DoDot:1
+2 IF X?1A.A
KILL ^ASUMB(X)
QUIT
+3 FOR Y=0:0
SET Y=$ORDER(^ASUMB(X,1,Y))
IF Y']""
QUIT
Begin DoDot:2
+4 IF Y?1A.A
KILL ^ASUMB(X,1,Y)
QUIT
+5 SET Z="AAA"
FOR
SET Z=$ORDER(^ASUMB(X,1,Y,1,Z))
IF Z']""
QUIT
KILL ^ASUMB(X,1,Y,1,Z)
End DoDot:2
End DoDot:1
+6 SET DIK="^ASUMB("
DO IXALL^DIK
+7 QUIT
