Routine: ACRFSTOK

ACRFSTOK ;IHS/OIRM/DSD/THL,AEF - ADD/EDIT STOCK ITEMS; [ 11/01/2001   9:44 AM ]

 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001

 ;;ROUTINE TO ADD OR EDIT STANDARD ITEMS

ITEM F  D ITEM1 Q:$D(ACRQUIT)!$D(ACROUT)

 K ACRQUIT,ACR,ACRSEQ,ACRDA,ACRSET,ACRSTOCK

ITEM1 W @IOF

 K ACRQUIT,ACR,ACRSEQ,ACRDA,ACRSET,ACRSTOCK

 W !?22,"ADD/EDIT STANDARD ITEMS"

 W !?21,"|==============================|"

 S DIR(0)="FO^1:30"

 S DIR("A")="STANDARD ITEM......."

 S DIR("?")="^ S DIC=""^ACRITEM("",DIC(0)=""EMZ"" D DIC^ACRFDIC K DIC"

 D DIR^ACRFDIC

 Q:$D(ACRQUIT)!$D(ACROUT)!(X="")!($E(X)=U)!($E(X)="?")

 S ACRX=X

 S DIC="^ACRITEM("

 S DIC(0)="EMZ"

 S DIC("S")="Q:'$D(^ACRITEM(+Y,""DT1""))  I $P(^(""DT1""),U,3)=1!($P(^(""DT1""),U,3)="""")"

 D DIC^ACRFDIC

 I $D(ACRQUIT)!$D(ACROUT)!('$L(X)) K ACRQUIT Q

 S ACRDA=Y

 I +ACRDA<1,$L(X)>2 D  I $D(ACRQUIT) K ACRQUIT Q

 .S DIR(0)="YOA"

 .S DIR("A")="   ADD "_X_" AS A NEW ARMS STANDARD ITEM? "

 .D DIR^ACRFDIC

 .I Y'=1 S ACRQUIT="" Q

 .S DIC("DR")="1////"_ACRX

 .D NEW^ACRFSTK1

ITEM11 ;EDIT A STANDARD ITEM

 Q:+ACRDA<1

 I $P($G(^ACRITEM(+ACRDA,"DT1")),U,3)'=1,$P($G(^ACRITEM(+ACRDA,"DT")),U)]"" D

 .S ACRPDA=$P(^ACRITEM(+ACRDA,"DT"),U,15)

 .Q:'ACRPDA

 .S ACRYY=0

 .F  S ACRYY=$O(^ACRITEM("G",ACRPDA,ACRYY)) Q:'ACRYY  I $D(^ACRITEM(ACRYY,"DT1")),$P(^("DT1"),U,3)=1 S ACRDA=ACRYY Q

 S (ACRD0,ACRITMDA)=+ACRDA

 S ACRSEQ=1

 N ACRY

 S ACRY=$P(ACRDA,U,3)

 F  D ITEM2 Q:$D(ACRQUIT)!$D(ACROUT)

 K ACRQUIT

 I ACRSEQ<3,$G(ACR(1)),'$D(ACRDEL),$P($G(^ACRITEM(+ACR(1),"DT1")),U) D

 .F  D ITEM5 Q:$D(ACRQUIT)!$D(ACROUT)!(ACRSEQ>2)

 K ACRQUIT,ACRDEL

ITEM2 I ACRY=1 S ACRSEQ=1 D ITEM3 Q:$D(ACRQUIT)!$D(ACROUT)

 D DISP^ACRFSTK1

 I ACRSEQ>1 D

 .S DIR(0)="YO"

 .S DIR("A")="Change Vendor priority"

 .S DIR("B")="NO"

 .D DIR^ACRFDIC

 .I Y=1 D

 ..I ACRSEQ=2 D

 ...S ACRX=ACR(2)

 ...S ACR(2)=ACR(1)

 ...S ACR(1)=ACRX

 ...F ACRX=1,2 D

 ....S DA=+ACR(ACRX)

 ....S DIE="^ACRITEM("

 ....S DR="15////"_+ACR(1)_";26////"_ACRX

 ....D DIE^ACRFDIC

 ..I ACRSEQ=3 D

 ...F ACRX=1:1:3 S ACRX(ACRX)=$G(ACR(ACRX))

 ...S ACRPRI=0

 ...W !

 ...F  S ACRPRI=$O(ACR(ACRPRI)) Q:'ACRPRI

 ...S DIR(0)="SOB^2:"_$P(ACR(2),U,3)_";3:"_$P(ACR(3),U,3)

 ...S DIR("A")="New Primary Vendor"

 ...D DIR^ACRFDIC

 ...I Y D

 ....S ACRX=Y

 ....S ACRX(Y)=ACR(1)

 ....S ACRX(1)=ACR(Y)

 ....S ACRSET="1:"_$P(ACR(1),U,3)_";"

 ....S ACRSET=$S(Y=2:ACRSET_"3:"_$P(ACR(3),U,3),1:ACRSET_"2:"_$P(ACR(2),U,3))

 ...Q:'Y

 ...S DIR(0)="SOB^"_ACRSET

 ...S DIR("A")="New Secondary Vendor"

 ...D DIR^ACRFDIC

 ...I Y=1 D

 ....S ACRX(2)=ACR(Y)

 ....S ACRX(3)=ACR($S(ACRX+Y=3:3,ACRX+Y=4:2,1:1))

 ...F ACRX=1:1:3 D

 ....S ACR(ACRX)=ACRX(ACRX)

 ....S DA=+ACR(ACRX)

 ....S DIE="^ACRITEM("

 ....S DR="15////"_+ACR(1)_";26////"_ACRX

 ....D DIE^ACRFDIC

 K ACRQUIT

 S DIR(0)="YO"

 S DIR("A")="Edit Item Data........"

 S DIR("B")="NO"

 D DIR^ACRFDIC

 I Y'=1 S ACRQUIT="" Q

 D ITEM3

ITEM3 S ACRY=""

 D:'$D(ACRADD) ITEM4

ITEM31 Q:$D(ACRQUIT)!$D(ACROUT)

 S:'$D(Y) Y="G"

 S:"123G"'[Y Y="G"

 S:Y="G" ACRG=""

 S DA=+ACRDA

 S DR=$S(Y:"[ACR DI VENDOR]",1:"[ACR ADD DIRECT ISSUE]")

 K ACRSSITM

ITEM311 S DIE="^ACRITEM("

 S ACRITEM=""

 S:$D(^ACRITEM(ACRDA,"DT1")) ACRMESS=$S(DR["SEC":"VENDOR - "_$S($P(^("DT1"),U)]"":$P(^AUTTVNDR($P(^ACRITEM(ACRDA,"DT1"),U),0),U),1:""),1:"STANDARD ITEM GENERAL INFO")

 D DIE^ACRFDIC

 K ACRITEM

 I $D(ACRG) F ACR=2,3 D:$D(ACR(ACR))

 .S ^ACRITEM(+ACR(ACR),"DT")=^ACRITEM(ACRDA,"DT")

 .S:$D(^ACRITEM(ACRDA,"DT2")) ^ACRITEM(+ACR(ACR),"DT2")=^ACRITEM(ACRDA,"DT2")

 .K ACRG

 I $D(ACRDEL) D DELETE^ACRFSTK1

ITEM4 K ACRADD

 S ACRSET="G:GENERAL INFORMATION;"_$S(ACRSEQ=1:"1:PRIMARY VENDOR",ACRSEQ=2:"1:PRIMARY VENDOR;2:SECONDARY VENDOR",1:"1:PRIMARY VENDOR;2:SECONDARY VENDOR;3:TERTIARY VENDOR")

 S DIR(0)="SO^"_ACRSET

 S DIR("A")="Which OPTION"

 D DIR^ACRFDIC

 Q:$D(ACRQUIT)!$D(ACROUT)

 Q:Y=""

 Q:'$D(ACR(Y))&'$D(ACR(1))

 S ACRDA=$S(Y&$D(ACR(Y)):+ACR(Y),1:+ACR(1))

 S:Y>1 ACRDEL=+ACR(Y)_U_Y

ITEM5 S DIR(0)="YO"

 S DIR("A")="Add a "_$S(ACRSEQ=1:"Secondary",1:"Tertiary ")_" Vendor"

 S DIR("B")="NO"

 D DIR^ACRFDIC

 I Y'=1 S ACRQUIT="" Q

 S DIC="^AUTTVNDR("

 S DIC(0)="AEMQZ"

 S DIC("A")="VENDOR..............: "

 D DIC^ACRFDIC

 Q:+Y<1!$D(ACRQUIT)!$D(ACROUT)

 S ACRVDA=+Y,ACR=0

 S ACRSEQ=ACRSEQ+1

 S X=ACRINDEX

 S DIC(0)="L"

 S DIC="^ACRITEM("

 S DIC("DR")="24////"_ACRVDA_";26////"_ACRSEQ

 D FILE^ACRFDIC

 Q:+Y<1

 S (DA,ACRDA)=+Y

 S $P(^ACRITEM(+Y,0),U,2)=$P(^ACRITEM(ACRDA(1),0),U,2)

 S ^ACRITEM(+Y,"DT")=^ACRITEM(+ACRDA(1),"DT")

 S DIK="^ACRITEM("

 D IX1^ACRFDIC

 S DA=+ACRDA

 S DIE="^ACRITEM("

 S DR=".03////"_ACRSEQ_";15////"_+ACRDA(1)_";26////"_ACRSEQ

 D DIE^ACRFDIC

 S (DA,ACRDA(ACRSEQ))=ACRDA

 S DR="[ACR DI VENDOR]"

 D ITEM311

ADD ;EP;TO ADD ITEM TO SI FILE DURING PO PROCESSING

 S ACRADD=""

 S ACRSSITM=""

 S X=^ACRSS(ACRSSDA,0)

 S ACRDT=$G(^ACRSS(ACRSSDA,"DT"))

 S ACRKW=$G(^ACRSS(ACRSSDA,"NMS"))

 S ACRVND=$G(^ACRSS(ACRSSDA,"VND"))

 S ACRDSC=$G(^ACRSS(ACRSSDA,"DESC"))

 S:ACRDSC[";" ACRDSC=$TR(ACRDSC,";",",")

 S DIC="^ACRITEM("

 S DIC(0)="LZ"

 S DIC("DR")=".02////"_$E($P(ACRKW,U,5),1,16)_";1////"_$P(ACRDSC,U)_";2////"_$P(ACRDSC,U,2)_";4////"_$P(ACRDT,U,4)_";29////"_$P(ACRDT,U,2)_";12////"_$P(ACRDT,U,2)_";13////"_$P(ACRDT,U,3)_";8////"_DT_";6////"_$P(X,U,4)

 S DIC("DR")=DIC("DR")_";24////"_+ACRVND_";50////"_$P(ACRDSC,U,3)_";51////"_$P(ACRDSC,U,4)_";52////"_$P(ACRDSC,U,5)

 D NEW^ACRFSTK1

 D ITEM11

 K ACRSSITM

ACRFSTOK  ;IHS/OIRM/DSD/THL,AEF - ADD/EDIT STOCK ITEMS; [ 11/01/2001   9:44 AM ]

 +1       ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001

 +2       ;;ROUTINE TO ADD OR EDIT STANDARD ITEMS

ITEM       FOR

               DO ITEM1

               IF $DATA(ACRQUIT)!$DATA(ACROUT)

                   QUIT

 +1        KILL ACRQUIT,ACR,ACRSEQ,ACRDA,ACRSET,ACRSTOCK

 +2        QUIT

ITEM1      WRITE @IOF

 +1        KILL ACRQUIT,ACR,ACRSEQ,ACRDA,ACRSET,ACRSTOCK

 +2        WRITE !?22,"ADD/EDIT STANDARD ITEMS"

 +3        WRITE !?21,"|==============================|"

 +4        SET DIR(0)="FO^1:30"

 +5        SET DIR("A")="STANDARD ITEM......."

 +6        SET DIR("?")="^ S DIC=""^ACRITEM("",DIC(0)=""EMZ"" D DIC^ACRFDIC K DIC"

 +7        DO DIR^ACRFDIC

 +8        IF $DATA(ACRQUIT)!$DATA(ACROUT)!(X="")!($EXTRACT(X)=U)!($EXTRACT(X)="?")

               QUIT

 +9        SET ACRX=X

 +10       SET DIC="^ACRITEM("

 +11       SET DIC(0)="EMZ"

 +12       SET DIC("S")="Q:'$D(^ACRITEM(+Y,""DT1""))  I $P(^(""DT1""),U,3)=1!($P(^(""DT1""),U,3)="""")"

 +13       DO DIC^ACRFDIC

 +14       IF $DATA(ACRQUIT)!$DATA(ACROUT)!('$LENGTH(X))

               KILL ACRQUIT

               QUIT

 +15       SET ACRDA=Y

 +16       IF +ACRDA<1

               IF $LENGTH(X)>2

                   Begin DoDot:1

 +17                   SET DIR(0)="YOA"

 +18                   SET DIR("A")="   ADD "_X_" AS A NEW ARMS STANDARD ITEM? "

 +19                   DO DIR^ACRFDIC

 +20                   IF Y'=1

                           SET ACRQUIT=""

                           QUIT

 +21                   SET DIC("DR")="1////"_ACRX

 +22                   DO NEW^ACRFSTK1

                   End DoDot:1

                   IF $DATA(ACRQUIT)

                       KILL ACRQUIT

                       QUIT

ITEM11    ;EDIT A STANDARD ITEM

 +1        IF +ACRDA<1

               QUIT

 +2        IF $PIECE($GET(^ACRITEM(+ACRDA,"DT1")),U,3)'=1

               IF $PIECE($GET(^ACRITEM(+ACRDA,"DT")),U)]""

                   Begin DoDot:1

 +3                    SET ACRPDA=$PIECE(^ACRITEM(+ACRDA,"DT"),U,15)

 +4                    IF 'ACRPDA

                           QUIT

 +5                    SET ACRYY=0

 +6                    FOR

                           SET ACRYY=$ORDER(^ACRITEM("G",ACRPDA,ACRYY))

                           IF 'ACRYY

                               QUIT

                           IF $DATA(^ACRITEM(ACRYY,"DT1"))

                               IF $PIECE(^("DT1"),U,3)=1

                                   SET ACRDA=ACRYY

                                   QUIT

                   End DoDot:1

 +7        SET (ACRD0,ACRITMDA)=+ACRDA

 +8        SET ACRSEQ=1

 +9        NEW ACRY

 +10       SET ACRY=$PIECE(ACRDA,U,3)

 +11       FOR

               DO ITEM2

               IF $DATA(ACRQUIT)!$DATA(ACROUT)

                   QUIT

 +12       KILL ACRQUIT

 +13       IF ACRSEQ<3

               IF $GET(ACR(1))

                   IF '$DATA(ACRDEL)

                       IF $PIECE($GET(^ACRITEM(+ACR(1),"DT1")),U)

                           Begin DoDot:1

 +14                           FOR

                                   DO ITEM5

                                   IF $DATA(ACRQUIT)!$DATA(ACROUT)!(ACRSEQ>2)

                                       QUIT

                           End DoDot:1

 +15       KILL ACRQUIT,ACRDEL

 +16       QUIT

