Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACRFDHR1

ACRFDHR1.m

Go to the documentation of this file.
  1. 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
  1. ;;
  1. DHRRCD ;EP;TO CREATE DHR RECORD IN DHR PROGRAM
  1. ; Quit if hold for next fiscal year
  1. Q:$$HOLD($G(ACRFY),$G(ACR3),$G(ACRD0),$G(ACRD1),$G(ACRD2)) ;ACR*2.1*3.08
  1. ;
  1. ; Quit if not 'activate DHR interface'
  1. Q:$P(^ACRSYS($$SYS^ACRFUTL($P($G(ACRDOC0),U,8)),"DT"),U,25)'=1
  1. ;
  1. ; Quit if no DHR records
  1. Q:'$D(^AFSHRCDS(0))#2
  1. ;
  1. ; Quit if Travel DHR only, and reference code is not 130 or 600 (travel order or voucher)
  1. I $P(^ACRSYS($$SYS^ACRFUTL($P($G(ACRDOC0),U,8)),"DT"),U,32),"^130^600^"'[(U_ACRREF_U) Q
  1. ;
  1. ; Quit if multi-use standard re and not 'create DHR for Fedstrip'
  1. I ACRREF=210,'$P(^ACRSYS($$SYS^ACRFUTL($P($G(ACRDOC0),U,8)),"DT"),U,38) Q
  1. ;
  1. ;I $P(^ACRSYS(1,"DT"),U,37),"^600^618^"[(U_ACRREF_U),"^181^182^191^192^281^"[(U_(ACR3)_U) Q
  1. N ACRDATE,ACRDA
  1. S ACRDATE=DT
  1. S ACRDA=$S($G(ACRIV)'="PAY":5,1:6)
  1. DATE I $P($G(^AFSHRCDS(ACRDA,"D",ACRDATE,"I",1,0)),U,3)="C" D G DATE
  1. .S X1=ACRDATE
  1. .S X2=1
  1. .D C^%DTC
  1. .S ACRDATE=X
  1. I '$D(^AFSHRCDS(ACRDA,0))#2 D
  1. .S (X,DINUM)=ACRDA
  1. .S DIC="^AFSHRCDS("
  1. .S DIC(0)="L"
  1. .D FILE^ACRFDIC
  1. S:$D(ACRDHRZ) ACRDATE=ACRDHRZ
  1. S:'$D(^AFSHRCDS(ACRDA,"D",0)) ^AFSHRCDS(ACRDA,"D",0)="^9002322.02D"
  1. I $G(ACRIV)'="PAY",ACRREF'="043" D I 1
  1. .S ACRACPT=$P(ACRDOC0,U,8)
  1. .S ACRACPT=$P(^ACRPO(ACRACPT,0),U,4)
  1. .I ACRACPT,$D(^AUTTACPT(ACRACPT,0)) S ACRACPT=$P(^AUTTACPT(ACRACPT,0),U)
  1. I $D(^AFSHRCDS(ACRDA,"D",ACRDATE,0))#2 S Y=ACRDATE
  1. E D
  1. .S DA(1)=ACRDA
  1. .S (X,DINUM)=ACRDATE
  1. .S DIC="^AFSHRCDS("_ACRDA_",""D"","
  1. .S DIC(0)="L"
  1. .D FILE^ACRFDIC
  1. S ACRDA(2)=+Y
  1. S:'$D(^AFSHRCDS(ACRDA,"D",ACRDA(2),"I",0))#2 ^AFSHRCDS(ACRDA,"D",ACRDA(2),"I",0)="^9002322.21"
  1. I $D(^AFSHRCDS(ACRDA,"D",ACRDA(2),"I","B","R")) S Y=$O(^("R",0))
  1. E D
  1. .S DA(2)=ACRDA
  1. .S DA(1)=ACRDA(2)
  1. .S X="R"
  1. .S DIC="^AFSHRCDS("_ACRDA_",""D"","_ACRDA(2)_",""I"","
  1. .S DIC(0)="L",DIC("DR")="1////"_ACRACPT_";2////O"
  1. .D FILE^ACRFDIC
  1. S ACRDA(3)=+Y
  1. S:'$D(^AFSHRCDS(ACRDA,"D",ACRDA(2),"I",ACRDA(3),"S",0)) ^AFSHRCDS(ACRDA,"D",ACRDA(2),"I",ACRDA(3),"S",0)="^9002322.216"
  1. K X
  1. L +^AFSHRCDS(ACRDA,"D",ACRDA(2),"I",ACRDA(3),"S",0):4 Q:'$T
  1. S X=$P(^AFSHRCDS(ACRDA,"D",ACRDA(2),"I",ACRDA(3),"S",0),U,3)
  1. S X=X+1
  1. L -^AFSHRCDS(ACRDA,"D",ACRDA(2),"I",ACRDA(3),"S",0):0
  1. Q:'$D(X)
  1. S DA(3)=ACRDA
  1. S DA(2)=ACRDA(2)
  1. S DA(1)=ACRDA(3)
  1. ;S X=X ;COMMENT OUT ;ACR*2.1*3.09
  1. S DIC="^AFSHRCDS("_ACRDA_",""D"","_ACRDA(2)_",""I"","_ACRDA(3)_",""S"","
  1. S DIC(0)="L"
  1. D FILE^ACRFDIC
  1. S ACRCNT=$G(ACRCNT)+1
  1. S DA(3)=ACRDA
  1. S DA(2)=ACRDA(2)
  1. S DA(1)=ACRDA(3)
  1. S DA=+Y
  1. S DIE="^AFSHRCDS("_ACRDA_",""D"","_ACRDA(2)_",""I"","_ACRDA(3)_",""S"","
  1. ;I $G(ACRIV)="PAY",'$G(ACRRECOV) Q:$G(ACRDHR)="" D DR ;ACR*2.1*16.06 IM15505
  1. I $G(ACRIV)["PAY",'$G(ACRRECOV) Q:$G(ACRDHR)="" D DR ;ACR*2.1*16.06 IM15505
  1. S DR=ACRDR
  1. I '$G(ACRFMS) D
  1. . Q:'$G(ACRD0) Q:'$G(ACRD1) Q:'$G(ACRD2) ;ACR*2.1*3.08
  1. . S ACRFMS=$P($G(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,"ARMS")),U,4) ;ACR*2.1*3.08
  1. I $E(DR,$L(DR))=";" S DR=$P(DR,";",1,$L(DR,";")-1)
  1. S DR=DR_";99////"_$G(ACRFMS)
  1. D DIE^ACRFDIC
  1. K ACRFMS
  1. Q
  1. DR ;CREATE DR STRING FROM 1166 DATA RECORD
  1. N Z
  1. S Z=ACRDHR
  1. S DR="1////"_$E(Z)
  1. S DR=DR_";2///"_$E(Z,2,7)
  1. S DR=DR_";3////"_$E(Z,8,10)
  1. S DR=DR_";4////"_$E(Z,11)
  1. S DR=DR_";5////"_$E(Z,12)
  1. S DR=DR_";6////"_$E(Z,13,15)
  1. S DR=DR_";7////"_$E(Z,16,25)
  1. S DR=DR_";8////"_$E(Z,26,28)
  1. S DR=DR_";9////"_$E(Z,29,38)
  1. S DR=DR_";10////"_$E(Z,39)
  1. S DR=DR_";11////"_$E(Z,40)
  1. S DR=DR_";12////"_$E(Z,41,47)
  1. S DR=DR_";13////"_$E(Z,48,51)
  1. S DR=DR_";14////"_$E(Z,52,63)
  1. S DR=DR_";15////"_$E(Z,64)
  1. S DR=DR_";16////"_$E(Z,65,79)
  1. S DR=DR_";17////"_$E(Z,80,94)
  1. S DR=DR_";18////"_$E(Z,95,104)
  1. S DR=DR_";26////"_$E(Z,126,129)
  1. S DR=DR_";27////"_$E(Z,130,133)
  1. S DR=DR_";28////"_$E(Z,134,135)
  1. S DR=DR_";29////"_$E(Z,136)
  1. S DR=DR_";30////"_$E(Z,137,140)
  1. S ACRDR=DR
  1. Q
  1. HOLD(ACRFY,ACR3,ACRFYDA,ACRBATDA,ACRSEQDA) ;
  1. ;----- HOLD DHRS FOR NEW FISCAL YEAR
  1. ;
  1. ; BASED ON ENTRY IN FIELD 401 HOLD DHRS FOR NEW FY
  1. ; IN THE FMS SYSTEM DEFAULTS FILE
  1. ;
  1. N ACRDOCDA
  1. I '$P($G(^ACRSYS(1,401)),U) Q 0
  1. I ACRFY,ACRFY=$P($G(^ACRSYS(1,401)),U) Q 1
  1. I ACR3="050",ACRFY=$P($G(^ACRSYS(1,401)),U) Q 1
  1. I "^181^182^191^192^061^242^"[(U_ACR3_U) D
  1. . I $G(ACRFYDA),$G(ACRBATDA),$G(ACRSEQDA) D ;ACR*2.1*3.15
  1. . . S ACRDOCDA=$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,"ARMS")),U) ;ACR*2.1*3.15
  1. I $G(ACRDOCDA),$$DOCFY(ACRDOCDA)=$P($G(^ACRSYS(1,401)),U) Q 1
  1. Q 0
  1. DOCFY(ACRDOCDA) ;
  1. ;----- RETURNS FY OF FUNDS FOR ARMS DOCUMENT
  1. ;
  1. S Y=""
  1. S Y=$P($G(^ACRDOC(ACRDOCDA,0)),U,6)
  1. I Y S Y=$P($G(^ACRLOCB(Y,"DT")),U)
  1. Q Y