ACRFEA3 ;IHS/OIRM/DSD/THL,AEF - CUSTOMIZED DOCUMENT EDITING UTILITY; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;CONTINUATION OF ACRFEA
;;ROUTINE USED TO CUSTOMIZE DOCUMENT EDITING
EN K ACRPARS
D ENX
EXIT S:$D(ACRREFX) ACRREF=ACRREFX
K ACRX,ACRI,DIE,DR,DA,ACRJ,ACRL,ACRPARS
Q
ENX N ACRI,ACRY,ACRX
S:ACRREF=600 ACRREF=130,ACRREFX=600
S:ACRREF=210 ACRREF=103,ACRREFX=210
S ACRL=$T(@ACRREF^ACRFEA31)
S ACRL=$P(ACRL,";;",2)
S DIR(0)="LOB^1:"_$S($D(ACRL):ACRL,1:ACRI)
S DIR("A")=" Edit which field(s)?"
D DIR^ACRFDIC
I $D(ACRQUIT)!$D(ACROUT) Q
S ACRX=Y(0)
S:$E(ACRX,$L(ACRX))="," ACRX=$E(ACRX,1,$L(ACRX)-1)
S ACRFEA3=0
EN1 ;EP;
D HOME^ACRFMENU
N ACRY
W !
F ACRI=1:1:$L(ACRX,",") D EN11
I $D(ACRAUTOD) D DELAUTO^ACRFSS41 K ACRAUTOD
Q
EN11 K ACRREFZ
S:ACRREF=210 ACRREF=103,ACRREFZ=210
S ACRY=$P(ACRX,",",ACRI)
S ACRMESS="[ "_ACRY_" ]"
S ACRDDIE="HEAD^ACRFEA3"
S DA=ACRDOCDA
S DIE=ACRDIE
S DR=$T(@ACRREF+ACRY^ACRFEA31)
I ACRREF=999&(ACRY>1) D
.S DIE="^ATAEMP("
.S DA=$P(^ACRDOC(DA,"PR"),U)
S DR=$P(DR,";;",2)_$S(DR'["]":"T",1:"")
N ACRTXDA
I ACRREF=116,+DR=.04 S ACRTXDA=$P(^ACRDOC(DA,0),U,4)
D DIE^ACRFDIC
I $D(ACRTXDA),$P(^ACRDOC(ACRDOCDA,0),U,4)'=ACRTXDA D
.I $P(^ACRDOC(ACRDOCDA,0),U,4)=35,$E($G(^ACROBL(ACRDOCDA,"APV")))="A" Q
.;IF CHANGED TO CREDIT CARD PURCHASE DURING PURCHASE ORDER PROCESSING
.;DO NOT RESET PREVIOUS APPROVALS
.S ACRSCHK=""
.D APPROVE^ACRFSCHK
I $D(ACRREFZ) S ACRREF=ACRREFZ K ACRREFZ
I $D(ACRNEWOB),ACRREF=130,$P($G(^ACRDOC(ACRDOCDA,"TO")),U,9) D
.;THIS SEQUENCE WILL SET TRAVEL AUTHORIZATION TO 'JTR' FOR
.;COMMISSIONED OFFICERS
.S ACRDUZ=$P(^ACRDOC(ACRDOCDA,"TO"),U,9)
.Q:$P($G(^ACRAU(ACRDUZ,1)),U,3)'="CO"
.S DA=ACRDOCDA
.S DIE="^ACRDOC("
.S DR="130121////J"
.D DIE^ACRFDIC
I ACRREF=148 D
.N ACRTP
.S ACRTP=$P($G(^ACRDOC(+$G(ACRDOCDA),"TRNG")),U,2)
.Q:'ACRTP
.S DR=""
.D EOD1^ACRFTPA1
.S DA=ACRDOCDA
.S DIE="^ACRDOC("
.S DR=$E(DR,2,999)
.D DIE^ACRFDIC
Q
HEAD N ACRX,ACRI
W @IOF
W ?4,"DOCUMENT NO: ",@ACRON,ACRDOC,@ACROF
W $$DASH^ACRFMENU
N DXS,DIP,DC,DN
S D0=ACRDOCDA
D @ACRRTN2
W $$DASH^ACRFMENU
W !
Q
ACRFEA3 ;IHS/OIRM/DSD/THL,AEF - CUSTOMIZED DOCUMENT EDITING UTILITY; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;CONTINUATION OF ACRFEA
+3 ;;ROUTINE USED TO CUSTOMIZE DOCUMENT EDITING
EN KILL ACRPARS
+1 DO ENX
EXIT IF $DATA(ACRREFX)
SET ACRREF=ACRREFX
+1 KILL ACRX,ACRI,DIE,DR,DA,ACRJ,ACRL,ACRPARS
+2 QUIT
ENX NEW ACRI,ACRY,ACRX
+1 IF ACRREF=600
SET ACRREF=130
SET ACRREFX=600
+2 IF ACRREF=210
SET ACRREF=103
SET ACRREFX=210
+3 SET ACRL=$TEXT(@ACRREF^ACRFEA31)
+4 SET ACRL=$PIECE(ACRL,";;",2)
+5 SET DIR(0)="LOB^1:"_$SELECT($DATA(ACRL):ACRL,1:ACRI)
+6 SET DIR("A")=" Edit which field(s)?"
+7 DO DIR^ACRFDIC
+8 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+9 SET ACRX=Y(0)
+10 IF $EXTRACT(ACRX,$LENGTH(ACRX))=","
SET ACRX=$EXTRACT(ACRX,1,$LENGTH(ACRX)-1)
+11 SET ACRFEA3=0
EN1 ;EP;
+1 DO HOME^ACRFMENU
+2 NEW ACRY
+3 WRITE !
+4 FOR ACRI=1:1:$LENGTH(ACRX,",")
DO EN11
+5 IF $DATA(ACRAUTOD)
DO DELAUTO^ACRFSS41
KILL ACRAUTOD
+6 QUIT
EN11 KILL ACRREFZ
+1 IF ACRREF=210
SET ACRREF=103
SET ACRREFZ=210
+2 SET ACRY=$PIECE(ACRX,",",ACRI)
+3 SET ACRMESS="[ "_ACRY_" ]"
+4 SET ACRDDIE="HEAD^ACRFEA3"
+5 SET DA=ACRDOCDA
+6 SET DIE=ACRDIE
+7 SET DR=$TEXT(@ACRREF+ACRY^ACRFEA31)
+8 IF ACRREF=999&(ACRY>1)
Begin DoDot:1
+9 SET DIE="^ATAEMP("
+10 SET DA=$PIECE(^ACRDOC(DA,"PR"),U)
End DoDot:1
+11 SET DR=$PIECE(DR,";;",2)_$SELECT(DR'["]":"T",1:"")
+12 NEW ACRTXDA
+13 IF ACRREF=116
IF +DR=.04
SET ACRTXDA=$PIECE(^ACRDOC(DA,0),U,4)
+14 DO DIE^ACRFDIC
+15 IF $DATA(ACRTXDA)
IF $PIECE(^ACRDOC(ACRDOCDA,0),U,4)'=ACRTXDA
Begin DoDot:1
+16 IF $PIECE(^ACRDOC(ACRDOCDA,0),U,4)=35
IF $EXTRACT($GET(^ACROBL(ACRDOCDA,"APV")))="A"
QUIT
+17 ;IF CHANGED TO CREDIT CARD PURCHASE DURING PURCHASE ORDER PROCESSING
+18 ;DO NOT RESET PREVIOUS APPROVALS
+19 SET ACRSCHK=""
+20 DO APPROVE^ACRFSCHK
End DoDot:1
+21 IF $DATA(ACRREFZ)
SET ACRREF=ACRREFZ
KILL ACRREFZ
+22 IF $DATA(ACRNEWOB)
IF ACRREF=130
IF $PIECE($GET(^ACRDOC(ACRDOCDA,"TO")),U,9)
Begin DoDot:1
+23 ;THIS SEQUENCE WILL SET TRAVEL AUTHORIZATION TO 'JTR' FOR
+24 ;COMMISSIONED OFFICERS
+25 SET ACRDUZ=$PIECE(^ACRDOC(ACRDOCDA,"TO"),U,9)
+26 IF $PIECE($GET(^ACRAU(ACRDUZ,1)),U,3)'="CO"
QUIT
+27 SET DA=ACRDOCDA
+28 SET DIE="^ACRDOC("
+29 SET DR="130121////J"
+30 DO DIE^ACRFDIC
End DoDot:1
+31 IF ACRREF=148
Begin DoDot:1
+32 NEW ACRTP
+33 SET ACRTP=$PIECE($GET(^ACRDOC(+$GET(ACRDOCDA),"TRNG")),U,2)
+34 IF 'ACRTP
QUIT
+35 SET DR=""
+36 DO EOD1^ACRFTPA1
+37 SET DA=ACRDOCDA
+38 SET DIE="^ACRDOC("
+39 SET DR=$EXTRACT(DR,2,999)
+40 DO DIE^ACRFDIC
End DoDot:1
+41 QUIT
HEAD NEW ACRX,ACRI
+1 WRITE @IOF
+2 WRITE ?4,"DOCUMENT NO: ",@ACRON,ACRDOC,@ACROF
+3 WRITE $$DASH^ACRFMENU
+4 NEW DXS,DIP,DC,DN
+5 SET D0=ACRDOCDA
+6 DO @ACRRTN2
+7 WRITE $$DASH^ACRFMENU
+8 WRITE !
+9 QUIT