ITEM2      IF ACRY=1

               SET ACRSEQ=1

               DO ITEM3

               IF $DATA(ACRQUIT)!$DATA(ACROUT)

                   QUIT

 +1        DO DISP^ACRFSTK1

 +2        IF ACRSEQ>1

               Begin DoDot:1

 +3                SET DIR(0)="YO"

 +4                SET DIR("A")="Change Vendor priority"

 +5                SET DIR("B")="NO"

 +6                DO DIR^ACRFDIC

 +7                IF Y=1

                       Begin DoDot:2

 +8                        IF ACRSEQ=2

                               Begin DoDot:3

 +9                                SET ACRX=ACR(2)

 +10                               SET ACR(2)=ACR(1)

 +11                               SET ACR(1)=ACRX

 +12                               FOR ACRX=1,2

                                       Begin DoDot:4

 +13                                       SET DA=+ACR(ACRX)

 +14                                       SET DIE="^ACRITEM("

 +15                                       SET DR="15////"_+ACR(1)_";26////"_ACRX

 +16                                       DO DIE^ACRFDIC

                                       End DoDot:4

                               End DoDot:3

 +17                       IF ACRSEQ=3

                               Begin DoDot:3

 +18                               FOR ACRX=1:1:3

                                       SET ACRX(ACRX)=$GET(ACR(ACRX))

 +19                               SET ACRPRI=0

 +20                               WRITE !

 +21                               FOR

                                       SET ACRPRI=$ORDER(ACR(ACRPRI))

                                       IF 'ACRPRI

                                           QUIT

 +22                               SET DIR(0)="SOB^2:"_$PIECE(ACR(2),U,3)_";3:"_$PIECE(ACR(3),U,3)

 +23                               SET DIR("A")="New Primary Vendor"

 +24                               DO DIR^ACRFDIC

 +25                               IF Y

                                       Begin DoDot:4

 +26                                       SET ACRX=Y

 +27                                       SET ACRX(Y)=ACR(1)

 +28                                       SET ACRX(1)=ACR(Y)

 +29                                       SET ACRSET="1:"_$PIECE(ACR(1),U,3)_";"

 +30                                       SET ACRSET=$SELECT(Y=2:ACRSET_"3:"_$PIECE(ACR(3),U,3),1:ACRSET_"2:"_$PIECE(ACR(2),U,3))

                                       End DoDot:4

 +31                               IF 'Y

                                       QUIT

 +32                               SET DIR(0)="SOB^"_ACRSET

 +33                               SET DIR("A")="New Secondary Vendor"

 +34                               DO DIR^ACRFDIC

 +35                               IF Y=1

                                       Begin DoDot:4

 +36                                       SET ACRX(2)=ACR(Y)

 +37                                       SET ACRX(3)=ACR($SELECT(ACRX+Y=3:3,ACRX+Y=4:2,1:1))

                                       End DoDot:4

 +38                               FOR ACRX=1:1:3

                                       Begin DoDot:4

 +39                                       SET ACR(ACRX)=ACRX(ACRX)

 +40                                       SET DA=+ACR(ACRX)

 +41                                       SET DIE="^ACRITEM("

 +42                                       SET DR="15////"_+ACR(1)_";26////"_ACRX

 +43                                       DO DIE^ACRFDIC

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +44       KILL ACRQUIT

 +45       SET DIR(0)="YO"

 +46       SET DIR("A")="Edit Item Data........"

 +47       SET DIR("B")="NO"

 +48       DO DIR^ACRFDIC

 +49       IF Y'=1

               SET ACRQUIT=""

               QUIT

 +50       DO ITEM3

 +51       QUIT

