- ASURQ810 ; IHS/ITSC/LMH -RPT 81 DROP SHIP LIST SORT ;
- ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
- ;This routine sorts report 81 extracts into proper sequence so that
- ;the report can be formatted and printed.
- I '$D(ASUP("QTR")) D SETQTR^ASUUDATE Q:$D(DUOUT)
- S ASUT="ISS",ASUT("TRCD")=""
- S ^XTMP("ASUR","R81",0)=ASUK("DT","FM")_U_ASUP("QTR")
- S ^XTMP("ASUR","R82",0)=ASUK("DT","FM")_U_ASUP("QTR")
- S ASUX("ARST")=ASUL(1,"AR","AP")_"000"
- F S ASUX("ARST")=$O(^ASUMS(ASUX("ARST"))) Q:$E(ASUX("ARST"),1,2)'=ASUL(1,"AR","AP") D
- .S ASUMX("E#","IDX")=0
- .F S ASUMX("E#","IDX")=$O(^ASUMS(ASUX("ARST"),1,ASUMX("E#","IDX"))) Q:$E(ASUMX("E#","IDX"),1,2)'=ASUL(1,"AR","AP") D
- ..Q:$P(^ASUMS(ASUX("ARST"),1,ASUMX("E#","IDX"),0),U)["999999"
- ..S ^XTMP("ASUR","R81",0,ASUX("ARST"))=$P(^ASUL(2,ASUX("ARST"),0),U)
- ..S ^XTMP("ASUR","R82",0,ASUX("ARST"))=^XTMP("ASUR","R81",0,ASUX("ARST"))
- ..S ASUMS("EOQ","TP")=$P(^ASUMS(ASUX("ARST"),1,ASUMX("E#","IDX"),2),U,5)
- ..S ASUMX("ACC")=$P(^ASUMX(ASUMX("E#","IDX"),0),U,6)
- ..S ASUX("ACIX")=ASUMX("ACC")_ASUMX("E#","IDX")
- ..I ASUMS("EOQ","TP")="S" D Q
- ...S ^XTMP("ASUR","R81",0,"IDX",ASUMX("E#","IDX"))=ASUMX("ACC")
- ...S ^XTMP("ASUR","R81",0,ASUX("ARST"),ASUX("ACIX"))=$P(^ASUL(9,ASUMX("ACC"),0),U)
- ..I ASUMS("EOQ","TP")="Y" D
- ...S ^XTMP("ASUR","R82",0,"IDX",ASUMX("E#","IDX"))=ASUMX("ACC")
- ...S ^XTMP("ASUR","R82",0,ASUX("ARST"),ASUX("ACIX"))=$P(^ASUL(9,ASUMX("ACC"),0),U)
- S ASUX("QTR")=$E(ASUP("QTR"),5,6)
- S ASUX("QTRF")=$E(ASUP("QTR"),1,4)_"00"
- S ASUV("YR")=ASUP("YR") S:$L(ASUV("YR"))=4 ASUV("YR")=$E(ASUV("YR"),3,4)
- F S ASUX("QTRF")=$O(^ASUML("C",ASUX("QTRF"))) Q:ASUX("QTRF")']"" Q:$E(ASUX("QTRF"),3,4)'=ASUV("YR") D
- .S ASUV("CQTR")=$E(ASUX("QTRF"),5,6) Q:ASUV("CQTR")>ASUX("QTR")
- .S ASUX("XTRQTR")=""
- .F S ASUX("XTRQTR")=$O(^ASUML("C",ASUX("QTRF"),ASUX("XTRQTR"))) Q:ASUX("XTRQTR")'?1N.N D
- ..S ASUX("XTRDT")=""
- ..F S ASUX("XTRDT")=$O(^ASUML(ASUX("XTRQTR"),"B",ASUX("XTRDT"))) Q:ASUX("XTRDT")="" D
- ...S ASUHDA=""
- ...F S ASUHDA=$O(^ASUH("AX",ASUX("XTRDT"),ASUHDA)) Q:ASUHDA="" D ASURQ811
- END ;
- K ASUT,ASUR,ASUMS,ASUV,ASUX
- Q
- ASURQ811 ;DROP SHIP LIST SORT
- D READ^ASU0TRRD(.ASUHDA,"H") Q:$G(ASUT)']""
- Q:ASUT("TYPE")'=3
- S ASUMX("E#","IDX")=ASUL(1,"AR","AP")_ASUT(ASUT,"IDX")
- S ASUX("ARST")=ASUL(1,"AR","AP")_0_ASUT(ASUT,"STA")
- S ASUX("SST")=ASUL(1,"AR","AP")_0_ASUT(ASUT,"SST")
- Q:$G(^ASUMS(ASUX("ARST"),1,ASUMX("E#","IDX"),0))'[""
- Q:$P(^ASUMS(ASUX("ARST"),1,ASUMX("E#","IDX"),0),U)["999999"
- S ASUMX("ACC")=ASUT(ASUT,"ACC")
- S ASUX("QTY")=ASUT(ASUT,"QTY","ISS")
- S:ASUX("QTY")']"" ASUX("QTY")=ASUT(ASUT,"QTY","REQ")
- I ASUT("TRCD")="3K" D Q
- .I ASUT(ASUT,"EOQ TYP")="S" D XTR Q
- .I $D(^XTMP("ASUR","R81",0,"IDX",ASUMX("E#","IDX"))) D XTR Q
- I ASUT("TRCD")'=32 Q
- I ASUT(ASUT,"EOQ TYP")="S" D XTR Q
- I $D(^XTMP("ASUR","R81",0,"IDX",ASUMX("E#","IDX"))) D XTR Q
- I ASUT(ASUT,"EOQ TYP")="Y" D ASURQ821 Q
- I $D(^XTMP("ASUR","R82",0,"IDX",ASUMX("E#","IDX"))) D ASURQ821
- XTR ;
- I ASUT("TRCD")="3K" D
- .S ASUT(ASUT,"VAL")=ASUT(ASUT,"VAL")*-1
- .S ASUX("QTY")=ASUX("QTY")*-1
- I ASUMX("ACC")']"" D SETACC Q:ASUMX("ACC")']""
- S ASUX("ACIX")=ASUMX("ACC")_ASUMX("E#","IDX")
- I '$D(^XTMP("ASUR","R81",ASUX("ARST"))) D
- .S ^XTMP("ASUR","R81",ASUX("ARST"))=$G(^XTMP("ASUR","R81",0,ASUX("ARST")))
- I '$D(^XTMP("ASUR","R81",ASUX("ARST"),ASUX("ACIX"))) D
- .S ^XTMP("ASUR","R81",ASUX("ARST"),ASUX("ACIX"))=$G(^XTMP("ASUR","R81",0,ASUX("ARST"),ASUX("ACIX")))
- K ASUL(18)
- D SST^ASULDIRR(ASUX("SST"))
- I '$D(^XTMP("ASUR","R81",ASUX("ARST"),ASUX("ACIX"))) D
- .S ^XTMP("ASUR","R81",ASUX("ARST"),ASUX("ACIX"))=$G(^XTMP("ASUR","R81",0,ASUX("ARST"),ASUX("ACIX")))
- F X=19,20,22 K ASUL(X)
- D REQ^ASULDIRR(ASUT(ASUT,"USR"))
- S ASUX("REQ")=$G(ASUL(20,"REQ","E#")) Q:ASUX("REQ")']""
- I '$D(^XTMP("ASUR","R81",ASUX("ARST"),ASUX("ACIX"),ASUX("REQ"))) D
- .S ^XTMP("ASUR","R81",ASUX("ARST"),ASUX("ACIX"),ASUX("REQ"))="0^0^0^0"
- S $P(^XTMP("ASUR","R81",ASUX("ARST"),ASUX("ACIX"),ASUX("REQ")),U,2)=$P(^XTMP("ASUR","R81",ASUX("ARST"),ASUX("ACIX"),ASUX("REQ")),U,2)+ASUX("QTY")
- S $P(^XTMP("ASUR","R81",ASUX("ARST"),ASUX("ACIX"),ASUX("REQ")),U,4)=$P(^XTMP("ASUR","R81",ASUX("ARST"),ASUX("ACIX"),ASUX("REQ")),U,4)+ASUT(ASUT,"VAL")
- I ASUX("QTR")'=ASUV("CQTR") Q
- S $P(^XTMP("ASUR","R81",ASUX("ARST"),ASUX("ACIX"),ASUX("REQ")),U)=$P(^XTMP("ASUR","R81",ASUX("ARST"),ASUX("ACIX"),ASUX("REQ")),U)+ASUX("QTY")
- S $P(^XTMP("ASUR","R81",ASUX("ARST"),ASUX("ACIX"),ASUX("REQ")),U,3)=$P(^XTMP("ASUR","R81",ASUX("ARST"),ASUX("ACIX"),ASUX("REQ")),U,3)+ASUT(ASUT,"VAL")
- Q
- ASURQ821 ;YEARLY ITEM LIST SORT
- I ASUT("TRCD")="3K" D
- .S ASUT(ASUT,"VAL")=ASUT(ASUT,"VAL")*-1
- .S ASUX("QTY")=ASUX("QTY")*-1
- I '$D(^XTMP("ASUR","R82",ASUX("ARST"))),$D(^XTMP("ASUR","R81",ASUX("ARST"))) D
- .S ^XTMP("ASUR","R82",ASUX("ARST"))=^XTMP("ASUR","R81",ASUX("ARST"))
- I '$G(^XTMP("ASUR","R82",ASUX("ARST")))']"" D
- .S ^XTMP("ASUR","R82",ASUX("ARST"))=$G(^XTMP("ASUR","R81",0,ASUX("ARST")))
- I '$D(^XTMP("ASUR","R82",ASUX("ARST"),ASUX("ACIX"))) D
- .S ^XTMP("ASUR","R82",ASUX("ARST"),ASUX("ACIX"))=$G(^XTMP("ASUR","R82",0,ASUX("ARST"),ASUX("ACIX")))
- D SST^ASULDIRR(ASUX("SST"))
- D REQ^ASULDIRR(ASUT(ASUT,"USR"))
- S ASUX("REQ")=$G(ASUL(20,"REQ","E#")) Q:ASUX("REQ")']""
- I '$D(^XTMP("ASUR","R82",ASUX("ARST"),ASUX("ACIX"),ASUX("REQ"))) D
- .S ^XTMP("ASUR","R82",ASUX("ARST"),ASUX("ACIX"),ASUX("REQ"))="0^0^0^0"
- S ASUX=^XTMP("ASUR","R82",ASUX("ARST"),ASUX("ACIX"),ASUX("REQ"))
- S $P(ASUX,U,2)=$P(ASUX,U,2)+ASUX("QTY")
- S $P(ASUX,U,4)=$P(ASUX,U,4)+ASUT(ASUT,"VAL")
- I ASUX("QTR")=ASUV("CQTR") D
- .S $P(ASUX,U)=$P(ASUX,U)+ASUX("QTY")
- .S $P(ASUX,U,3)=$P(ASUX,U,3)+ASUT(ASUT,"VAL")
- S ^XTMP("ASUR","R82",ASUX("ARST"),ASUX("ACIX"),ASUX("REQ"))=ASUX
- SETACC ;EP; SET ACCOUNT
- S ASUMX("ACC")=$P(^ASUMX(ASUMX("E#","IDX"),0),U,6)
- Q
- ASURQ810 ; IHS/ITSC/LMH -RPT 81 DROP SHIP LIST SORT ;
- +1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
- +2 ;This routine sorts report 81 extracts into proper sequence so that
- +3 ;the report can be formatted and printed.
- +4 IF '$DATA(ASUP("QTR"))
- DO SETQTR^ASUUDATE
- IF $DATA(DUOUT)
- QUIT
- +5 SET ASUT="ISS"
- SET ASUT("TRCD")=""
- +6 SET ^XTMP("ASUR","R81",0)=ASUK("DT","FM")_U_ASUP("QTR")
- +7 SET ^XTMP("ASUR","R82",0)=ASUK("DT","FM")_U_ASUP("QTR")
- +8 SET ASUX("ARST")=ASUL(1,"AR","AP")_"000"
- +9 FOR
- SET ASUX("ARST")=$ORDER(^ASUMS(ASUX("ARST")))
- IF $EXTRACT(ASUX("ARST"),1,2)'=ASUL(1,"AR","AP")
- QUIT
- Begin DoDot:1
- +10 SET ASUMX("E#","IDX")=0
- +11 FOR
- SET ASUMX("E#","IDX")=$ORDER(^ASUMS(ASUX("ARST"),1,ASUMX("E#","IDX")))
- IF $EXTRACT(ASUMX("E#","IDX"),1,2)'=ASUL(1,"AR","AP")
- QUIT
- Begin DoDot:2
- +12 IF $PIECE(^ASUMS(ASUX("ARST"),1,ASUMX("E#","IDX"),0),U)["999999"
- QUIT
- +13 SET ^XTMP("ASUR","R81",0,ASUX("ARST"))=$PIECE(^ASUL(2,ASUX("ARST"),0),U)
- +14 SET ^XTMP("ASUR","R82",0,ASUX("ARST"))=^XTMP("ASUR","R81",0,ASUX("ARST"))
- +15 SET ASUMS("EOQ","TP")=$PIECE(^ASUMS(ASUX("ARST"),1,ASUMX("E#","IDX"),2),U,5)
- +16 SET ASUMX("ACC")=$PIECE(^ASUMX(ASUMX("E#","IDX"),0),U,6)
- +17 SET ASUX("ACIX")=ASUMX("ACC")_ASUMX("E#","IDX")
- +18 IF ASUMS("EOQ","TP")="S"
- Begin DoDot:3
- +19 SET ^XTMP("ASUR","R81",0,"IDX",ASUMX("E#","IDX"))=ASUMX("ACC")
- +20 SET ^XTMP("ASUR","R81",0,ASUX("ARST"),ASUX("ACIX"))=$PIECE(^ASUL(9,ASUMX("ACC"),0),U)
- End DoDot:3
- QUIT
- +21 IF ASUMS("EOQ","TP")="Y"
- Begin DoDot:3
- +22 SET ^XTMP("ASUR","R82",0,"IDX",ASUMX("E#","IDX"))=ASUMX("ACC")
- +23 SET ^XTMP("ASUR","R82",0,ASUX("ARST"),ASUX("ACIX"))=$PIECE(^ASUL(9,ASUMX("ACC"),0),U)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +24 SET ASUX("QTR")=$EXTRACT(ASUP("QTR"),5,6)
- +25 SET ASUX("QTRF")=$EXTRACT(ASUP("QTR"),1,4)_"00"
- +26 SET ASUV("YR")=ASUP("YR")
- IF $LENGTH(ASUV("YR"))=4
- SET ASUV("YR")=$EXTRACT(ASUV("YR"),3,4)
- +27 FOR
- SET ASUX("QTRF")=$ORDER(^ASUML("C",ASUX("QTRF")))
- IF ASUX("QTRF")']""
- QUIT
- IF $EXTRACT(ASUX("QTRF"),3,4)'=ASUV("YR")
- QUIT
- Begin DoDot:1
- +28 SET ASUV("CQTR")=$EXTRACT(ASUX("QTRF"),5,6)
- IF ASUV("CQTR")>ASUX("QTR")
- QUIT
- +29 SET ASUX("XTRQTR")=""
- +30 FOR
- SET ASUX("XTRQTR")=$ORDER(^ASUML("C",ASUX("QTRF"),ASUX("XTRQTR")))
- IF ASUX("XTRQTR")'?1N.N
- QUIT
- Begin DoDot:2
- +31 SET ASUX("XTRDT")=""
- +32 FOR
- SET ASUX("XTRDT")=$ORDER(^ASUML(ASUX("XTRQTR"),"B",ASUX("XTRDT")))
- IF ASUX("XTRDT")=""
- QUIT
- Begin DoDot:3
- +33 SET ASUHDA=""
- +34 FOR
- SET ASUHDA=$ORDER(^ASUH("AX",ASUX("XTRDT"),ASUHDA))
- IF ASUHDA=""
- QUIT
- DO ASURQ811
- End DoDot:3
- End DoDot:2
- End DoDot:1
- END ;
- +1 KILL ASUT,ASUR,ASUMS,ASUV,ASUX
- +2 QUIT
- ASURQ811 ;DROP SHIP LIST SORT
- +1 DO READ^ASU0TRRD(.ASUHDA,"H")
- IF $GET(ASUT)']""
- QUIT
- +2 IF ASUT("TYPE")'=3
- QUIT
- +3 SET ASUMX("E#","IDX")=ASUL(1,"AR","AP")_ASUT(ASUT,"IDX")
- +4 SET ASUX("ARST")=ASUL(1,"AR","AP")_0_ASUT(ASUT,"STA")
- +5 SET ASUX("SST")=ASUL(1,"AR","AP")_0_ASUT(ASUT,"SST")
- +6 IF $GET(^ASUMS(ASUX("ARST"),1,ASUMX("E#","IDX"),0))'[""
- QUIT
- +7 IF $PIECE(^ASUMS(ASUX("ARST"),1,ASUMX("E#","IDX"),0),U)["999999"
- QUIT
- +8 SET ASUMX("ACC")=ASUT(ASUT,"ACC")
- +9 SET ASUX("QTY")=ASUT(ASUT,"QTY","ISS")
- +10 IF ASUX("QTY")']""
- SET ASUX("QTY")=ASUT(ASUT,"QTY","REQ")
- +11 IF ASUT("TRCD")="3K"
- Begin DoDot:1
- +12 IF ASUT(ASUT,"EOQ TYP")="S"
- DO XTR
- QUIT
- +13 IF $DATA(^XTMP("ASUR","R81",0,"IDX",ASUMX("E#","IDX")))
- DO XTR
- QUIT
- End DoDot:1
- QUIT
- +14 IF ASUT("TRCD")'=32
- QUIT
- +15 IF ASUT(ASUT,"EOQ TYP")="S"
- DO XTR
- QUIT
- +16 IF $DATA(^XTMP("ASUR","R81",0,"IDX",ASUMX("E#","IDX")))
- DO XTR
- QUIT
- +17 IF ASUT(ASUT,"EOQ TYP")="Y"
- DO ASURQ821
- QUIT
- +18 IF $DATA(^XTMP("ASUR","R82",0,"IDX",ASUMX("E#","IDX")))
- DO ASURQ821
- XTR ;
- +1 IF ASUT("TRCD")="3K"
- Begin DoDot:1
- +2 SET ASUT(ASUT,"VAL")=ASUT(ASUT,"VAL")*-1
- +3 SET ASUX("QTY")=ASUX("QTY")*-1
- End DoDot:1
- +4 IF ASUMX("ACC")']""
- DO SETACC
- IF ASUMX("ACC")']""
- QUIT
- +5 SET ASUX("ACIX")=ASUMX("ACC")_ASUMX("E#","IDX")
- +6 IF '$DATA(^XTMP("ASUR","R81",ASUX("ARST")))
- Begin DoDot:1
- +7 SET ^XTMP("ASUR","R81",ASUX("ARST"))=$GET(^XTMP("ASUR","R81",0,ASUX("ARST")))
- End DoDot:1
- +8 IF '$DATA(^XTMP("ASUR","R81",ASUX("ARST"),ASUX("ACIX")))
- Begin DoDot:1
- +9 SET ^XTMP("ASUR","R81",ASUX("ARST"),ASUX("ACIX"))=$GET(^XTMP("ASUR","R81",0,ASUX("ARST"),ASUX("ACIX")))
- End DoDot:1
- +10 KILL ASUL(18)
- +11 DO SST^ASULDIRR(ASUX("SST"))
- +12 IF '$DATA(^XTMP("ASUR","R81",ASUX("ARST"),ASUX("ACIX")))
- Begin DoDot:1
- +13 SET ^XTMP("ASUR","R81",ASUX("ARST"),ASUX("ACIX"))=$GET(^XTMP("ASUR","R81",0,ASUX("ARST"),ASUX("ACIX")))
- End DoDot:1
- +14 FOR X=19,20,22
- KILL ASUL(X)
- +15 DO REQ^ASULDIRR(ASUT(ASUT,"USR"))
- +16 SET ASUX("REQ")=$GET(ASUL(20,"REQ","E#"))
- IF ASUX("REQ")']""
- QUIT
- +17 IF '$DATA(^XTMP("ASUR","R81",ASUX("ARST"),ASUX("ACIX"),ASUX("REQ")))
- Begin DoDot:1
- +18 SET ^XTMP("ASUR","R81",ASUX("ARST"),ASUX("ACIX"),ASUX("REQ"))="0^0^0^0"
- End DoDot:1
- +19 SET $PIECE(^XTMP("ASUR","R81",ASUX("ARST"),ASUX("ACIX"),ASUX("REQ")),U,2)=$PIECE(^XTMP("ASUR","R81",ASUX("ARST"),ASUX("ACIX"),ASUX("REQ")),U,2)+ASUX("QTY")
- +20 SET $PIECE(^XTMP("ASUR","R81",ASUX("ARST"),ASUX("ACIX"),ASUX("REQ")),U,4)=$PIECE(^XTMP("ASUR","R81",ASUX("ARST"),ASUX("ACIX"),ASUX("REQ")),U,4)+ASUT(ASUT,"VAL")
- +21 IF ASUX("QTR")'=ASUV("CQTR")
- QUIT
- +22 SET $PIECE(^XTMP("ASUR","R81",ASUX("ARST"),ASUX("ACIX"),ASUX("REQ")),U)=$PIECE(^XTMP("ASUR","R81",ASUX("ARST"),ASUX("ACIX"),ASUX("REQ")),U)+ASUX("QTY")
- +23 SET $PIECE(^XTMP("ASUR","R81",ASUX("ARST"),ASUX("ACIX"),ASUX("REQ")),U,3)=$PIECE(^XTMP("ASUR","R81",ASUX("ARST"),ASUX("ACIX"),ASUX("REQ")),U,3)+ASUT(ASUT,"VAL")
- +24 QUIT
- ASURQ821 ;YEARLY ITEM LIST SORT
- +1 IF ASUT("TRCD")="3K"
- Begin DoDot:1
- +2 SET ASUT(ASUT,"VAL")=ASUT(ASUT,"VAL")*-1
- +3 SET ASUX("QTY")=ASUX("QTY")*-1
- End DoDot:1
- +4 IF '$DATA(^XTMP("ASUR","R82",ASUX("ARST")))
- IF $DATA(^XTMP("ASUR","R81",ASUX("ARST")))
- Begin DoDot:1
- +5 SET ^XTMP("ASUR","R82",ASUX("ARST"))=^XTMP("ASUR","R81",ASUX("ARST"))
- End DoDot:1
- +6 IF '$GET(^XTMP("ASUR","R82",ASUX("ARST")))']""
- Begin DoDot:1
- +7 SET ^XTMP("ASUR","R82",ASUX("ARST"))=$GET(^XTMP("ASUR","R81",0,ASUX("ARST")))
- End DoDot:1
- +8 IF '$DATA(^XTMP("ASUR","R82",ASUX("ARST"),ASUX("ACIX")))
- Begin DoDot:1
- +9 SET ^XTMP("ASUR","R82",ASUX("ARST"),ASUX("ACIX"))=$GET(^XTMP("ASUR","R82",0,ASUX("ARST"),ASUX("ACIX")))
- End DoDot:1
- +10 DO SST^ASULDIRR(ASUX("SST"))
- +11 DO REQ^ASULDIRR(ASUT(ASUT,"USR"))
- +12 SET ASUX("REQ")=$GET(ASUL(20,"REQ","E#"))
- IF ASUX("REQ")']""
- QUIT
- +13 IF '$DATA(^XTMP("ASUR","R82",ASUX("ARST"),ASUX("ACIX"),ASUX("REQ")))
- Begin DoDot:1
- +14 SET ^XTMP("ASUR","R82",ASUX("ARST"),ASUX("ACIX"),ASUX("REQ"))="0^0^0^0"
- End DoDot:1
- +15 SET ASUX=^XTMP("ASUR","R82",ASUX("ARST"),ASUX("ACIX"),ASUX("REQ"))
- +16 SET $PIECE(ASUX,U,2)=$PIECE(ASUX,U,2)+ASUX("QTY")
- +17 SET $PIECE(ASUX,U,4)=$PIECE(ASUX,U,4)+ASUT(ASUT,"VAL")
- +18 IF ASUX("QTR")=ASUV("CQTR")
- Begin DoDot:1
- +19 SET $PIECE(ASUX,U)=$PIECE(ASUX,U)+ASUX("QTY")
- +20 SET $PIECE(ASUX,U,3)=$PIECE(ASUX,U,3)+ASUT(ASUT,"VAL")
- End DoDot:1
- +21 SET ^XTMP("ASUR","R82",ASUX("ARST"),ASUX("ACIX"),ASUX("REQ"))=ASUX
- SETACC ;EP; SET ACCOUNT
- +1 SET ASUMX("ACC")=$PIECE(^ASUMX(ASUMX("E#","IDX"),0),U,6)
- +2 QUIT
