ACRFDHR1 ;IHS/OIRM/DSD/THL,AEF - PROCESS DOCUMENT HISTORY RECORDS - CON'T; [ 02/02/2005 10:25 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,16**;NOV 05, 2001
;;
DHRRCD ;EP;TO CREATE DHR RECORD IN DHR PROGRAM
; Quit if hold for next fiscal year
Q:$$HOLD($G(ACRFY),$G(ACR3),$G(ACRD0),$G(ACRD1),$G(ACRD2)) ;ACR*2.1*3.08
;
; Quit if not 'activate DHR interface'
Q:$P(^ACRSYS($$SYS^ACRFUTL($P($G(ACRDOC0),U,8)),"DT"),U,25)'=1
;
; Quit if no DHR records
Q:'$D(^AFSHRCDS(0))#2
;
; Quit if Travel DHR only, and reference code is not 130 or 600 (travel order or voucher)
I $P(^ACRSYS($$SYS^ACRFUTL($P($G(ACRDOC0),U,8)),"DT"),U,32),"^130^600^"'[(U_ACRREF_U) Q
;
; Quit if multi-use standard re and not 'create DHR for Fedstrip'
I ACRREF=210,'$P(^ACRSYS($$SYS^ACRFUTL($P($G(ACRDOC0),U,8)),"DT"),U,38) Q
;
;I $P(^ACRSYS(1,"DT"),U,37),"^600^618^"[(U_ACRREF_U),"^181^182^191^192^281^"[(U_(ACR3)_U) Q
N ACRDATE,ACRDA
S ACRDATE=DT
S ACRDA=$S($G(ACRIV)'="PAY":5,1:6)
DATE I $P($G(^AFSHRCDS(ACRDA,"D",ACRDATE,"I",1,0)),U,3)="C" D G DATE
.S X1=ACRDATE
.S X2=1
.D C^%DTC
.S ACRDATE=X
I '$D(^AFSHRCDS(ACRDA,0))#2 D
.S (X,DINUM)=ACRDA
.S DIC="^AFSHRCDS("
.S DIC(0)="L"
.D FILE^ACRFDIC
S:$D(ACRDHRZ) ACRDATE=ACRDHRZ
S:'$D(^AFSHRCDS(ACRDA,"D",0)) ^AFSHRCDS(ACRDA,"D",0)="^9002322.02D"
I $G(ACRIV)'="PAY",ACRREF'="043" D I 1
.S ACRACPT=$P(ACRDOC0,U,8)
.S ACRACPT=$P(^ACRPO(ACRACPT,0),U,4)
.I ACRACPT,$D(^AUTTACPT(ACRACPT,0)) S ACRACPT=$P(^AUTTACPT(ACRACPT,0),U)
I $D(^AFSHRCDS(ACRDA,"D",ACRDATE,0))#2 S Y=ACRDATE
E D
.S DA(1)=ACRDA
.S (X,DINUM)=ACRDATE
.S DIC="^AFSHRCDS("_ACRDA_",""D"","
.S DIC(0)="L"
.D FILE^ACRFDIC
S ACRDA(2)=+Y
S:'$D(^AFSHRCDS(ACRDA,"D",ACRDA(2),"I",0))#2 ^AFSHRCDS(ACRDA,"D",ACRDA(2),"I",0)="^9002322.21"
I $D(^AFSHRCDS(ACRDA,"D",ACRDA(2),"I","B","R")) S Y=$O(^("R",0))
E D
.S DA(2)=ACRDA
.S DA(1)=ACRDA(2)
.S X="R"
.S DIC="^AFSHRCDS("_ACRDA_",""D"","_ACRDA(2)_",""I"","
.S DIC(0)="L",DIC("DR")="1////"_ACRACPT_";2////O"
.D FILE^ACRFDIC
S ACRDA(3)=+Y
S:'$D(^AFSHRCDS(ACRDA,"D",ACRDA(2),"I",ACRDA(3),"S",0)) ^AFSHRCDS(ACRDA,"D",ACRDA(2),"I",ACRDA(3),"S",0)="^9002322.216"
K X
L +^AFSHRCDS(ACRDA,"D",ACRDA(2),"I",ACRDA(3),"S",0):4 Q:'$T
S X=$P(^AFSHRCDS(ACRDA,"D",ACRDA(2),"I",ACRDA(3),"S",0),U,3)
S X=X+1
L -^AFSHRCDS(ACRDA,"D",ACRDA(2),"I",ACRDA(3),"S",0):0
Q:'$D(X)
S DA(3)=ACRDA
S DA(2)=ACRDA(2)
S DA(1)=ACRDA(3)
;S X=X ;COMMENT OUT ;ACR*2.1*3.09
S DIC="^AFSHRCDS("_ACRDA_",""D"","_ACRDA(2)_",""I"","_ACRDA(3)_",""S"","
S DIC(0)="L"
D FILE^ACRFDIC
S ACRCNT=$G(ACRCNT)+1
S DA(3)=ACRDA
S DA(2)=ACRDA(2)
S DA(1)=ACRDA(3)
S DA=+Y
S DIE="^AFSHRCDS("_ACRDA_",""D"","_ACRDA(2)_",""I"","_ACRDA(3)_",""S"","
;I $G(ACRIV)="PAY",'$G(ACRRECOV) Q:$G(ACRDHR)="" D DR ;ACR*2.1*16.06 IM15505
I $G(ACRIV)["PAY",'$G(ACRRECOV) Q:$G(ACRDHR)="" D DR ;ACR*2.1*16.06 IM15505
S DR=ACRDR
I '$G(ACRFMS) D
. Q:'$G(ACRD0) Q:'$G(ACRD1) Q:'$G(ACRD2) ;ACR*2.1*3.08
. S ACRFMS=$P($G(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,"ARMS")),U,4) ;ACR*2.1*3.08
I $E(DR,$L(DR))=";" S DR=$P(DR,";",1,$L(DR,";")-1)
S DR=DR_";99////"_$G(ACRFMS)
D DIE^ACRFDIC
K ACRFMS
Q
DR ;CREATE DR STRING FROM 1166 DATA RECORD
N Z
S Z=ACRDHR
S DR="1////"_$E(Z)
S DR=DR_";2///"_$E(Z,2,7)
S DR=DR_";3////"_$E(Z,8,10)
S DR=DR_";4////"_$E(Z,11)
S DR=DR_";5////"_$E(Z,12)
S DR=DR_";6////"_$E(Z,13,15)
S DR=DR_";7////"_$E(Z,16,25)
S DR=DR_";8////"_$E(Z,26,28)
S DR=DR_";9////"_$E(Z,29,38)
S DR=DR_";10////"_$E(Z,39)
S DR=DR_";11////"_$E(Z,40)
S DR=DR_";12////"_$E(Z,41,47)
S DR=DR_";13////"_$E(Z,48,51)
S DR=DR_";14////"_$E(Z,52,63)
S DR=DR_";15////"_$E(Z,64)
S DR=DR_";16////"_$E(Z,65,79)
S DR=DR_";17////"_$E(Z,80,94)
S DR=DR_";18////"_$E(Z,95,104)
S DR=DR_";26////"_$E(Z,126,129)
S DR=DR_";27////"_$E(Z,130,133)
S DR=DR_";28////"_$E(Z,134,135)
S DR=DR_";29////"_$E(Z,136)
S DR=DR_";30////"_$E(Z,137,140)
S ACRDR=DR
Q
HOLD(ACRFY,ACR3,ACRFYDA,ACRBATDA,ACRSEQDA) ;
;----- HOLD DHRS FOR NEW FISCAL YEAR
;
; BASED ON ENTRY IN FIELD 401 HOLD DHRS FOR NEW FY
; IN THE FMS SYSTEM DEFAULTS FILE
;
N ACRDOCDA
I '$P($G(^ACRSYS(1,401)),U) Q 0
I ACRFY,ACRFY=$P($G(^ACRSYS(1,401)),U) Q 1
I ACR3="050",ACRFY=$P($G(^ACRSYS(1,401)),U) Q 1
I "^181^182^191^192^061^242^"[(U_ACR3_U) D
. I $G(ACRFYDA),$G(ACRBATDA),$G(ACRSEQDA) D ;ACR*2.1*3.15
. . S ACRDOCDA=$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,"ARMS")),U) ;ACR*2.1*3.15
I $G(ACRDOCDA),$$DOCFY(ACRDOCDA)=$P($G(^ACRSYS(1,401)),U) Q 1
Q 0
DOCFY(ACRDOCDA) ;
;----- RETURNS FY OF FUNDS FOR ARMS DOCUMENT
;
S Y=""
S Y=$P($G(^ACRDOC(ACRDOCDA,0)),U,6)
I Y S Y=$P($G(^ACRLOCB(Y,"DT")),U)
Q Y
ACRFDHR1 ;IHS/OIRM/DSD/THL,AEF - PROCESS DOCUMENT HISTORY RECORDS - CON'T; [ 02/02/2005 10:25 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,16**;NOV 05, 2001
+2 ;;
DHRRCD ;EP;TO CREATE DHR RECORD IN DHR PROGRAM
+1 ; Quit if hold for next fiscal year
+2 ;ACR*2.1*3.08
IF $$HOLD($GET(ACRFY),$GET(ACR3),$GET(ACRD0),$GET(ACRD1),$GET(ACRD2))
QUIT
+3 ;
+4 ; Quit if not 'activate DHR interface'
+5 IF $PIECE(^ACRSYS($$SYS^ACRFUTL($PIECE($GET(ACRDOC0),U,8)),"DT"),U,25)'=1
QUIT
+6 ;
+7 ; Quit if no DHR records
+8 IF '$DATA(^AFSHRCDS(0))#2
QUIT
+9 ;
+10 ; Quit if Travel DHR only, and reference code is not 130 or 600 (travel order or voucher)
+11 IF $PIECE(^ACRSYS($$SYS^ACRFUTL($PIECE($GET(ACRDOC0),U,8)),"DT"),U,32)
IF "^130^600^"'[(U_ACRREF_U)
QUIT
+12 ;
+13 ; Quit if multi-use standard re and not 'create DHR for Fedstrip'
+14 IF ACRREF=210
IF '$PIECE(^ACRSYS($$SYS^ACRFUTL($PIECE($GET(ACRDOC0),U,8)),"DT"),U,38)
QUIT
+15 ;
+16 ;I $P(^ACRSYS(1,"DT"),U,37),"^600^618^"[(U_ACRREF_U),"^181^182^191^192^281^"[(U_(ACR3)_U) Q
+17 NEW ACRDATE,ACRDA
+18 SET ACRDATE=DT
+19 SET ACRDA=$SELECT($GET(ACRIV)'="PAY":5,1:6)
DATE IF $PIECE($GET(^AFSHRCDS(ACRDA,"D",ACRDATE,"I",1,0)),U,3)="C"
Begin DoDot:1
+1 SET X1=ACRDATE
+2 SET X2=1
+3 DO C^%DTC
+4 SET ACRDATE=X
End DoDot:1
GOTO DATE
+5 IF '$DATA(^AFSHRCDS(ACRDA,0))#2
Begin DoDot:1
+6 SET (X,DINUM)=ACRDA
+7 SET DIC="^AFSHRCDS("
+8 SET DIC(0)="L"
+9 DO FILE^ACRFDIC
End DoDot:1
+10 IF $DATA(ACRDHRZ)
SET ACRDATE=ACRDHRZ
+11 IF '$DATA(^AFSHRCDS(ACRDA,"D",0))
SET ^AFSHRCDS(ACRDA,"D",0)="^9002322.02D"
+12 IF $GET(ACRIV)'="PAY"
IF ACRREF'="043"
Begin DoDot:1
+13 SET ACRACPT=$PIECE(ACRDOC0,U,8)
+14 SET ACRACPT=$PIECE(^ACRPO(ACRACPT,0),U,4)
+15 IF ACRACPT
IF $DATA(^AUTTACPT(ACRACPT,0))
SET ACRACPT=$PIECE(^AUTTACPT(ACRACPT,0),U)
End DoDot:1
IF 1
+16 IF $DATA(^AFSHRCDS(ACRDA,"D",ACRDATE,0))#2
SET Y=ACRDATE
+17 IF '$TEST
Begin DoDot:1
+18 SET DA(1)=ACRDA
+19 SET (X,DINUM)=ACRDATE
+20 SET DIC="^AFSHRCDS("_ACRDA_",""D"","
+21 SET DIC(0)="L"
+22 DO FILE^ACRFDIC
End DoDot:1
+23 SET ACRDA(2)=+Y
+24 IF '$DATA(^AFSHRCDS(ACRDA,"D",ACRDA(2),"I",0))#2
SET ^AFSHRCDS(ACRDA,"D",ACRDA(2),"I",0)="^9002322.21"
+25 IF $DATA(^AFSHRCDS(ACRDA,"D",ACRDA(2),"I","B","R"))
SET Y=$ORDER(^("R",0))
+26 IF '$TEST
Begin DoDot:1
+27 SET DA(2)=ACRDA
+28 SET DA(1)=ACRDA(2)
+29 SET X="R"
+30 SET DIC="^AFSHRCDS("_ACRDA_",""D"","_ACRDA(2)_",""I"","
+31 SET DIC(0)="L"
SET DIC("DR")="1////"_ACRACPT_";2////O"
+32 DO FILE^ACRFDIC
End DoDot:1
+33 SET ACRDA(3)=+Y
+34 IF '$DATA(^AFSHRCDS(ACRDA,"D",ACRDA(2),"I",ACRDA(3),"S",0))
SET ^AFSHRCDS(ACRDA,"D",ACRDA(2),"I",ACRDA(3),"S",0)="^9002322.216"
+35 KILL X
+36 LOCK +^AFSHRCDS(ACRDA,"D",ACRDA(2),"I",ACRDA(3),"S",0):4
IF '$TEST
QUIT
+37 SET X=$PIECE(^AFSHRCDS(ACRDA,"D",ACRDA(2),"I",ACRDA(3),"S",0),U,3)
+38 SET X=X+1
+39 LOCK -^AFSHRCDS(ACRDA,"D",ACRDA(2),"I",ACRDA(3),"S",0):0
+40 IF '$DATA(X)
QUIT
+41 SET DA(3)=ACRDA
+42 SET DA(2)=ACRDA(2)
+43 SET DA(1)=ACRDA(3)
+44 ;S X=X ;COMMENT OUT ;ACR*2.1*3.09
+45 SET DIC="^AFSHRCDS("_ACRDA_",""D"","_ACRDA(2)_",""I"","_ACRDA(3)_",""S"","
+46 SET DIC(0)="L"
+47 DO FILE^ACRFDIC
+48 SET ACRCNT=$GET(ACRCNT)+1
+49 SET DA(3)=ACRDA
+50 SET DA(2)=ACRDA(2)
+51 SET DA(1)=ACRDA(3)
+52 SET DA=+Y
+53 SET DIE="^AFSHRCDS("_ACRDA_",""D"","_ACRDA(2)_",""I"","_ACRDA(3)_",""S"","
+54 ;I $G(ACRIV)="PAY",'$G(ACRRECOV) Q:$G(ACRDHR)="" D DR ;ACR*2.1*16.06 IM15505
+55 ;ACR*2.1*16.06 IM15505
IF $GET(ACRIV)["PAY"
IF '$GET(ACRRECOV)
IF $GET(ACRDHR)=""
QUIT
DO DR
+56 SET DR=ACRDR
+57 IF '$GET(ACRFMS)
Begin DoDot:1
+58 ;ACR*2.1*3.08
IF '$GET(ACRD0)
QUIT
IF '$GET(ACRD1)
QUIT
IF '$GET(ACRD2)
QUIT
+59 ;ACR*2.1*3.08
SET ACRFMS=$PIECE($GET(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,"ARMS")),U,4)
End DoDot:1
+60 IF $EXTRACT(DR,$LENGTH(DR))=";"
SET DR=$PIECE(DR,";",1,$LENGTH(DR,";")-1)
+61 SET DR=DR_";99////"_$GET(ACRFMS)
+62 DO DIE^ACRFDIC
+63 KILL ACRFMS
+64 QUIT
DR ;CREATE DR STRING FROM 1166 DATA RECORD
+1 NEW Z
+2 SET Z=ACRDHR
+3 SET DR="1////"_$EXTRACT(Z)
+4 SET DR=DR_";2///"_$EXTRACT(Z,2,7)
+5 SET DR=DR_";3////"_$EXTRACT(Z,8,10)
+6 SET DR=DR_";4////"_$EXTRACT(Z,11)
+7 SET DR=DR_";5////"_$EXTRACT(Z,12)
+8 SET DR=DR_";6////"_$EXTRACT(Z,13,15)
+9 SET DR=DR_";7////"_$EXTRACT(Z,16,25)
+10 SET DR=DR_";8////"_$EXTRACT(Z,26,28)
+11 SET DR=DR_";9////"_$EXTRACT(Z,29,38)
+12 SET DR=DR_";10////"_$EXTRACT(Z,39)
+13 SET DR=DR_";11////"_$EXTRACT(Z,40)
+14 SET DR=DR_";12////"_$EXTRACT(Z,41,47)
+15 SET DR=DR_";13////"_$EXTRACT(Z,48,51)
+16 SET DR=DR_";14////"_$EXTRACT(Z,52,63)
+17 SET DR=DR_";15////"_$EXTRACT(Z,64)
+18 SET DR=DR_";16////"_$EXTRACT(Z,65,79)
+19 SET DR=DR_";17////"_$EXTRACT(Z,80,94)
+20 SET DR=DR_";18////"_$EXTRACT(Z,95,104)
+21 SET DR=DR_";26////"_$EXTRACT(Z,126,129)
+22 SET DR=DR_";27////"_$EXTRACT(Z,130,133)
+23 SET DR=DR_";28////"_$EXTRACT(Z,134,135)
+24 SET DR=DR_";29////"_$EXTRACT(Z,136)
+25 SET DR=DR_";30////"_$EXTRACT(Z,137,140)
+26 SET ACRDR=DR
+27 QUIT
HOLD(ACRFY,ACR3,ACRFYDA,ACRBATDA,ACRSEQDA) ;
+1 ;----- HOLD DHRS FOR NEW FISCAL YEAR
+2 ;
+3 ; BASED ON ENTRY IN FIELD 401 HOLD DHRS FOR NEW FY
+4 ; IN THE FMS SYSTEM DEFAULTS FILE
+5 ;
+6 NEW ACRDOCDA
+7 IF '$PIECE($GET(^ACRSYS(1,401)),U)
QUIT 0
+8 IF ACRFY
IF ACRFY=$PIECE($GET(^ACRSYS(1,401)),U)
QUIT 1
+9 IF ACR3="050"
IF ACRFY=$PIECE($GET(^ACRSYS(1,401)),U)
QUIT 1
+10 IF "^181^182^191^192^061^242^"[(U_ACR3_U)
Begin DoDot:1
+11 ;ACR*2.1*3.15
IF $GET(ACRFYDA)
IF $GET(ACRBATDA)
IF $GET(ACRSEQDA)
Begin DoDot:2
+12 ;ACR*2.1*3.15
SET ACRDOCDA=$PIECE($GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,"ARMS")),U)
End DoDot:2
End DoDot:1
+13 IF $GET(ACRDOCDA)
IF $$DOCFY(ACRDOCDA)=$PIECE($GET(^ACRSYS(1,401)),U)
QUIT 1
+14 QUIT 0
DOCFY(ACRDOCDA) ;
+1 ;----- RETURNS FY OF FUNDS FOR ARMS DOCUMENT
+2 ;
+3 SET Y=""
+4 SET Y=$PIECE($GET(^ACRDOC(ACRDOCDA,0)),U,6)
+5 IF Y
SET Y=$PIECE($GET(^ACRLOCB(Y,"DT")),U)
+6 QUIT Y