ITEM3      SET ACRY=""

 +1        IF '$DATA(ACRADD)

               DO ITEM4

ITEM31     IF $DATA(ACRQUIT)!$DATA(ACROUT)

               QUIT

 +1        IF '$DATA(Y)

               SET Y="G"

 +2        IF "123G"'[Y

               SET Y="G"

 +3        IF Y="G"

               SET ACRG=""

 +4        SET DA=+ACRDA

 +5        SET DR=$SELECT(Y:"[ACR DI VENDOR]",1:"[ACR ADD DIRECT ISSUE]")

 +6        KILL ACRSSITM

ITEM311    SET DIE="^ACRITEM("

 +1        SET ACRITEM=""

 +2        IF $DATA(^ACRITEM(ACRDA,"DT1"))

               SET ACRMESS=$SELECT(DR["SEC":"VENDOR - "_$SELECT($PIECE(^("DT1"),U)]"":$PIECE(^AUTTVNDR($PIECE(^ACRITEM(ACRDA,"DT1"),U),0),U),1:""),1:"STANDARD ITEM GENERAL INFO")

 +3        DO DIE^ACRFDIC

 +4        KILL ACRITEM

 +5        IF $DATA(ACRG)

               FOR ACR=2,3

                   IF $DATA(ACR(ACR))

                       Begin DoDot:1

 +6                        SET ^ACRITEM(+ACR(ACR),"DT")=^ACRITEM(ACRDA,"DT")

 +7                        IF $DATA(^ACRITEM(ACRDA,"DT2"))

                               SET ^ACRITEM(+ACR(ACR),"DT2")=^ACRITEM(ACRDA,"DT2")

 +8                        KILL ACRG

                       End DoDot:1

 +9        IF $DATA(ACRDEL)

               DO DELETE^ACRFSTK1

 +10       QUIT

