ACRFSS ;IHS/OIRM/DSD/THL,AEF - DISPLAY AND EDIT SERVICES/SUPPLIES; [ 01/31/2007 9:55 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**5,22**;NOV 05, 2001
;;ROUTINE TO DISPLAY AND EDIT SERVICES/SUPPLIES AND TRAVEL ORDER AND
;;TRAINING REQUEST INFORMATION
EN N ACRI
K ACRQUIT,DR,ACRSSDR
S:'$D(ACRTXDA) ACRTXDA=$P(ACRDOC0,U,4)
I ACRREF=130!(ACRREF=148)!(ACRREF=600) D Q
.D ^ACRFSS3
.D EXIT
I ACRREF=999 D Q
.D ^ACRFSS6
.D EXIT
F D EN1 Q:$D(ACRQUIT)!$D(ACROUT)!$D(ACRREV)!$D(ACROUT)
I $D(ACRPO),'$D(ACROUT) D
.N ACRX
.S ACRX=0
.F S ACRX=$O(ACRSS(ACRX)) Q:'ACRX D
..S ACRSSDA=$P(ACRSS(ACRX),U)
..I $P(^ACRSS(ACRSSDA,0),U,12)]"" K ACRSS(ACRX)
.S (ACRK,ACRX)=0
.F S ACRX=$O(ACRSS(ACRX)) Q:'ACRX S ACRK=ACRK+1
.I ACRK>1 D Q:Y'=1
..S DIR(0)="YO"
..S DIR("A")="Add these ITEMS to the STANDARD ITEM FILE"
..S DIR("B")="NO"
..W !
..D DIR^ACRFDIC
.N ACRX
.S ACRX=0
.F S ACRX=$O(ACRSS(ACRX)) Q:'ACRX D
..S ACRSSDA=+ACRSS(ACRX)
..Q:$P(^ACRSS(ACRSSDA,0),U,12)]""
..S DIR(0)="YO"
..S DIR("A")="Add ITEM NO. "_ACRX_" to the STANDARD ITEM FILE"
..S DIR("B")="NO"
..W !
..D DIR^ACRFDIC
..Q:Y'=1
..D ADD^ACRFSTOK
..S DA=ACRSSDA
..S DIE="^ACRSS("
..S DR=".12////"_ACRITMDA
..D DIE^ACRFDIC
EXIT I $D(ACRSSTOT),$P(ACROBL0,U)'=ACRSSTOT D
.W !
.D WAIT^DICD:$E($G(IOST),1,2)="C-"
.D EX
D EXIT^ACRFSSA
Q
EN1 I $D(ACRPO),'$D(^ACRSS("C",ACRDOCDA)),'$D(^ACRSS("J",ACRDOCDA)) D Q
.W !!,"NO ITEMS ORDERED ON THIS REQUEST."
.H 2
.S ACRQUIT=""
I $D(^ACRSS("C",ACRDOCDA))!$D(^ACRSS("J",ACRDOCDA)) D
.N ACRSJ
.D DISPLAY^ACRFSS12
.D SELECT
I '$D(ACRREV),'$D(ACRPO),'$D(^ACRSS("C",ACRDOCDA)) D Q:$D(ACRQUIT)!$D(ACROUT)
.S ACRJ=0
.S ACRDOCVN=$P(ACRDOCPO,U,5)
.W @IOF
.W !?20,"ADD ITEMS TO THIS REQUEST"
.W !!
.D ORDER^ACRFSS11
I '$D(ACRREV),'$D(ACRPO) D
.Q:"^103^349^326^210^"[(U_$G(ACRREFX)_U)
.Q:$P(^ACRDOC(ACRDOCDA,0),U,4)=35&($E($G(^ACROBL(ACRDOCDA,"APV")))="A")
.Q:$G(ACRAPVT)=31!($G(ACRAPVT)=6)
.D ^ACRFSCHK
Q
SELECT D ^ACRFSSPO
D CHECK^ACRFWARN
Q:$D(ACROUT)
I $$REQTP^ACRFSSU(ACRDOCDA)["CREDIT CARD" D ;ACR*2.1*5.17
.;I ACRSSTOT>2500 D CHECKCC^ACRFWARN(ACRSSTOT) ;ACR*2.1*5.17 ;ACR*2.1*22.06 IM23064
.I ACRSSTOT>3000 D CHECKCC^ACRFWARN(ACRSSTOT) ;ACR*2.1*22.06 IM23064
Q:$D(ACROUT) ;ACR*2.1*5.17
I $D(ACRREV),$E(IOST,1,2)="C-" Q
I $D(ACRPO),ACRJ<1 S ACRQUIT="" H 2 Q
SELECT1 I '$D(ACRPO) D
.S DIR(0)="SO^1:Edit an item;2:Add a new item;3:Delete an item;4:View item ADDITIONAL DESCRIPTION;5:Item Entry Completed"
.S:$G(ACRPOT)>2500 DIR(0)=DIR(0)_";6:Add Cost Comparison Data"
.I $P(^ACRDOC(ACRDOCDA,0),U,19),$P(^ACRDOC(ACRDOCDA,"PO"),U,5)=$P($G(^ACRSYS(1,"DT1")),U,12),$P($G(^ACRDOC(ACRDOCDA,"REQ2")),U,13)]"",$D(^ACRSUP("B",$P(^("REQ2"),U,13))) D
..I $G(ACRPOT)>2500 S DIR(0)=DIR(0)_";7:"
..E S DIR(0)=DIR(0)_";6:"
..S DIR(0)=DIR(0)_$S('$P($G(^ACRDOC(ACRDOCDA,"REQ2")),U,14):"Import Supply Contract Data",1:"Edit Unit of Issue/Object Code")
..S ACRSUPC=$P($G(^ACRDOC(ACRDOCDA,"REQ2")),U,14) ;CONTROL UPDATE OF SUPPLY CONTRACT DATA FOR SELECTED DOCUMENT
I $D(ACRPO) D
.S DIR(0)="SO^1:Edit an item;2:Add NEW or Standard item;3:Delete an item;4:View item ADDITIONAL DESCRIPTION;5:Item Edit Completed;6:Transfer an item"
.S:$G(ACRPOT)>2500 DIR(0)=DIR(0)_";7:Add Cost Comparison Data"
I $G(ACRAPVT)=31!($G(ACRAPVT)=6) D
.S DIR(0)="SO^1:Edit an item;5:Item Entry Completed"
S DIR(0)=DIR(0)_";OUT:Discontinue Processing "_$S('$D(ACRPO):"Request",1:"PO")
S DIR("A")=" Option"
S DIR("B")=5
D DIR^ACRFDIC
Q:$D(ACRQUIT)!$D(ACROUT)
I Y=1 D EDIT^ACRFSS1 Q
I Y=2 D ORDER^ACRFSS11 K ACRQUIT Q
I Y=3 D DELETE^ACRFSS2 K ACRQUIT Q
I Y=4 D VIEW^ACRFSS2 K ACRQUIT Q
I Y=6,$D(ACRPO) D TRANS^ACRFSS2 Q
I Y=6,'$D(ACRPO),'$D(ACRSUPC) D EDIT^ACRFSS2 Q
I Y=7,'$D(ACRSUPC) D EDIT^ACRFSS2 Q
I Y=6!(Y=7),$D(ACRSUPC) D PVENDOR Q
I Y=5 S ACRQUIT="" Q
I Y="OUT",'$D(ACRPO),'$D(ACRPOA) S ACROUT=""
Q
OBL ;EP;TO TRIGGER THE REQUEST APPROVED AND/OR REQUEST AUTHORIZED FIELD(S)
;IN THE FMS SUPPLIES/SERVICES FILE TO UPDATE THE REQUESTED AND
;OBLIGATED AMOUNTS
S ACRDA=0
F S ACRDA=$O(^ACRSS("J",ACRDOCDA,ACRDA)) Q:'ACRDA D
.S DA=ACRDA
.S DIE="^ACRSS("
.S DR="905////A"
.I "^103^349^326^210^600^148^"[(U_ACRREF_U) S DR=DR_";911///A"
.I ACRREF=204,$P(^ACRDOC(ACRDOCDA,0),U,4)=30 S DR=DR_";911///A"
.I ACRREF=116,$P(^ACRDOC(ACRDOCDA,0),U,4)=35 S DR=DR_";911///A"
.I $P(^ACRDOC(ACRDOCDA,0),U,19),$D(^ACRDOC($P(^(0),U,19),0)),$P(^(0),U,20) S DR=DR_";911///A"
.D DIE^ACRFDIC
.D TRANS
Q
EX Q:'$P(^ACRSYS(1,"DT"),U,99)
S DA=ACRDOCDA
S DIE="^ACROBL("
S DR=".01///"_(ACRSSTOT-$G(ACRQD))
S:$D(ACRVENDA) DR=DR_";100////"_ACRVENDA
D DIE^ACRFDIC
S DA=$O(^ACRTRX("AC",ACRDOCDA,"O",0))
S DIE="^ACRTRX("
S DR="10////"_(ACRSSTOT-$G(ACRQD))
D DIE^ACRFDIC
Q
DISPLAY ;EP;
D DISPLAY^ACRFSS12
Q
TRANS ;EP;TO SET THE DOCUMENT FILE MULTIPLE FOR ITEMS TRANSFERRED TO
;ANOTHER DOCUMENT
Q:$D(^ACRSS("C",ACRDOCDA,ACRDA))
Q:$P(^ACRSS(ACRDA,0),U,2)=ACRDOCDA
S DA(1)=$P(^ACRSS(ACRDA,0),U,2)
Q:$D(^ACRDOC(DA(1),31,"B",ACRDOCDA))
S X=ACRDOCDA
S DIC="^ACRDOC("_DA(1)_",31,"
S DIC(0)="L"
S:'$D(^ACRDOC(DA(1),31,0)) ^ACRDOC(DA(1),31,0)="^9002196.031P"
D FILE^ACRFDIC
Q
PVENDOR ;PRIME VENDOR OPTIONS
;IF PRIME VENDOR DATA HAS NOT BEEN IMPORTED FOR THIS DOCUMENT, IMPORT
I '$G(ACRSUPC) D Q
.K ACRSUPC
.S ACR1=$P($G(^ACRDOC(ACRDOCDA,"REQ2")),U,13)
.I ACR1="" K ACRSUPC Q
.S DIR(0)="YO"
.S DIR("A")="Update Items from Contractor Data"
.W !
.D DIR^ACRFDIC
.Q:$G(Y)'=1
.D DOC^ACRFPVEN
;IF PRIME VENDOR DATA HAS BEEN IMPORTED ALLOW EDIT OF UNIT OF ISSUE
;AND OBJECT CODE
N ACRSSDA
S ACRSSDA=0
F S ACRSSDA=$O(^ACRSS("J",ACRDOCDA,ACRSSDA)) Q:'ACRSSDA!$D(ACRQUIT) D
.S DA=ACRSSDA
.S DIE="^ACRSS("
.S DR=".04T;11T"
.W !
.D DIE^ACRFDIC
.K ACRQUIT
.S DIR(0)="YO"
.S DIR("A")="Edit next item......"
.S DIR("B")="YES"
.D DIR^ACRFDIC
.I $G(Y)'=1 S ACRQUIT="" Q
Q
ACRFSS ;IHS/OIRM/DSD/THL,AEF - DISPLAY AND EDIT SERVICES/SUPPLIES; [ 01/31/2007 9:55 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**5,22**;NOV 05, 2001
+2 ;;ROUTINE TO DISPLAY AND EDIT SERVICES/SUPPLIES AND TRAVEL ORDER AND
+3 ;;TRAINING REQUEST INFORMATION
EN NEW ACRI
+1 KILL ACRQUIT,DR,ACRSSDR
+2 IF '$DATA(ACRTXDA)
SET ACRTXDA=$PIECE(ACRDOC0,U,4)
+3 IF ACRREF=130!(ACRREF=148)!(ACRREF=600)
Begin DoDot:1
+4 DO ^ACRFSS3
+5 DO EXIT
End DoDot:1
QUIT
+6 IF ACRREF=999
Begin DoDot:1
+7 DO ^ACRFSS6
+8 DO EXIT
End DoDot:1
QUIT
+9 FOR
DO EN1
IF $DATA(ACRQUIT)!$DATA(ACROUT)!$DATA(ACRREV)!$DATA(ACROUT)
QUIT
+10 IF $DATA(ACRPO)
IF '$DATA(ACROUT)
Begin DoDot:1
+11 NEW ACRX
+12 SET ACRX=0
+13 FOR
SET ACRX=$ORDER(ACRSS(ACRX))
IF 'ACRX
QUIT
Begin DoDot:2
+14 SET ACRSSDA=$PIECE(ACRSS(ACRX),U)
+15 IF $PIECE(^ACRSS(ACRSSDA,0),U,12)]""
KILL ACRSS(ACRX)
End DoDot:2
+16 SET (ACRK,ACRX)=0
+17 FOR
SET ACRX=$ORDER(ACRSS(ACRX))
IF 'ACRX
QUIT
SET ACRK=ACRK+1
+18 IF ACRK>1
Begin DoDot:2
+19 SET DIR(0)="YO"
+20 SET DIR("A")="Add these ITEMS to the STANDARD ITEM FILE"
+21 SET DIR("B")="NO"
+22 WRITE !
+23 DO DIR^ACRFDIC
End DoDot:2
IF Y'=1
QUIT
+24 NEW ACRX
+25 SET ACRX=0
+26 FOR
SET ACRX=$ORDER(ACRSS(ACRX))
IF 'ACRX
QUIT
Begin DoDot:2
+27 SET ACRSSDA=+ACRSS(ACRX)
+28 IF $PIECE(^ACRSS(ACRSSDA,0),U,12)]""
QUIT
+29 SET DIR(0)="YO"
+30 SET DIR("A")="Add ITEM NO. "_ACRX_" to the STANDARD ITEM FILE"
+31 SET DIR("B")="NO"
+32 WRITE !
+33 DO DIR^ACRFDIC
+34 IF Y'=1
QUIT
+35 DO ADD^ACRFSTOK
+36 SET DA=ACRSSDA
+37 SET DIE="^ACRSS("
+38 SET DR=".12////"_ACRITMDA
+39 DO DIE^ACRFDIC
End DoDot:2
End DoDot:1
EXIT IF $DATA(ACRSSTOT)
IF $PIECE(ACROBL0,U)'=ACRSSTOT
Begin DoDot:1
+1 WRITE !
+2 IF $EXTRACT($GET(IOST),1,2)="C-"
DO WAIT^DICD
+3 DO EX
End DoDot:1
+4 DO EXIT^ACRFSSA
+5 QUIT
EN1 IF $DATA(ACRPO)
IF '$DATA(^ACRSS("C",ACRDOCDA))
IF '$DATA(^ACRSS("J",ACRDOCDA))
Begin DoDot:1
+1 WRITE !!,"NO ITEMS ORDERED ON THIS REQUEST."
+2 HANG 2
+3 SET ACRQUIT=""
End DoDot:1
QUIT
+4 IF $DATA(^ACRSS("C",ACRDOCDA))!$DATA(^ACRSS("J",ACRDOCDA))
Begin DoDot:1
+5 NEW ACRSJ
+6 DO DISPLAY^ACRFSS12
+7 DO SELECT
End DoDot:1
+8 IF '$DATA(ACRREV)
IF '$DATA(ACRPO)
IF '$DATA(^ACRSS("C",ACRDOCDA))
Begin DoDot:1
+9 SET ACRJ=0
+10 SET ACRDOCVN=$PIECE(ACRDOCPO,U,5)
+11 WRITE @IOF
+12 WRITE !?20,"ADD ITEMS TO THIS REQUEST"
+13 WRITE !!
+14 DO ORDER^ACRFSS11
End DoDot:1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+15 IF '$DATA(ACRREV)
IF '$DATA(ACRPO)
Begin DoDot:1
+16 IF "^103^349^326^210^"[(U_$GET(ACRREFX)_U)
QUIT
+17 IF $PIECE(^ACRDOC(ACRDOCDA,0),U,4)=35&($EXTRACT($GET(^ACROBL(ACRDOCDA,"APV")))="A")
QUIT
+18 IF $GET(ACRAPVT)=31!($GET(ACRAPVT)=6)
QUIT
+19 DO ^ACRFSCHK
End DoDot:1
+20 QUIT
SELECT DO ^ACRFSSPO
+1 DO CHECK^ACRFWARN
+2 IF $DATA(ACROUT)
QUIT
+3 ;ACR*2.1*5.17
IF $$REQTP^ACRFSSU(ACRDOCDA)["CREDIT CARD"
Begin DoDot:1
+4 ;I ACRSSTOT>2500 D CHECKCC^ACRFWARN(ACRSSTOT) ;ACR*2.1*5.17 ;ACR*2.1*22.06 IM23064
+5 ;ACR*2.1*22.06 IM23064
IF ACRSSTOT>3000
DO CHECKCC^ACRFWARN(ACRSSTOT)
End DoDot:1
+6 ;ACR*2.1*5.17
IF $DATA(ACROUT)
QUIT
+7 IF $DATA(ACRREV)
IF $EXTRACT(IOST,1,2)="C-"
QUIT
+8 IF $DATA(ACRPO)
IF ACRJ<1
SET ACRQUIT=""
HANG 2
QUIT
SELECT1 IF '$DATA(ACRPO)
Begin DoDot:1
+1 SET DIR(0)="SO^1:Edit an item;2:Add a new item;3:Delete an item;4:View item ADDITIONAL DESCRIPTION;5:Item Entry Completed"
+2 IF $GET(ACRPOT)>2500
SET DIR(0)=DIR(0)_";6:Add Cost Comparison Data"
+3 IF $PIECE(^ACRDOC(ACRDOCDA,0),U,19)
IF $PIECE(^ACRDOC(ACRDOCDA,"PO"),U,5)=$PIECE($GET(^ACRSYS(1,"DT1")),U,12)
IF $PIECE($GET(^ACRDOC(ACRDOCDA,"REQ2")),U,13)]""
IF $DATA(^ACRSUP("B",$PIECE(^("REQ2"),U,13)))
Begin DoDot:2
+4 IF $GET(ACRPOT)>2500
SET DIR(0)=DIR(0)_";7:"
+5 IF '$TEST
SET DIR(0)=DIR(0)_";6:"
+6 SET DIR(0)=DIR(0)_$SELECT('$PIECE($GET(^ACRDOC(ACRDOCDA,"REQ2")),U,14):"Import Supply Contract Data",1:"Edit Unit of Issue/Object Code")
+7 ;CONTROL UPDATE OF SUPPLY CONTRACT DATA FOR SELECTED DOCUMENT
SET ACRSUPC=$PIECE($GET(^ACRDOC(ACRDOCDA,"REQ2")),U,14)
End DoDot:2
End DoDot:1
+8 IF $DATA(ACRPO)
Begin DoDot:1
+9 SET DIR(0)="SO^1:Edit an item;2:Add NEW or Standard item;3:Delete an item;4:View item ADDITIONAL DESCRIPTION;5:Item Edit Completed;6:Transfer an item"
+10 IF $GET(ACRPOT)>2500
SET DIR(0)=DIR(0)_";7:Add Cost Comparison Data"
End DoDot:1
+11 IF $GET(ACRAPVT)=31!($GET(ACRAPVT)=6)
Begin DoDot:1
+12 SET DIR(0)="SO^1:Edit an item;5:Item Entry Completed"
End DoDot:1
+13 SET DIR(0)=DIR(0)_";OUT:Discontinue Processing "_$SELECT('$DATA(ACRPO):"Request",1:"PO")
+14 SET DIR("A")=" Option"
+15 SET DIR("B")=5
+16 DO DIR^ACRFDIC
+17 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+18 IF Y=1
DO EDIT^ACRFSS1
QUIT
+19 IF Y=2
DO ORDER^ACRFSS11
KILL ACRQUIT
QUIT
+20 IF Y=3
DO DELETE^ACRFSS2
KILL ACRQUIT
QUIT
+21 IF Y=4
DO VIEW^ACRFSS2
KILL ACRQUIT
QUIT
+22 IF Y=6
IF $DATA(ACRPO)
DO TRANS^ACRFSS2
QUIT
+23 IF Y=6
IF '$DATA(ACRPO)
IF '$DATA(ACRSUPC)
DO EDIT^ACRFSS2
QUIT
+24 IF Y=7
IF '$DATA(ACRSUPC)
DO EDIT^ACRFSS2
QUIT
+25 IF Y=6!(Y=7)
IF $DATA(ACRSUPC)
DO PVENDOR
QUIT
+26 IF Y=5
SET ACRQUIT=""
QUIT
+27 IF Y="OUT"
IF '$DATA(ACRPO)
IF '$DATA(ACRPOA)
SET ACROUT=""
+28 QUIT
OBL ;EP;TO TRIGGER THE REQUEST APPROVED AND/OR REQUEST AUTHORIZED FIELD(S)
+1 ;IN THE FMS SUPPLIES/SERVICES FILE TO UPDATE THE REQUESTED AND
+2 ;OBLIGATED AMOUNTS
+3 SET ACRDA=0
+4 FOR
SET ACRDA=$ORDER(^ACRSS("J",ACRDOCDA,ACRDA))
IF 'ACRDA
QUIT
Begin DoDot:1
+5 SET DA=ACRDA
+6 SET DIE="^ACRSS("
+7 SET DR="905////A"
+8 IF "^103^349^326^210^600^148^"[(U_ACRREF_U)
SET DR=DR_";911///A"
+9 IF ACRREF=204
IF $PIECE(^ACRDOC(ACRDOCDA,0),U,4)=30
SET DR=DR_";911///A"
+10 IF ACRREF=116
IF $PIECE(^ACRDOC(ACRDOCDA,0),U,4)=35
SET DR=DR_";911///A"
+11 IF $PIECE(^ACRDOC(ACRDOCDA,0),U,19)
IF $DATA(^ACRDOC($PIECE(^(0),U,19),0))
IF $PIECE(^(0),U,20)
SET DR=DR_";911///A"
+12 DO DIE^ACRFDIC
+13 DO TRANS
End DoDot:1
+14 QUIT
EX IF '$PIECE(^ACRSYS(1,"DT"),U,99)
QUIT
+1 SET DA=ACRDOCDA
+2 SET DIE="^ACROBL("
+3 SET DR=".01///"_(ACRSSTOT-$GET(ACRQD))
+4 IF $DATA(ACRVENDA)
SET DR=DR_";100////"_ACRVENDA
+5 DO DIE^ACRFDIC
+6 SET DA=$ORDER(^ACRTRX("AC",ACRDOCDA,"O",0))
+7 SET DIE="^ACRTRX("
+8 SET DR="10////"_(ACRSSTOT-$GET(ACRQD))
+9 DO DIE^ACRFDIC
+10 QUIT
DISPLAY ;EP;
+1 DO DISPLAY^ACRFSS12
+2 QUIT
TRANS ;EP;TO SET THE DOCUMENT FILE MULTIPLE FOR ITEMS TRANSFERRED TO
+1 ;ANOTHER DOCUMENT
+2 IF $DATA(^ACRSS("C",ACRDOCDA,ACRDA))
QUIT
+3 IF $PIECE(^ACRSS(ACRDA,0),U,2)=ACRDOCDA
QUIT
+4 SET DA(1)=$PIECE(^ACRSS(ACRDA,0),U,2)
+5 IF $DATA(^ACRDOC(DA(1),31,"B",ACRDOCDA))
QUIT
+6 SET X=ACRDOCDA
+7 SET DIC="^ACRDOC("_DA(1)_",31,"
+8 SET DIC(0)="L"
+9 IF '$DATA(^ACRDOC(DA(1),31,0))
SET ^ACRDOC(DA(1),31,0)="^9002196.031P"
+10 DO FILE^ACRFDIC
+11 QUIT
PVENDOR ;PRIME VENDOR OPTIONS
+1 ;IF PRIME VENDOR DATA HAS NOT BEEN IMPORTED FOR THIS DOCUMENT, IMPORT
+2 IF '$GET(ACRSUPC)
Begin DoDot:1
+3 KILL ACRSUPC
+4 SET ACR1=$PIECE($GET(^ACRDOC(ACRDOCDA,"REQ2")),U,13)
+5 IF ACR1=""
KILL ACRSUPC
QUIT
+6 SET DIR(0)="YO"
+7 SET DIR("A")="Update Items from Contractor Data"
+8 WRITE !
+9 DO DIR^ACRFDIC
+10 IF $GET(Y)'=1
QUIT
+11 DO DOC^ACRFPVEN
End DoDot:1
QUIT
+12 ;IF PRIME VENDOR DATA HAS BEEN IMPORTED ALLOW EDIT OF UNIT OF ISSUE
+13 ;AND OBJECT CODE
+14 NEW ACRSSDA
+15 SET ACRSSDA=0
+16 FOR
SET ACRSSDA=$ORDER(^ACRSS("J",ACRDOCDA,ACRSSDA))
IF 'ACRSSDA!$DATA(ACRQUIT)
QUIT
Begin DoDot:1
+17 SET DA=ACRSSDA
+18 SET DIE="^ACRSS("
+19 SET DR=".04T;11T"
+20 WRITE !
+21 DO DIE^ACRFDIC
+22 KILL ACRQUIT
+23 SET DIR(0)="YO"
+24 SET DIR("A")="Edit next item......"
+25 SET DIR("B")="YES"
+26 DO DIR^ACRFDIC
+27 IF $GET(Y)'=1
SET ACRQUIT=""
QUIT
End DoDot:1
+28 QUIT
