ACRFEXP3 ;IHS/OIRM/DSD/AEF - EXPORT TO DHR FILE [ 10/4/2005 3:57 PM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,16,19**;NOV 05, 2001
;
;
;This routine processes payments from the 1166 Approvals
;for Payment file and places them into the DHR Data Records
;file for further processing and subsequent transmission to
;CORE.
;
;It is expected that the global ^TMP("ACR",$J,"DHR") would have
;been built by routine ^ACRFEXP2 and will contain the payments
;to be placed into the DHR Data Records file.
;
DHR ;EP -- MAIN ENTRY POINT
;
Q:'$P($G(^ACRSYS(1,"DT1")),U,9)
;
Q:'$D(^TMP("ACR",$J,"DHR"))
;
D LOOP
;
Q
LOOP ;----- LOOP THROUGH ^TMP("ACR",$J,"DHR") GLOBAL AND PUT
; PAYMENT DATA INTO DHR DATA RECORDS FILE
;
N ACRD0,ACRD1,ACRD2,ACRPMT,ACRVEND
S ACRVEND=""
F S ACRVEND=$O(^TMP("ACR",$J,"DHR",ACRVEND)) Q:ACRVEND']"" D
. S ACRPMT=0
. F S ACRPMT=$O(^TMP("ACR",$J,"DHR",ACRVEND,ACRPMT)) Q:'ACRPMT D
. . S ACRDATA=^TMP("ACR",$J,"DHR",ACRVEND,ACRPMT,0)
. . S ACRD0=$P(ACRDATA,U,3)
. . S ACRD1=$P(ACRDATA,U,4)
. . S ACRD2=$P(ACRDATA,U,5)
. . D ONE(ACRD0,ACRD1,ACRD2)
Q
ONE(ACRD0,ACRD1,ACRD2) ;
;----- PROCESS ONE PAYMENT
;
; INPUT:
; ACRD0 = FY IEN IN 1166 APPROVALS FOR PAYMENT FILE
; ACRD1 = BATCH IEN
; ACRD2 = SEQ IEN
;
N ACRDATA,ACROCC,Z
;Q:$P($G(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,"ARMS")),U,2) ;ACR*2.1*16.06 IM15505
S ACRDATA=$G(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,"ARMS")) ;ACR*2.1*16.06 IM15505
Q:$P(ACRDATA,U,2) ;ACR*2.1*16.06 IM15505
S ACRDOCDA=$P(ACRDATA,U) ;ACR*2.1*16.06 IM15505
S ACRDOC0="" ;ACR*2.1*16.06 IM15505
S:ACRDOCDA]"" ACRDOC0=$G(^ACRDOC(ACRDOCDA,0)) ;ACR*2.1*16.06 IM15505
D SET(ACRD0,ACRD1,ACRD2,.Z)
S ACRDATA=$G(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,0)) ;ACR*2.1*16.06 IM15505
S ACRIV="PAY"
S:$P(ACRDATA,U,18)="05025" ACRIV="" ;DISCOUNT;ACR*2.1*16.06 IM15505
;D DHRRCD(Z) ;ACR*2.1*16.06 IM15505
D DHRRCD(Z,ACRIV) ;ACR*2.1*16.06 IM15505
;S ACRDATA=$G(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,0)) ;ACR*2.1*16.06 IM15505
I +$P(ACRDATA,U,12),$P(ACRDATA,U,24) D
. Q:$P(ACRDATA,U,18)="06119"
. S ACROCC=$P(ACRDATA,U,8)
. I ACROCC S ACROCC=$P($G(^AUTTOBJC(ACROCC,0)),U)
. Q:ACROCC="219M"
. Q:$P(ACRDATA,U,6)'=600
. ;D LTA(ACRD0,ACRD1,ACRD2,.Z) ;ACR*2.1*3.06
. N ACRDAT ;ACR*2.1*3.06
. D LTA(ACRD0,ACRD1,ACRD2,.Z,.ACRDAT) ;ACR*2.1*3.06
. D DHR2^ACRFPAY2(ACRD0,ACRD1,ACRD2,ACRDAT) ;ACR*2.1*3.06
.;D DHRRCD(Z) ;ACR*2.1*16.06 IM15505
. D DHRRCD(Z,"PAY") ;ACR*2.1*16.06 IM15505
D UPDATE(ACRD0,ACRD1,ACRD2)
Q
SET(ACRD0,ACRD1,ACRD2,Z) ;
;----- SET DHR INFORMATION INTO VARIABLE Z
;
; INPUT:
; ACRD0 = FY IEN OF 1166 APPROVALS FOR PAYMENT FILE
; ACRD1 = BATCH IEN OF 1166 APPROVALS FOR PAYMENT FILE
; ACRD2 = SEQUENCE IEN OF 1166 APPROVALS FOR PAYMENT FILE
;
; RETURNS:
; Z = DHR DATA STRING
;
N ACRAMT,ACRBTYP,ACRCAN,ACROBJ,ACRSEQ0,ACRSEQ1,ACRSEQ3,ACRSSN
D ^XBKVAR
S ACRBTYP=$P($G(^AFSLAFP(ACRD0,1,ACRD1,0)),U,4)
S ACRSEQ0=$G(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,0))
S ACRSEQ1=$G(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,1))
S ACRSEQ3=$G(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,3))
S ACRCAN=$P(ACRSEQ0,U,7)
I ACRCAN S ACRCAN=$P($G(^AUTTCAN(ACRCAN,0)),U)
S ACROBJ=$P(ACRSEQ0,U,8)
I ACROBJ S ACROBJ=$P($G(^AUTTOBJC(ACROBJ,0)),U)
S ACRAMT=$P(ACRSEQ0,U,11)
S ACRAMT=$TR(ACRAMT,".","")
S ACRSSN=""
I ACRBTYP="V" D
. S ACRSSN=$P(ACRSEQ0,U,10)
. S ACRSSN=$P($G(^AUTTVNDR(ACRSSN,11)),U,13)
I ACRBTYP="T" D
. S ACRSSN=$P(ACRSEQ0,U,24)
. S ACRSSN=$P($G(^VA(200,ACRSSN,1)),U,9)
;
S Z=""
S $E(Z)=2
S $E(Z,2,7)=$E(DT,4,7)_$E(DT,2,3)
S $E(Z,8,12)=$$PAD^ACRFUTL($P(ACRSEQ0,U,18),"R",5,"")
S $E(Z,13,15)=$$PAD^ACRFUTL($P(ACRSEQ0,U,5),"R",3,"")
S $E(Z,16,25)=$$PAD^ACRFUTL($P(ACRSEQ0,U,20),"R",10,"")
S $E(Z,26,28)=$$PAD^ACRFUTL($P(ACRSEQ0,U,6),"R",3,"")
S $E(Z,29,38)=$$PAD^ACRFUTL($P(ACRSEQ0,U,21),"R",10,"")
S $E(Z,39)=1
S $E(Z,40)=$$PAD^ACRFUTL($P(ACRSEQ0,U,2),"R",1,"")
S $E(Z,41,47)=$$PAD^ACRFUTL($G(ACRCAN),"R",7,"")
S $E(Z,48,51)=$$PAD^ACRFUTL($G(ACROBJ),"R",4,"")
S $E(Z,52,63)=$$PAD^ACRFUTL(ACRAMT,"L",12,0)
S $E(Z,64)=1
S $E(Z,65,79)=$$PAD^ACRFUTL($G(ACRSSN),"R",15,"")
S $E(Z,80,94)=$$PAD^ACRFUTL("","R",15,"")
S $E(Z,95,104)=$$PAD^ACRFUTL($P(ACRSEQ1,U,11),"R",10,"")
S $E(Z,105,106)=$$PAD^ACRFUTL("","R",2,"")
S $E(Z,107,108)=$$PAD^ACRFUTL("","R",2,"")
S $E(Z,109)=$$PAD^ACRFUTL("","R",1,"")
S $E(Z,110,111)=$$PAD^ACRFUTL("","R",2,"")
S $E(Z,112,115)=$$PAD^ACRFUTL("","R",4,"")
S $E(Z,116,119)=$$PAD^ACRFUTL("","R",4,"")
S $E(Z,120,125)=$$PAD^ACRFUTL("","R",6,"")
S $E(Z,126,129)=$$PAD^ACRFUTL($P(ACRSEQ3,U),"R",4,"")
S $E(Z,130,133)=$$PAD^ACRFUTL($P(ACRSEQ3,U,2),"R",4,"")
S $E(Z,134,135)=$$PAD^ACRFUTL($P(ACRSEQ3,U,3),"R",2,"")
S $E(Z,136)=$$PAD^ACRFUTL("","R",1,"")
S $E(Z,137,140)=$$PAD^ACRFUTL("","R",4,"")
S $E(Z,141,160)=$$PAD^ACRFUTL(0,"R",20,0)
Q
LTA(ACRD0,ACRD1,ACRD2,Z,ACRDAT) ; ACR*2.1*3.06
;----- LIQUIDATE TRAVEL ADVANCE, SET LTA DHR DATA INTO VARIABLE Z
; IF PAYMENT IS FOR TRAVEL VOUCHER WITH TRAVEL ADVANCE AMOUNT,
; CREATE SECOND DHR TO LIQUIDATE THE TRAVEL ADVANCE
;
; INPUT:
; ACRD0 = FY IEN IN 1166 APPROVALS FOR PAYMENT FILE
; ACRD1 = BATCH IEN IN 1166 APPROVALS FOR PAYMENT FILE
; ACRD2 = SEQUENCE IEN OF 1166 APPROVALS FOR PAYMENT FILE
; Z = DHR DATA STRING FOR ORIGINAL DHR
; ACRDAT = NULL
;
; RETURNS:
; Z = DHR DATA STRING CONTAINING TRAVEL ADVANCE LIQUIDATION
; ACRDAT = MODIFIED STRING REPRESENTING THE ZERO NODE
;
N ACRAMT,ACRNAME
S ACRDAT=$G(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,0))
S ACRAMT=$P(ACRDAT,U,12)
S ACRAMT=$$DOL^ACRFUTL(ACRAMT)
S ACRAMT=$TR(ACRAMT,".","")
S ACRNAME=$P(ACRDAT,U,24)
;S ACRNAME=$P($G(^VA(200,ACRNAME,0)),U) ;ACR*2.1*19.02 IM16848
;S ACRNAME=$P(ACRNAME,",")_" "_$E($P(ACRNAME,",",2)) ;ACR*2.1*19.02 IM16848
S ACRNAME=$$NAME3^ACRFUTL1(ACRNAME) ;ACR*2.1*19.02 IM16848
;
S ($P(ACRDAT,U,18),$E(Z,8,12))="24219"
S ($P(ACRDAT,U,6),$E(Z,26,28))="602"
S ($P(ACRDAT,U,11),$E(Z,52,63))=$$PAD^ACRFUTL(ACRAMT,"L",12,0)
S $P(ACRDAT,U,12)=""
S ($P(ACRDAT,U,24),$E(Z,80,94))=$$PAD^ACRFUTL(ACRNAME,"R",15,"")
Q
DHRRCD(Z,ACRIV) ; ;ACR*2.1*16.06 IM15505
;----- INTERFACE TO DHRRCD^ACRFDHR1 ROUTINE
; SETS UP VARIABLES NEEDED TO CALL DHRRCD^ACRFDHR1 ROUTINE
; TO PUT DHR RECORDS INTO DHR DATA RECORDS FILE
;
; INPUT:
; Z = DHR DATA STRING
; ACRIV = OBLIGATION/PAYMENT INDICATOR ;ACR*2.1*16.06 IM15505
;
; ACR3 = TRANSACTION CODE
; ACRACPT = ACCOUNTING POINT
; ACRDHR = DHR DATA STRING
; ACRREF = ORIGINAL DOCUMENT REFERENCE CODE
;
;N ACR3,ACRACPT,ACRDHR,ACRIV,ACRREF ;ACR*2.1*16.06 IM15505
N ACR3,ACRACPT,ACRDHR,ACRREF ;ACR*2.1*16.06 IM15505
S ACR3=$E(Z,8,10)
S ACRACPT=$E(Z,42,43)
S ACRREF=$E(Z,13,15)
;S ACRIV="PAY" ;ACR*2.1*16.06 IM15505
S ACRDHR=$$UPPER^ACRFUTL(Z)
D DHRRCD^ACRFDHR1
Q
UPDATE(ACRD0,ACRD1,ACRD2) ;
;----- UPDATE ARMS DHR FILED FIELD
;
N DA,DIE,DR,X,Y
S DA(2)=ACRD0
S DA(1)=ACRD1
S DA=ACRD2
S DIE="^AFSLAFP("_DA(2)_",1,"_DA(1)_",1,"
S DR=".03////1"
D ^DIE
Q
ACRFEXP3 ;IHS/OIRM/DSD/AEF - EXPORT TO DHR FILE [ 10/4/2005 3:57 PM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,16,19**;NOV 05, 2001
+2 ;
+3 ;
+4 ;This routine processes payments from the 1166 Approvals
+5 ;for Payment file and places them into the DHR Data Records
+6 ;file for further processing and subsequent transmission to
+7 ;CORE.
+8 ;
+9 ;It is expected that the global ^TMP("ACR",$J,"DHR") would have
+10 ;been built by routine ^ACRFEXP2 and will contain the payments
+11 ;to be placed into the DHR Data Records file.
+12 ;
DHR ;EP -- MAIN ENTRY POINT
+1 ;
+2 IF '$PIECE($GET(^ACRSYS(1,"DT1")),U,9)
QUIT
+3 ;
+4 IF '$DATA(^TMP("ACR",$JOB,"DHR"))
QUIT
+5 ;
+6 DO LOOP
+7 ;
+8 QUIT
LOOP ;----- LOOP THROUGH ^TMP("ACR",$J,"DHR") GLOBAL AND PUT
+1 ; PAYMENT DATA INTO DHR DATA RECORDS FILE
+2 ;
+3 NEW ACRD0,ACRD1,ACRD2,ACRPMT,ACRVEND
+4 SET ACRVEND=""
+5 FOR
SET ACRVEND=$ORDER(^TMP("ACR",$JOB,"DHR",ACRVEND))
IF ACRVEND']""
QUIT
Begin DoDot:1
+6 SET ACRPMT=0
+7 FOR
SET ACRPMT=$ORDER(^TMP("ACR",$JOB,"DHR",ACRVEND,ACRPMT))
IF 'ACRPMT
QUIT
Begin DoDot:2
+8 SET ACRDATA=^TMP("ACR",$JOB,"DHR",ACRVEND,ACRPMT,0)
+9 SET ACRD0=$PIECE(ACRDATA,U,3)
+10 SET ACRD1=$PIECE(ACRDATA,U,4)
+11 SET ACRD2=$PIECE(ACRDATA,U,5)
+12 DO ONE(ACRD0,ACRD1,ACRD2)
End DoDot:2
End DoDot:1
+13 QUIT
ONE(ACRD0,ACRD1,ACRD2) ;
+1 ;----- PROCESS ONE PAYMENT
+2 ;
+3 ; INPUT:
+4 ; ACRD0 = FY IEN IN 1166 APPROVALS FOR PAYMENT FILE
+5 ; ACRD1 = BATCH IEN
+6 ; ACRD2 = SEQ IEN
+7 ;
+8 NEW ACRDATA,ACROCC,Z
+9 ;Q:$P($G(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,"ARMS")),U,2) ;ACR*2.1*16.06 IM15505
+10 ;ACR*2.1*16.06 IM15505
SET ACRDATA=$GET(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,"ARMS"))
+11 ;ACR*2.1*16.06 IM15505
IF $PIECE(ACRDATA,U,2)
QUIT
+12 ;ACR*2.1*16.06 IM15505
SET ACRDOCDA=$PIECE(ACRDATA,U)
+13 ;ACR*2.1*16.06 IM15505
SET ACRDOC0=""
+14 ;ACR*2.1*16.06 IM15505
IF ACRDOCDA]""
SET ACRDOC0=$GET(^ACRDOC(ACRDOCDA,0))
+15 DO SET(ACRD0,ACRD1,ACRD2,.Z)
+16 ;ACR*2.1*16.06 IM15505
SET ACRDATA=$GET(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,0))
+17 SET ACRIV="PAY"
+18 ;DISCOUNT;ACR*2.1*16.06 IM15505
IF $PIECE(ACRDATA,U,18)="05025"
SET ACRIV=""
+19 ;D DHRRCD(Z) ;ACR*2.1*16.06 IM15505
+20 ;ACR*2.1*16.06 IM15505
DO DHRRCD(Z,ACRIV)
+21 ;S ACRDATA=$G(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,0)) ;ACR*2.1*16.06 IM15505
+22 IF +$PIECE(ACRDATA,U,12)
IF $PIECE(ACRDATA,U,24)
Begin DoDot:1
+23 IF $PIECE(ACRDATA,U,18)="06119"
QUIT
+24 SET ACROCC=$PIECE(ACRDATA,U,8)
+25 IF ACROCC
SET ACROCC=$PIECE($GET(^AUTTOBJC(ACROCC,0)),U)
+26 IF ACROCC="219M"
QUIT
+27 IF $PIECE(ACRDATA,U,6)'=600
QUIT
+28 ;D LTA(ACRD0,ACRD1,ACRD2,.Z) ;ACR*2.1*3.06
+29 ;ACR*2.1*3.06
NEW ACRDAT
+30 ;ACR*2.1*3.06
DO LTA(ACRD0,ACRD1,ACRD2,.Z,.ACRDAT)
+31 ;ACR*2.1*3.06
DO DHR2^ACRFPAY2(ACRD0,ACRD1,ACRD2,ACRDAT)
+32 ;D DHRRCD(Z) ;ACR*2.1*16.06 IM15505
+33 ;ACR*2.1*16.06 IM15505
DO DHRRCD(Z,"PAY")
End DoDot:1
+34 DO UPDATE(ACRD0,ACRD1,ACRD2)
+35 QUIT
SET(ACRD0,ACRD1,ACRD2,Z) ;
+1 ;----- SET DHR INFORMATION INTO VARIABLE Z
+2 ;
+3 ; INPUT:
+4 ; ACRD0 = FY IEN OF 1166 APPROVALS FOR PAYMENT FILE
+5 ; ACRD1 = BATCH IEN OF 1166 APPROVALS FOR PAYMENT FILE
+6 ; ACRD2 = SEQUENCE IEN OF 1166 APPROVALS FOR PAYMENT FILE
+7 ;
+8 ; RETURNS:
+9 ; Z = DHR DATA STRING
+10 ;
+11 NEW ACRAMT,ACRBTYP,ACRCAN,ACROBJ,ACRSEQ0,ACRSEQ1,ACRSEQ3,ACRSSN
+12 DO ^XBKVAR
+13 SET ACRBTYP=$PIECE($GET(^AFSLAFP(ACRD0,1,ACRD1,0)),U,4)
+14 SET ACRSEQ0=$GET(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,0))
+15 SET ACRSEQ1=$GET(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,1))
+16 SET ACRSEQ3=$GET(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,3))
+17 SET ACRCAN=$PIECE(ACRSEQ0,U,7)
+18 IF ACRCAN
SET ACRCAN=$PIECE($GET(^AUTTCAN(ACRCAN,0)),U)
+19 SET ACROBJ=$PIECE(ACRSEQ0,U,8)
+20 IF ACROBJ
SET ACROBJ=$PIECE($GET(^AUTTOBJC(ACROBJ,0)),U)
+21 SET ACRAMT=$PIECE(ACRSEQ0,U,11)
+22 SET ACRAMT=$TRANSLATE(ACRAMT,".","")
+23 SET ACRSSN=""
+24 IF ACRBTYP="V"
Begin DoDot:1
+25 SET ACRSSN=$PIECE(ACRSEQ0,U,10)
+26 SET ACRSSN=$PIECE($GET(^AUTTVNDR(ACRSSN,11)),U,13)
End DoDot:1
+27 IF ACRBTYP="T"
Begin DoDot:1
+28 SET ACRSSN=$PIECE(ACRSEQ0,U,24)
+29 SET ACRSSN=$PIECE($GET(^VA(200,ACRSSN,1)),U,9)
End DoDot:1
+30 ;
+31 SET Z=""
+32 SET $EXTRACT(Z)=2
+33 SET $EXTRACT(Z,2,7)=$EXTRACT(DT,4,7)_$EXTRACT(DT,2,3)
+34 SET $EXTRACT(Z,8,12)=$$PAD^ACRFUTL($PIECE(ACRSEQ0,U,18),"R",5,"")
+35 SET $EXTRACT(Z,13,15)=$$PAD^ACRFUTL($PIECE(ACRSEQ0,U,5),"R",3,"")
+36 SET $EXTRACT(Z,16,25)=$$PAD^ACRFUTL($PIECE(ACRSEQ0,U,20),"R",10,"")
+37 SET $EXTRACT(Z,26,28)=$$PAD^ACRFUTL($PIECE(ACRSEQ0,U,6),"R",3,"")
+38 SET $EXTRACT(Z,29,38)=$$PAD^ACRFUTL($PIECE(ACRSEQ0,U,21),"R",10,"")
+39 SET $EXTRACT(Z,39)=1
+40 SET $EXTRACT(Z,40)=$$PAD^ACRFUTL($PIECE(ACRSEQ0,U,2),"R",1,"")
+41 SET $EXTRACT(Z,41,47)=$$PAD^ACRFUTL($GET(ACRCAN),"R",7,"")
+42 SET $EXTRACT(Z,48,51)=$$PAD^ACRFUTL($GET(ACROBJ),"R",4,"")
+43 SET $EXTRACT(Z,52,63)=$$PAD^ACRFUTL(ACRAMT,"L",12,0)
+44 SET $EXTRACT(Z,64)=1
+45 SET $EXTRACT(Z,65,79)=$$PAD^ACRFUTL($GET(ACRSSN),"R",15,"")
+46 SET $EXTRACT(Z,80,94)=$$PAD^ACRFUTL("","R",15,"")
+47 SET $EXTRACT(Z,95,104)=$$PAD^ACRFUTL($PIECE(ACRSEQ1,U,11),"R",10,"")
+48 SET $EXTRACT(Z,105,106)=$$PAD^ACRFUTL("","R",2,"")
+49 SET $EXTRACT(Z,107,108)=$$PAD^ACRFUTL("","R",2,"")
+50 SET $EXTRACT(Z,109)=$$PAD^ACRFUTL("","R",1,"")
+51 SET $EXTRACT(Z,110,111)=$$PAD^ACRFUTL("","R",2,"")
+52 SET $EXTRACT(Z,112,115)=$$PAD^ACRFUTL("","R",4,"")
+53 SET $EXTRACT(Z,116,119)=$$PAD^ACRFUTL("","R",4,"")
+54 SET $EXTRACT(Z,120,125)=$$PAD^ACRFUTL("","R",6,"")
+55 SET $EXTRACT(Z,126,129)=$$PAD^ACRFUTL($PIECE(ACRSEQ3,U),"R",4,"")
+56 SET $EXTRACT(Z,130,133)=$$PAD^ACRFUTL($PIECE(ACRSEQ3,U,2),"R",4,"")
+57 SET $EXTRACT(Z,134,135)=$$PAD^ACRFUTL($PIECE(ACRSEQ3,U,3),"R",2,"")
+58 SET $EXTRACT(Z,136)=$$PAD^ACRFUTL("","R",1,"")
+59 SET $EXTRACT(Z,137,140)=$$PAD^ACRFUTL("","R",4,"")
+60 SET $EXTRACT(Z,141,160)=$$PAD^ACRFUTL(0,"R",20,0)
+61 QUIT
LTA(ACRD0,ACRD1,ACRD2,Z,ACRDAT) ; ACR*2.1*3.06
+1 ;----- LIQUIDATE TRAVEL ADVANCE, SET LTA DHR DATA INTO VARIABLE Z
+2 ; IF PAYMENT IS FOR TRAVEL VOUCHER WITH TRAVEL ADVANCE AMOUNT,
+3 ; CREATE SECOND DHR TO LIQUIDATE THE TRAVEL ADVANCE
+4 ;
+5 ; INPUT:
+6 ; ACRD0 = FY IEN IN 1166 APPROVALS FOR PAYMENT FILE
+7 ; ACRD1 = BATCH IEN IN 1166 APPROVALS FOR PAYMENT FILE
+8 ; ACRD2 = SEQUENCE IEN OF 1166 APPROVALS FOR PAYMENT FILE
+9 ; Z = DHR DATA STRING FOR ORIGINAL DHR
+10 ; ACRDAT = NULL
+11 ;
+12 ; RETURNS:
+13 ; Z = DHR DATA STRING CONTAINING TRAVEL ADVANCE LIQUIDATION
+14 ; ACRDAT = MODIFIED STRING REPRESENTING THE ZERO NODE
+15 ;
+16 NEW ACRAMT,ACRNAME
+17 SET ACRDAT=$GET(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,0))
+18 SET ACRAMT=$PIECE(ACRDAT,U,12)
+19 SET ACRAMT=$$DOL^ACRFUTL(ACRAMT)
+20 SET ACRAMT=$TRANSLATE(ACRAMT,".","")
+21 SET ACRNAME=$PIECE(ACRDAT,U,24)
+22 ;S ACRNAME=$P($G(^VA(200,ACRNAME,0)),U) ;ACR*2.1*19.02 IM16848
+23 ;S ACRNAME=$P(ACRNAME,",")_" "_$E($P(ACRNAME,",",2)) ;ACR*2.1*19.02 IM16848
+24 ;ACR*2.1*19.02 IM16848
SET ACRNAME=$$NAME3^ACRFUTL1(ACRNAME)
+25 ;
+26 SET ($PIECE(ACRDAT,U,18),$EXTRACT(Z,8,12))="24219"
+27 SET ($PIECE(ACRDAT,U,6),$EXTRACT(Z,26,28))="602"
+28 SET ($PIECE(ACRDAT,U,11),$EXTRACT(Z,52,63))=$$PAD^ACRFUTL(ACRAMT,"L",12,0)
+29 SET $PIECE(ACRDAT,U,12)=""
+30 SET ($PIECE(ACRDAT,U,24),$EXTRACT(Z,80,94))=$$PAD^ACRFUTL(ACRNAME,"R",15,"")
+31 QUIT
DHRRCD(Z,ACRIV) ; ;ACR*2.1*16.06 IM15505
+1 ;----- INTERFACE TO DHRRCD^ACRFDHR1 ROUTINE
+2 ; SETS UP VARIABLES NEEDED TO CALL DHRRCD^ACRFDHR1 ROUTINE
+3 ; TO PUT DHR RECORDS INTO DHR DATA RECORDS FILE
+4 ;
+5 ; INPUT:
+6 ; Z = DHR DATA STRING
+7 ; ACRIV = OBLIGATION/PAYMENT INDICATOR ;ACR*2.1*16.06 IM15505
+8 ;
+9 ; ACR3 = TRANSACTION CODE
+10 ; ACRACPT = ACCOUNTING POINT
+11 ; ACRDHR = DHR DATA STRING
+12 ; ACRREF = ORIGINAL DOCUMENT REFERENCE CODE
+13 ;
+14 ;N ACR3,ACRACPT,ACRDHR,ACRIV,ACRREF ;ACR*2.1*16.06 IM15505
+15 ;ACR*2.1*16.06 IM15505
NEW ACR3,ACRACPT,ACRDHR,ACRREF
+16 SET ACR3=$EXTRACT(Z,8,10)
+17 SET ACRACPT=$EXTRACT(Z,42,43)
+18 SET ACRREF=$EXTRACT(Z,13,15)
+19 ;S ACRIV="PAY" ;ACR*2.1*16.06 IM15505
+20 SET ACRDHR=$$UPPER^ACRFUTL(Z)
+21 DO DHRRCD^ACRFDHR1
+22 QUIT
UPDATE(ACRD0,ACRD1,ACRD2) ;
+1 ;----- UPDATE ARMS DHR FILED FIELD
+2 ;
+3 NEW DA,DIE,DR,X,Y
+4 SET DA(2)=ACRD0
+5 SET DA(1)=ACRD1
+6 SET DA=ACRD2
+7 SET DIE="^AFSLAFP("_DA(2)_",1,"_DA(1)_",1,"
+8 SET DR=".03////1"
+9 DO ^DIE
+10 QUIT