ITEM4      KILL ACRADD

 +1        SET ACRSET="G:GENERAL INFORMATION;"_$SELECT(ACRSEQ=1:"1:PRIMARY VENDOR",ACRSEQ=2:"1:PRIMARY VENDOR;2:SECONDARY VENDOR",1:"1:PRIMARY VENDOR;2:SECONDARY VENDOR;3:TERTIARY VENDOR")

 +2        SET DIR(0)="SO^"_ACRSET

 +3        SET DIR("A")="Which OPTION"

 +4        DO DIR^ACRFDIC

 +5        IF $DATA(ACRQUIT)!$DATA(ACROUT)

               QUIT

 +6        IF Y=""

               QUIT

 +7        IF '$DATA(ACR(Y))&'$DATA(ACR(1))

               QUIT

 +8        SET ACRDA=$SELECT(Y&$DATA(ACR(Y)):+ACR(Y),1:+ACR(1))

 +9        IF Y>1

               SET ACRDEL=+ACR(Y)_U_Y

 +10       QUIT

ITEM5      SET DIR(0)="YO"

 +1        SET DIR("A")="Add a "_$SELECT(ACRSEQ=1:"Secondary",1:"Tertiary ")_" Vendor"

 +2        SET DIR("B")="NO"

 +3        DO DIR^ACRFDIC

 +4        IF Y'=1

               SET ACRQUIT=""

               QUIT

 +5        SET DIC="^AUTTVNDR("

 +6        SET DIC(0)="AEMQZ"

 +7        SET DIC("A")="VENDOR..............: "

 +8        DO DIC^ACRFDIC

 +9        IF +Y<1!$DATA(ACRQUIT)!$DATA(ACROUT)

               QUIT

 +10       SET ACRVDA=+Y

           SET ACR=0

 +11       SET ACRSEQ=ACRSEQ+1

 +12       SET X=ACRINDEX

 +13       SET DIC(0)="L"

 +14       SET DIC="^ACRITEM("

 +15       SET DIC("DR")="24////"_ACRVDA_";26////"_ACRSEQ

 +16       DO FILE^ACRFDIC

 +17       IF +Y<1

               QUIT

 +18       SET (DA,ACRDA)=+Y

 +19       SET $PIECE(^ACRITEM(+Y,0),U,2)=$PIECE(^ACRITEM(ACRDA(1),0),U,2)

 +20       SET ^ACRITEM(+Y,"DT")=^ACRITEM(+ACRDA(1),"DT")

 +21       SET DIK="^ACRITEM("

 +22       DO IX1^ACRFDIC

 +23       SET DA=+ACRDA

 +24       SET DIE="^ACRITEM("

 +25       SET DR=".03////"_ACRSEQ_";15////"_+ACRDA(1)_";26////"_ACRSEQ

 +26       DO DIE^ACRFDIC

 +27       SET (DA,ACRDA(ACRSEQ))=ACRDA

 +28       SET DR="[ACR DI VENDOR]"

 +29       DO ITEM311

 +30       QUIT

