- 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