ADD       ;EP;TO ADD ITEM TO SI FILE DURING PO PROCESSING

 +1        SET ACRADD=""

 +2        SET ACRSSITM=""

 +3        SET X=^ACRSS(ACRSSDA,0)

 +4        SET ACRDT=$GET(^ACRSS(ACRSSDA,"DT"))

 +5        SET ACRKW=$GET(^ACRSS(ACRSSDA,"NMS"))

 +6        SET ACRVND=$GET(^ACRSS(ACRSSDA,"VND"))

 +7        SET ACRDSC=$GET(^ACRSS(ACRSSDA,"DESC"))

 +8        IF ACRDSC[";"

               SET ACRDSC=$TRANSLATE(ACRDSC,";",",")

 +9        SET DIC="^ACRITEM("

 +10       SET DIC(0)="LZ"

 +11      SET DIC("DR")=".02////"_$EXTRACT($PIECE(ACRKW,U,5),1,16)_";1////"_$PIECE(ACRDSC,U)_";2////"_$PIECE(ACRDSC,U,2)_";4////"_$PIECE(ACRDT,U,4)_";29////"_$PIECE(ACRDT,U,2)_";12////"_$PIECE(ACRDT,U,2)_";13////"_$PIECE(ACRDT,U,3)_";8////"_DT_";6////"_..

           ... $PIECE(X,U,4)

 +12       SET DIC("DR")=DIC("DR")_";24////"_+ACRVND_";50////"_$PIECE(ACRDSC,U,3)_";51////"_$PIECE(ACRDSC,U,4)_";52////"_$PIECE(ACRDSC,U,5)

 +13       DO NEW^ACRFSTK1

 +14       DO ITEM11

 +15       KILL ACRSSITM

 +16       QUIT

ACRFSTOK.m