ACRFODOC ;IHS/OIRM/DSD/AEF - OPEN DOCUMENT FILE INTERFACE [ 07/24/2002 3:26 PM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**3**;NOV 05, 2001
;
EN(ACRDOCDA,ACR1,ACR2) ;EP
;----- MAIN ENTRY POINT
;
; CALLED BY CREATE^ACRFDHR
;
; ACRDOCDA = FMS DOCUMENT IEN
; ACR1 = STRING CONTAINING DATA:
; DOCUMENT TYPE^TRANSACTION CODE^REVERSE CODE^
; MODIFIER CODE^DOCUMENT REFERENCE CODE^CAN NUMBER^
; OBJECT CLASS CODE^AMOUNT^FED/NON FED CODE^
; PID (VENDOR IEN OR TRAVELER SSN)^DOCUMENT NUMBER
; ACR2 = STRING CONTAINING DATA:
; PAYMENT DATE^AFP BATCH^TREAS SCHED NO^AFP BATCH SEQ
;
D ^XBKVAR
I $P(ACR1,U,2)="050" D OBL(ACRDOCDA,ACR1)
Q
;
OBL(ACRDOCDA,ACR) ;EP
;----- ENTER/EDIT OBLIGATION IN OPEN DOCUMENT FILE
;
; ACR = STRING CONTAINING DATA:
; TYPE^TRNCD^REVCD^MODCD^REF^CAN^OCC^AMT^FED^PID^DOCNO
; ACRDOC0 = ZERO NODE OF FMS DOCUMENT FILE
; ACRFY = FISCAL YEAR OF FUNDS
; ACRDEPT = DEPARTMENT ACCOUNT
; ACRALW = ALLOWANCE NUMBER
; ACRAPP = APPROPRIATION NUMBER
; ACRLOC = LOCATION CODE
; ACRSSA = SUB-SUB-ACTIVITY
; ACRIMN = IMN NUMBER
;
N ACRALW,ACRAPP,ACRDEPT,ACRDOC0,ACRFY,ACRIMN,ACRLOC,ACRSSA,DATA,DATA1,DATA2,DATA3
D ^XBKVAR
S ACRDOC0=$G(^ACRDOC(ACRDOCDA,0))
S ACRDEPT=$P($G(ACRDOC0),U,6)
I ACRDEPT D
. S DATA=$G(^ACRLOCB(ACRDEPT,"DT"))
. S ACRFY=$P(DATA,U)
. Q:'ACRFY
. S ACRALW=$P(DATA,U,5)
. I ACRALW S ACRALW=$P($G(^AUTTALLW(ACRALW,0)),U)
. S ACRLOC=$P(DATA,U,11)
. I ACRLOC S ACRLOC=$P($G(^AUTTLCOD(ACRLOC,0)),U)
. S ACRSSA=$P(DATA,U,8)
. I ACRSSA S ACRSSA=$P($G(^AUTTSSA(ACRSSA,0)),U)
. S ACRAPP=$P(DATA,U,4)
. I ACRAPP D
. . S DATA=$G(^AUTTPRO(ACRAPP,0))
. . S ACRAPP=$P(DATA,U)
. . S ACRIMN=$P(DATA,U,3)
K DATA
Q:'ACRFY
S DATA1=U_$P(ACR,U,6)_U_$P(ACR,U,7)_U_$P(ACR,U,9)_U_$P(ACR,U)_U_$P(ACR,U,10)_U_U_DT_U_$P(ACR,U,8)
S DATA2=$P(ACR,U,5)_U_U_U_U_DT_U_$P(ACR,U,2)_$P(ACR,U,3)_$P(ACR,U,4)_U_$P(ACR,U,8)_U_U_ACRFY_U_ACRALW_U_ACRAPP_U_ACRLOC_U_ACRSSA_U_DT
S DATA3=DT_U_DT_U_ACRIMN
D AFY(ACRFY,.Y)
S ACRD0=+Y
D DOC(ACRD0,DATA1,DATA2,DATA3,$P(ACR,U,11))
;
Q
DOC(ACRD0,DATA1,DATA2,DATA3,X) ;EP
;----- ADD/EDIT OPEN DOCUMENT FILE ENTRY
;
; ACRD0 = FISCAL YEAR IEN
; ACRD1 = DOCUMENT SUBFILE IEN
; X = EXTERNAL DOCUMENT NUMBER
; DATA1-DATA3 = STRINGS CONTAINING DATA (SEE EDOC)
;
N ACRD1,Y
Q:X']""
D LDOC(ACRD0,X,.Y)
I +Y'>0 D ADOC(ACRD0,X,.Y)
Q:+Y'>0
S ACRD1=+Y
D EDOC(ACRD0,ACRD1,DATA1,DATA2,DATA3)
Q
PAY(ACRD0,DATA,X) ;EP
;----- ADD/EDIT OPEN DOCUMENT PAYMENT ENTRY
;
; ACRD0 = FISCAL YEAR IEN
; X = EXTERNAL DOCUMENT NUMBER
; DATA = STRING CONTAINING DATA (SEE PDOC)
;
N ACRD1,ACRD2,Y
D APMT(ACRD0,.ACRD1,X,.Y)
Q:Y'>0
S ACRD2=+Y
D EPMT(ACRD0,ACRD1,ACRD2,DATA)
Q
LDOC(ACRD0,X,Y) ;EP
;----- LOOKUP DOCUMENT ENTRY
;
; ACRD0 = FISCAL YEAR IEN
; X = EXTERNAL DOCUMENT NUMBER
; Y = INTERNAL DOCUMENT ENTRY IEN (-1 IF NOT FOUND) (RETURNED)
;
N DIC
S DIC="^AFSLODOC("_ACRD0_",1,"
S DIC(0)=""
D ^DIC
Q
ADOC(ACRD0,X,Y) ;EP
;----- ADD NEW DOCUMENT ENTRY
;
; ACRD0 = FISCAL YEAR IEN
; X = EXTERNAL DOCUMENT NUMBER
; Y = INTERNAL DOCUMENT ENTRY IEN (RETURNED)
;
N DA,DD,DIC,DO
S DA(1)=ACRD0
S DLAYGO=9002325.3
S DIC="^AFSLODOC("_DA(1)_",1,"
S DIC(0)="L"
S DIC("P")=$P(^DD(9002325.3,1,0),U,2)
K DD,DO
D FILE^DICN
Q
EDOC(ACRD0,ACRD1,DATA1,DATA2,DATA3) ;EP
;----- EDIT DOCUMENT DATA
;
; ACRD0 = FISCAL YEAR IEN
; ACRD1 = DOCUMENT NUMBER SUBFILE IEN
; DATA1 = STRING CONTAINING DATA:
; DOCUMENT SFX^CAN^SUB-OBJ CLASS^FED-NON FED^DOC TYPE^
; PID^PID-SUFFIX^OBLIGATION DATE^OBLIGATION AMT^CLOSED
; FLAG
; DATA2 = STRING CONTAINING DATA:
; DOCUMENT REF^DOWNLOAD ENTRY^VND-POINTER^LINKED
; DOCUMENT^DATE OF LAST TRANSACTION^LAST TRANSACTION
; CODE^LAST TRANSACTION AMOUNT^BATCH NAME^FY OF FUNDS^
; ALLOWANCE^APPROPRIATION^LOCATION^SSA^OBLIGATION POSTED^
; DATA3 = STRING CONTAINING DATA:
; OBLIG CREATE DATE^LAST ACTIVITY DATE^IMN
;
N AMT,BAL,CODE,DA,DIE,DR,X
S AMT=$P(DATA1,U,9)
S CODE=$P(DATA2,U,6)
S CODE=$E(CODE,4)
I CODE=2 S AMT=(0-AMT)
Q:'$D(^AFSLODOC(ACRD0,1,ACRD1))
S DA(1)=ACRD0
S DA=ACRD1
S X=""
I $P(DATA1,U)]"" S X=X_"1////"_$P(DATA1,U)
I $P(DATA1,U,2)]"" S X=X_";2////"_$P(DATA1,U,2)
I $P(DATA1,U,3)]"" S X=X_";3////"_$P(DATA1,U,3)
I $P(DATA1,U,4)]"" S X=X_";4////"_$P(DATA1,U,4)
I $P(DATA1,U,5)]"" S X=X_";5////"_$P(DATA1,U,5)
I $P(DATA1,U,6)]"" S X=X_";6////"_$P(DATA1,U,6)
I $P(DATA1,U,7)]"" S X=X_";7////"_$P(DATA1,U,7)
I $P(DATA1,U,8)]"" S X=X_";8////"_$P(DATA1,U,8)
;I $P(DATA1,U,9)]"" S X=X_";9////"_$P(DATA1,U,9)
I AMT]"",'+$P($G(^AFSLODOC(ACRD0,1,ACRD1,0)),U,10) S X=X_";9////"_AMT
F Q:$E(X)'=";" S X=$E(X,2,9999)
I X]"" S DR=X
S X=""
I $P(DATA2,U)]"" S X=X_"12////"_$P(DATA2,U)
I $P(DATA2,U,2)]"" S X=X_";14////"_$P(DATA2,U,2)
I $P(DATA2,U,3)]"" S X=X_";15////"_$P(DATA2,U,3)
I $P(DATA2,U,4)]"" S X=X_";16////"_$P(DATA2,U,4)
I $P(DATA2,U,5)]"" S X=X_";17////"_$P(DATA2,U,5)
I $P(DATA2,U,6)]"" S X=X_";18////"_$P(DATA2,U,6)
I $P(DATA2,U,7)]"" S X=X_";19////"_$P(DATA2,U,7)
I $P(DATA2,U,8)]"" S X=X_";20////"_$P(DATA2,U,8)
I $P(DATA2,U,9)]"" S X=X_";21////"_$P(DATA2,U,9)
I $P(DATA2,U,10)]"" S X=X_";22////"_$P(DATA2,U,10)
I $P(DATA2,U,11)]"" S X=X_";23////"_$P(DATA2,U,11)
I $P(DATA2,U,12)]"" S X=X_";24////"_$P(DATA2,U,12)
I $P(DATA2,U,13)]"" S X=X_";25////"_$P(DATA2,U,13)
I $P(DATA2,U,14)]"" S X=X_";26////"_$P(DATA2,U,14)
F Q:$E(X)'=";" S X=$E(X,2,9999)
I X]"" S DR(1,9002325.31,1)=X
S X=""
I $P(DATA3,U)]"" S X=X_";32////"_$P(DATA3,U)
I $P(DATA3,U,2)]"" S X=X_";33////"_$P(DATA3,U,2)
I $P(DATA3,U,3)]"" S X=X_";36////"_$P(DATA3,U,3)
F Q:$E(X)'="" S X=$E(X,2,9999)
I X]"" S DR(1,9002325.31,1)=$G(DR(1,9002325.31,1))_X ;ACR*2.1*3.11
K X
Q:'$D(DR)
S DIE="^AFSLODOC("_DA(1)_",1,"
D ^DIE
D BAL(ACRD0,ACRD1)
Q
KDOC(ACRD0,ACRD1) ;EP
;----- DELETE DOCUMENT ENTRY
;
; ACRD0 = FY IEN
; ACRD1 = DOCUMENT ENTRY IEN
;
N DA,DIK,X,Y
S DA=ACRD1
S DA(1)=ACRD0
S DIK="^AFSLODOC("_DA(1)_",1,"
D ^DIK
Q
APMT(ACRD0,ACRD1,X,Y) ;EP
;----- ADD NEW PAYMENT ENTRY TO PMT# SUBFILE
;
; ACRD0 = FISCAL YEAR IEN
; ACRD1 = DOCUMENT ENTRY IEN (RETURNED)
; X = EXTERNAL DOCUMENT NUMBER
; Y = PAYMENT NUMBER IEN (RETURNED)
;
N DA,DD,DIC,DINUM,DLAYGO,DO
I '$D(^AFSLODOC("DOCNO",X,ACRD0)) D Q
. W !?5,"Document number ",X," is not in the Open Document file"
. S Y=-1
S (ACRD1,DA(1))=$$GETODOC(ACRD0,X)
Q:'DA(1)
S DA(2)=ACRD0
Q:'$D(^AFSLODOC(DA(2),1,DA(1)))
L +^AFSLODOC(DA(2),1,DA(1)):1 Q:'$T
S X=$P($G(^AFSLODOC(DA(2),1,DA(1),1,0)),U,3)
F S X=X+1 Q:'$D(^AFSLODOC(DA(2),1,DA(1),1,"B",X))
S DINUM=X
S DLAYGO=9002325.3
S DIC="^AFSLODOC("_DA(2)_",1,"_DA(1)_",1,"
S DIC(0)="L"
S DIC("P")=$P(^DD(9002325.31,11,0),U,2)
K DD,DO
D FILE^DICN
L -^AFSLODOC(DA(2),1,DA(1))
Q
EPMT(ACRD0,ACRD1,ACRD2,DATA) ;EP
;----- Edit PAYMENT DATA
;
; ACRD0 = FISCAL YEAR IEN
; ACRD1 = DOCUMENT NUMBER SUBFILE IEN
; ACRD2 = PAYMENT NUMBER SUBFILE IEN
; DATA = STRING CONTAINING DATA:
; PAYMENT DATE^PAYMENT AMOUNT^AFP BATCH^EIN/SSN^
; TREAS SCHED#^PD-FOR^PAYMENT POSTED^MODIFIER^
; AFP BATCH PMT#
;
N DA,DIE,DR,X,Y
Q:'$D(^AFSLODOC(ACRD0,1,ACRD1,1,ACRD2))
S DA(2)=ACRD0
S DA(1)=ACRD1
S DA=ACRD2
S X=""
I $P(DATA,U)]"" S X=X_"1////"_$P(DATA,U)
I $P(DATA,U,2)]"" S X=X_";2////"_$P(DATA,U,2)
I $P(DATA,U,3)]"" S X=X_";.05////"_$P(DATA,U,3)
I $P(DATA,U,4)]"" S X=X_";3////"_$P(DATA,U,4)
I $P(DATA,U,5)]"" S X=X_";4////"_$P(DATA,U,5)
I $P(DATA,U,6)]"" S X=X_";5////"_$P(DATA,U,6)
I $P(DATA,U,7)]"" S X=X_";6////"_$P(DATA,U,7)
I $P(DATA,U,8)]"" S X=X_";7////"_$P(DATA,U,8)
I $P(DATA,U,9)]"" S X=X_";8////"_$P(DATA,U,9)
I $E(X)=";" S X=$E(X,2,9999)
I X]"" S DR=X
K X
Q:'$D(DR)
S DIE="^AFSLODOC("_DA(2)_",1,"_DA(1)_",1,"
D ^DIE
;
S DA(1)=ACRD0
S DA=ACRD1
S DIE="^AFSLODOC("_DA(1)_",1,"
S DR="19////"_$P(DATA,U,2)
D ^DIE
;
D BAL(ACRD0,ACRD1)
Q
KP(ACRFY,ACRDOCNO,ACRBATNO,ACRSEQNO) ;EP
;----- ENTRY POINT TO DELETE OPEN DOCUMENT FILE PAYMENT ENTRY
; WHEN DELETING PAYMENT FROM ARMS PAYMENT BATCH
; CALLED BY DELETE^ACRFPAY4
;
; FROM 1166 APPROVALS FOR PAYMENT FILE:
; ACRFY = EXTERNAL FISCAL YEAR
; ACRDOCNO = DOCUMENT NUMBER
; ACRBATNO = PAYMENT BATCH NUMBER
; ACRSEQNO = PAYMENT SEQUENCE NUMBER
;
Q:ACRFY']"" ;ACR*2.1*3.34
Q:ACRDOCNO']"" ;ACR*2.1*3.34
Q:ACRBATNO']"" ;ACR*2.1*3.34
Q:ACRSEQNO']"" ;ACR*2.1*3.34
S ACRD0=$O(^AFSLODOC("B",ACRFY,0))
Q:'ACRD0
S ACRD1=$O(^AFSLODOC(ACRD0,1,"B",ACRDOCNO,0))
Q:'ACRD1
S ACRD2=$O(^AFSLODOC(ACRD0,1,ACRD1,1,"C",ACRBATNO,ACRSEQNO,0))
Q:'ACRD2
D KPMT(ACRD0,ACRD1,ACRD2)
Q
KPMT(ACRD0,ACRD1,ACRD2) ;EP
;----- DELETE OPEN DOCUMENT FILE PAYMENT ENTRY
;
; ACRD0 = FISCAL YEAR IEN
; ACRD1 = DOCUMENT NUMBER SUBFILE IEN
; ACRD2 = PAYMENT NUMBER SUBFILE IEN
;
N DA,DIK,X,Y
S DA(2)=ACRD0
Q:'DA(2)
S DA(1)=ACRD1
S DA=ACRD2
S DIK="^AFSLODOC("_DA(2)_",1,"_DA(1)_",1,"
D ^DIK
D BAL(ACRD0,ACRD1)
Q
AFY(X,Y) ;EP -- ADD NEW FISCAL YEAR ENTRY
;
; X = EXTERNAL FISCAL YEAR
;
N DIC,DD,DO,DLAYGO
S DIC="^AFSLODOC("
S DIC(0)=""
I '$O(^AFSLODOC("B",X,0)) D
. S DIC(0)="L"
. S DLAYGO=9002325.3
D ^DIC
Q
FIND(ACRFY,ACRBATNO,ACRSEQNO,ACRDOC) ;EP
;----- FIND PMT NODE BELONGING TO BATCH AND SEQUENCE
;
; ACRFY = EXTERNAL FISCAL YEAR
; ACRBATNO = EXTERNAL 1166 BATCH NUMBER
; ACRSEQNO = EXTERNAL 1166 SEQUENCE NUMBER
; ACRDOC = EXTERNAL DOCUMENT NUMBER
;
N DATA,ACRD0,ACRD1,ACRD2
S (ACRD0,ACRD1,ACRD2)=""
S ACRD0=$O(^AFSLODOC("B",ACRFY,0))
S ACRD1=0
F S ACRD1=$O(^AFSLODOC("G",ACRBATNO,ACRD0,ACRD1)) Q:'ACRD1 D
. Q:$P(^AFSLODOC(ACRD0,1,ACRD1,0),U)'=ACRDOC
. S ACRD2=0
. F S ACRD2=$O(^AFSLODOC("G",ACRBATNO,ACRD0,ACRD1,ACRD2)) Q:'ACRD2 D
. . S DATA=$G(^AFSLODOC(ACRD0,1,ACRD1,1,ACRD2,0))
. . Q:$P(DATA,U,4)'=ACRBATNO
. . Q:$P(DATA,U,10)'=ACRSEQNO
Q
GETODOC(ACRD0,X) ;EP
;----- GET OPEN DOCUMENT SUBFILE DOCUMENT ENTRY IEN
;
; ACRD0 = FISCAL YEAR IEN
; X = EXTERNAL DOCUMENT NUMBER
;
N Y
S Y=$O(^AFSLODOC(ACRD0,1,"B",X,0))
Q $G(Y)
SETC(ACRD0,ACRD1,ACRD2) ;EP
;EP -- CALLED BY "C" CROSSREFERENCE IN OPEN DOCUMENT FILE
;
N X
Q:'ACRD0
Q:'ACRD1
Q:'ACRD2
S X=$G(^AFSLODOC(ACRD0,1,ACRD1,1,ACRD2,0))
Q:$P(X,U,4)=""
Q:$P(X,U,10)=""
S ^AFSLODOC(ACRD0,1,ACRD1,1,"C",$P(X,U,4),$P(X,U,10),ACRD2)=""
Q
KILLC(ACRD0,ACRD1,ACRD2) ;EP
;EP -- CALLED BY "C" CROSSREFERENCE IN OPEN DOCUMENT FILE
;
N X
Q:'ACRD0
Q:'ACRD1
Q:'ACRD2
S X=$G(^AFSLODOC(ACRD0,1,ACRD1,1,ACRD2,0))
Q:$P(X,U,4)=""
Q:$P(X,U,10)=""
K ^AFSLODOC(ACRD0,1,ACRD1,1,"C",$P(X,U,4),$P(X,U,10),ACRD2)
Q
BAL(ACRD0,ACRD1) ;EP
;----- CALCULATE AND ADJUST OPEN DOCUMENT BALANCE
;
; ACRD0 = FISCAL YEAR IEN
; ACRD1 = DOCUMENT ENTRY IEN
;
N ACRBAL,DA,DIE,DR
D CALC(ACRD0,ACRD1,.ACRBAL)
S DA=ACRD1
S DA(1)=ACRD0
S DIE="^AFSLODOC("_DA(1)_",1,"
S DR="27////"_ACRBAL
D ^DIE
;
Q
CALC(ACRD0,ACRD1,ACRBAL) ;EP
;----- CALCULATE OPEN DOCUMENT BALANCE
;
; RETURNS:
; ACRBAL = BALANCE OF OBLIGATIONS MINUS PAYMENTS
;
N ACRAMT,ACRDHR,ACRDOC,ACRDOCDA,ACRREV,ACRD2,DATA
S ACRBAL=0
S ACRDOC=$P($G(^AFSLODOC(ACRD0,1,ACRD1,0)),U)
Q:ACRDOC']""
S ACRDOCDA=0
F S ACRDOCDA=$O(^ACRDOC("C",ACRDOC,ACRDOCDA)) Q:'ACRDOCDA D
. S ACRDHR=0
. F S ACRDHR=$O(^ACRDHR("E",ACRDOCDA,ACRDHR)) Q:'ACRDHR D
. . S DATA=$G(^ACRDHR(ACRDHR,1))
. . Q:$P(DATA,U,3)'="050"
. . S ACRREV=$P(DATA,U,4)
. . S ACRAMT=$P(DATA,U,14)
. . S ACRAMT=$$DOL^ACRFUTL(ACRAMT/100)
. . I ACRREV=2 S ACRAMT=0-ACRAMT
. . S ACRBAL=ACRBAL+ACRAMT
. . S ACRBAL=$$DOL^ACRFUTL(ACRBAL)
. . I ACRBAL["(" S ACRBAL=$TR(ACRBAL,"()",""),ACRBAL="-"_ACRBAL
S ACRD2=0
F S ACRD2=$O(^AFSLODOC(ACRD0,1,ACRD1,1,ACRD2)) Q:'ACRD2 D
. S ACRAMT=$P(^AFSLODOC(ACRD0,1,ACRD1,1,ACRD2,0),U,3)
. S ACRBAL=ACRBAL-ACRAMT
. S ACRBAL=$$DOL^ACRFUTL(ACRBAL)
. I ACRBAL["(" S ACRBAL=$TR(ACRBAL,"()",""),ACRBAL="-"_ACRBAL
Q
ACRFODOC ;IHS/OIRM/DSD/AEF - OPEN DOCUMENT FILE INTERFACE [ 07/24/2002 3:26 PM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**3**;NOV 05, 2001
+2 ;
EN(ACRDOCDA,ACR1,ACR2) ;EP
+1 ;----- MAIN ENTRY POINT
+2 ;
+3 ; CALLED BY CREATE^ACRFDHR
+4 ;
+5 ; ACRDOCDA = FMS DOCUMENT IEN
+6 ; ACR1 = STRING CONTAINING DATA:
+7 ; DOCUMENT TYPE^TRANSACTION CODE^REVERSE CODE^
+8 ; MODIFIER CODE^DOCUMENT REFERENCE CODE^CAN NUMBER^
+9 ; OBJECT CLASS CODE^AMOUNT^FED/NON FED CODE^
+10 ; PID (VENDOR IEN OR TRAVELER SSN)^DOCUMENT NUMBER
+11 ; ACR2 = STRING CONTAINING DATA:
+12 ; PAYMENT DATE^AFP BATCH^TREAS SCHED NO^AFP BATCH SEQ
+13 ;
+14 DO ^XBKVAR
+15 IF $PIECE(ACR1,U,2)="050"
DO OBL(ACRDOCDA,ACR1)
+16 QUIT
+17 ;
OBL(ACRDOCDA,ACR) ;EP
+1 ;----- ENTER/EDIT OBLIGATION IN OPEN DOCUMENT FILE
+2 ;
+3 ; ACR = STRING CONTAINING DATA:
+4 ; TYPE^TRNCD^REVCD^MODCD^REF^CAN^OCC^AMT^FED^PID^DOCNO
+5 ; ACRDOC0 = ZERO NODE OF FMS DOCUMENT FILE
+6 ; ACRFY = FISCAL YEAR OF FUNDS
+7 ; ACRDEPT = DEPARTMENT ACCOUNT
+8 ; ACRALW = ALLOWANCE NUMBER
+9 ; ACRAPP = APPROPRIATION NUMBER
+10 ; ACRLOC = LOCATION CODE
+11 ; ACRSSA = SUB-SUB-ACTIVITY
+12 ; ACRIMN = IMN NUMBER
+13 ;
+14 NEW ACRALW,ACRAPP,ACRDEPT,ACRDOC0,ACRFY,ACRIMN,ACRLOC,ACRSSA,DATA,DATA1,DATA2,DATA3
+15 DO ^XBKVAR
+16 SET ACRDOC0=$GET(^ACRDOC(ACRDOCDA,0))
+17 SET ACRDEPT=$PIECE($GET(ACRDOC0),U,6)
+18 IF ACRDEPT
Begin DoDot:1
+19 SET DATA=$GET(^ACRLOCB(ACRDEPT,"DT"))
+20 SET ACRFY=$PIECE(DATA,U)
+21 IF 'ACRFY
QUIT
+22 SET ACRALW=$PIECE(DATA,U,5)
+23 IF ACRALW
SET ACRALW=$PIECE($GET(^AUTTALLW(ACRALW,0)),U)
+24 SET ACRLOC=$PIECE(DATA,U,11)
+25 IF ACRLOC
SET ACRLOC=$PIECE($GET(^AUTTLCOD(ACRLOC,0)),U)
+26 SET ACRSSA=$PIECE(DATA,U,8)
+27 IF ACRSSA
SET ACRSSA=$PIECE($GET(^AUTTSSA(ACRSSA,0)),U)
+28 SET ACRAPP=$PIECE(DATA,U,4)
+29 IF ACRAPP
Begin DoDot:2
+30 SET DATA=$GET(^AUTTPRO(ACRAPP,0))
+31 SET ACRAPP=$PIECE(DATA,U)
+32 SET ACRIMN=$PIECE(DATA,U,3)
End DoDot:2
End DoDot:1
+33 KILL DATA
+34 IF 'ACRFY
QUIT
+35 SET DATA1=U_$PIECE(ACR,U,6)_U_$PIECE(ACR,U,7)_U_$PIECE(ACR,U,9)_U_$PIECE(ACR,U)_U_$PIECE(ACR,U,10)_U_U_DT_U_$PIECE(ACR,U,8)
+36 SET DATA2=$PIECE(ACR,U,5)_U_U_U_U_DT_U_$PIECE(ACR,U,2)_$PIECE(ACR,U,3)_$PIECE(ACR,U,4)_U_$PIECE(ACR,U,8)_U_U_ACRFY_U_ACRALW_U_ACRAPP_U_ACRLOC_U_ACRSSA_U_DT
+37 SET DATA3=DT_U_DT_U_ACRIMN
+38 DO AFY(ACRFY,.Y)
+39 SET ACRD0=+Y
+40 DO DOC(ACRD0,DATA1,DATA2,DATA3,$PIECE(ACR,U,11))
+41 ;
+42 QUIT
DOC(ACRD0,DATA1,DATA2,DATA3,X) ;EP
+1 ;----- ADD/EDIT OPEN DOCUMENT FILE ENTRY
+2 ;
+3 ; ACRD0 = FISCAL YEAR IEN
+4 ; ACRD1 = DOCUMENT SUBFILE IEN
+5 ; X = EXTERNAL DOCUMENT NUMBER
+6 ; DATA1-DATA3 = STRINGS CONTAINING DATA (SEE EDOC)
+7 ;
+8 NEW ACRD1,Y
+9 IF X']""
QUIT
+10 DO LDOC(ACRD0,X,.Y)
+11 IF +Y'>0
DO ADOC(ACRD0,X,.Y)
+12 IF +Y'>0
QUIT
+13 SET ACRD1=+Y
+14 DO EDOC(ACRD0,ACRD1,DATA1,DATA2,DATA3)
+15 QUIT
PAY(ACRD0,DATA,X) ;EP
+1 ;----- ADD/EDIT OPEN DOCUMENT PAYMENT ENTRY
+2 ;
+3 ; ACRD0 = FISCAL YEAR IEN
+4 ; X = EXTERNAL DOCUMENT NUMBER
+5 ; DATA = STRING CONTAINING DATA (SEE PDOC)
+6 ;
+7 NEW ACRD1,ACRD2,Y
+8 DO APMT(ACRD0,.ACRD1,X,.Y)
+9 IF Y'>0
QUIT
+10 SET ACRD2=+Y
+11 DO EPMT(ACRD0,ACRD1,ACRD2,DATA)
+12 QUIT
LDOC(ACRD0,X,Y) ;EP
+1 ;----- LOOKUP DOCUMENT ENTRY
+2 ;
+3 ; ACRD0 = FISCAL YEAR IEN
+4 ; X = EXTERNAL DOCUMENT NUMBER
+5 ; Y = INTERNAL DOCUMENT ENTRY IEN (-1 IF NOT FOUND) (RETURNED)
+6 ;
+7 NEW DIC
+8 SET DIC="^AFSLODOC("_ACRD0_",1,"
+9 SET DIC(0)=""
+10 DO ^DIC
+11 QUIT
ADOC(ACRD0,X,Y) ;EP
+1 ;----- ADD NEW DOCUMENT ENTRY
+2 ;
+3 ; ACRD0 = FISCAL YEAR IEN
+4 ; X = EXTERNAL DOCUMENT NUMBER
+5 ; Y = INTERNAL DOCUMENT ENTRY IEN (RETURNED)
+6 ;
+7 NEW DA,DD,DIC,DO
+8 SET DA(1)=ACRD0
+9 SET DLAYGO=9002325.3
+10 SET DIC="^AFSLODOC("_DA(1)_",1,"
+11 SET DIC(0)="L"
+12 SET DIC("P")=$PIECE(^DD(9002325.3,1,0),U,2)
+13 KILL DD,DO
+14 DO FILE^DICN
+15 QUIT
EDOC(ACRD0,ACRD1,DATA1,DATA2,DATA3) ;EP
+1 ;----- EDIT DOCUMENT DATA
+2 ;
+3 ; ACRD0 = FISCAL YEAR IEN
+4 ; ACRD1 = DOCUMENT NUMBER SUBFILE IEN
+5 ; DATA1 = STRING CONTAINING DATA:
+6 ; DOCUMENT SFX^CAN^SUB-OBJ CLASS^FED-NON FED^DOC TYPE^
+7 ; PID^PID-SUFFIX^OBLIGATION DATE^OBLIGATION AMT^CLOSED
+8 ; FLAG
+9 ; DATA2 = STRING CONTAINING DATA:
+10 ; DOCUMENT REF^DOWNLOAD ENTRY^VND-POINTER^LINKED
+11 ; DOCUMENT^DATE OF LAST TRANSACTION^LAST TRANSACTION
+12 ; CODE^LAST TRANSACTION AMOUNT^BATCH NAME^FY OF FUNDS^
+13 ; ALLOWANCE^APPROPRIATION^LOCATION^SSA^OBLIGATION POSTED^
+14 ; DATA3 = STRING CONTAINING DATA:
+15 ; OBLIG CREATE DATE^LAST ACTIVITY DATE^IMN
+16 ;
+17 NEW AMT,BAL,CODE,DA,DIE,DR,X
+18 SET AMT=$PIECE(DATA1,U,9)
+19 SET CODE=$PIECE(DATA2,U,6)
+20 SET CODE=$EXTRACT(CODE,4)
+21 IF CODE=2
SET AMT=(0-AMT)
+22 IF '$DATA(^AFSLODOC(ACRD0,1,ACRD1))
QUIT
+23 SET DA(1)=ACRD0
+24 SET DA=ACRD1
+25 SET X=""
+26 IF $PIECE(DATA1,U)]""
SET X=X_"1////"_$PIECE(DATA1,U)
+27 IF $PIECE(DATA1,U,2)]""
SET X=X_";2////"_$PIECE(DATA1,U,2)
+28 IF $PIECE(DATA1,U,3)]""
SET X=X_";3////"_$PIECE(DATA1,U,3)
+29 IF $PIECE(DATA1,U,4)]""
SET X=X_";4////"_$PIECE(DATA1,U,4)
+30 IF $PIECE(DATA1,U,5)]""
SET X=X_";5////"_$PIECE(DATA1,U,5)
+31 IF $PIECE(DATA1,U,6)]""
SET X=X_";6////"_$PIECE(DATA1,U,6)
+32 IF $PIECE(DATA1,U,7)]""
SET X=X_";7////"_$PIECE(DATA1,U,7)
+33 IF $PIECE(DATA1,U,8)]""
SET X=X_";8////"_$PIECE(DATA1,U,8)
+34 ;I $P(DATA1,U,9)]"" S X=X_";9////"_$P(DATA1,U,9)
+35 IF AMT]""
IF '+$PIECE($GET(^AFSLODOC(ACRD0,1,ACRD1,0)),U,10)
SET X=X_";9////"_AMT
+36 FOR
IF $EXTRACT(X)'=";"
QUIT
SET X=$EXTRACT(X,2,9999)
+37 IF X]""
SET DR=X
+38 SET X=""
+39 IF $PIECE(DATA2,U)]""
SET X=X_"12////"_$PIECE(DATA2,U)
+40 IF $PIECE(DATA2,U,2)]""
SET X=X_";14////"_$PIECE(DATA2,U,2)
+41 IF $PIECE(DATA2,U,3)]""
SET X=X_";15////"_$PIECE(DATA2,U,3)
+42 IF $PIECE(DATA2,U,4)]""
SET X=X_";16////"_$PIECE(DATA2,U,4)
+43 IF $PIECE(DATA2,U,5)]""
SET X=X_";17////"_$PIECE(DATA2,U,5)
+44 IF $PIECE(DATA2,U,6)]""
SET X=X_";18////"_$PIECE(DATA2,U,6)
+45 IF $PIECE(DATA2,U,7)]""
SET X=X_";19////"_$PIECE(DATA2,U,7)
+46 IF $PIECE(DATA2,U,8)]""
SET X=X_";20////"_$PIECE(DATA2,U,8)
+47 IF $PIECE(DATA2,U,9)]""
SET X=X_";21////"_$PIECE(DATA2,U,9)
+48 IF $PIECE(DATA2,U,10)]""
SET X=X_";22////"_$PIECE(DATA2,U,10)
+49 IF $PIECE(DATA2,U,11)]""
SET X=X_";23////"_$PIECE(DATA2,U,11)
+50 IF $PIECE(DATA2,U,12)]""
SET X=X_";24////"_$PIECE(DATA2,U,12)
+51 IF $PIECE(DATA2,U,13)]""
SET X=X_";25////"_$PIECE(DATA2,U,13)
+52 IF $PIECE(DATA2,U,14)]""
SET X=X_";26////"_$PIECE(DATA2,U,14)
+53 FOR
IF $EXTRACT(X)'=";"
QUIT
SET X=$EXTRACT(X,2,9999)
+54 IF X]""
SET DR(1,9002325.31,1)=X
+55 SET X=""
+56 IF $PIECE(DATA3,U)]""
SET X=X_";32////"_$PIECE(DATA3,U)
+57 IF $PIECE(DATA3,U,2)]""
SET X=X_";33////"_$PIECE(DATA3,U,2)
+58 IF $PIECE(DATA3,U,3)]""
SET X=X_";36////"_$PIECE(DATA3,U,3)
+59 FOR
IF $EXTRACT(X)'=""
QUIT
SET X=$EXTRACT(X,2,9999)
+60 ;ACR*2.1*3.11
IF X]""
SET DR(1,9002325.31,1)=$GET(DR(1,9002325.31,1))_X
+61 KILL X
+62 IF '$DATA(DR)
QUIT
+63 SET DIE="^AFSLODOC("_DA(1)_",1,"
+64 DO ^DIE
+65 DO BAL(ACRD0,ACRD1)
+66 QUIT
KDOC(ACRD0,ACRD1) ;EP
+1 ;----- DELETE DOCUMENT ENTRY
+2 ;
+3 ; ACRD0 = FY IEN
+4 ; ACRD1 = DOCUMENT ENTRY IEN
+5 ;
+6 NEW DA,DIK,X,Y
+7 SET DA=ACRD1
+8 SET DA(1)=ACRD0
+9 SET DIK="^AFSLODOC("_DA(1)_",1,"
+10 DO ^DIK
+11 QUIT
APMT(ACRD0,ACRD1,X,Y) ;EP
+1 ;----- ADD NEW PAYMENT ENTRY TO PMT# SUBFILE
+2 ;
+3 ; ACRD0 = FISCAL YEAR IEN
+4 ; ACRD1 = DOCUMENT ENTRY IEN (RETURNED)
+5 ; X = EXTERNAL DOCUMENT NUMBER
+6 ; Y = PAYMENT NUMBER IEN (RETURNED)
+7 ;
+8 NEW DA,DD,DIC,DINUM,DLAYGO,DO
+9 IF '$DATA(^AFSLODOC("DOCNO",X,ACRD0))
Begin DoDot:1
+10 WRITE !?5,"Document number ",X," is not in the Open Document file"
+11 SET Y=-1
End DoDot:1
QUIT
+12 SET (ACRD1,DA(1))=$$GETODOC(ACRD0,X)
+13 IF 'DA(1)
QUIT
+14 SET DA(2)=ACRD0
+15 IF '$DATA(^AFSLODOC(DA(2),1,DA(1)))
QUIT
+16 LOCK +^AFSLODOC(DA(2),1,DA(1)):1
IF '$TEST
QUIT
+17 SET X=$PIECE($GET(^AFSLODOC(DA(2),1,DA(1),1,0)),U,3)
+18 FOR
SET X=X+1
IF '$DATA(^AFSLODOC(DA(2),1,DA(1),1,"B",X))
QUIT
+19 SET DINUM=X
+20 SET DLAYGO=9002325.3
+21 SET DIC="^AFSLODOC("_DA(2)_",1,"_DA(1)_",1,"
+22 SET DIC(0)="L"
+23 SET DIC("P")=$PIECE(^DD(9002325.31,11,0),U,2)
+24 KILL DD,DO
+25 DO FILE^DICN
+26 LOCK -^AFSLODOC(DA(2),1,DA(1))
+27 QUIT
EPMT(ACRD0,ACRD1,ACRD2,DATA) ;EP
+1 ;----- Edit PAYMENT DATA
+2 ;
+3 ; ACRD0 = FISCAL YEAR IEN
+4 ; ACRD1 = DOCUMENT NUMBER SUBFILE IEN
+5 ; ACRD2 = PAYMENT NUMBER SUBFILE IEN
+6 ; DATA = STRING CONTAINING DATA:
+7 ; PAYMENT DATE^PAYMENT AMOUNT^AFP BATCH^EIN/SSN^
+8 ; TREAS SCHED#^PD-FOR^PAYMENT POSTED^MODIFIER^
+9 ; AFP BATCH PMT#
+10 ;
+11 NEW DA,DIE,DR,X,Y
+12 IF '$DATA(^AFSLODOC(ACRD0,1,ACRD1,1,ACRD2))
QUIT
+13 SET DA(2)=ACRD0
+14 SET DA(1)=ACRD1
+15 SET DA=ACRD2
+16 SET X=""
+17 IF $PIECE(DATA,U)]""
SET X=X_"1////"_$PIECE(DATA,U)
+18 IF $PIECE(DATA,U,2)]""
SET X=X_";2////"_$PIECE(DATA,U,2)
+19 IF $PIECE(DATA,U,3)]""
SET X=X_";.05////"_$PIECE(DATA,U,3)
+20 IF $PIECE(DATA,U,4)]""
SET X=X_";3////"_$PIECE(DATA,U,4)
+21 IF $PIECE(DATA,U,5)]""
SET X=X_";4////"_$PIECE(DATA,U,5)
+22 IF $PIECE(DATA,U,6)]""
SET X=X_";5////"_$PIECE(DATA,U,6)
+23 IF $PIECE(DATA,U,7)]""
SET X=X_";6////"_$PIECE(DATA,U,7)
+24 IF $PIECE(DATA,U,8)]""
SET X=X_";7////"_$PIECE(DATA,U,8)
+25 IF $PIECE(DATA,U,9)]""
SET X=X_";8////"_$PIECE(DATA,U,9)
+26 IF $EXTRACT(X)=";"
SET X=$EXTRACT(X,2,9999)
+27 IF X]""
SET DR=X
+28 KILL X
+29 IF '$DATA(DR)
QUIT
+30 SET DIE="^AFSLODOC("_DA(2)_",1,"_DA(1)_",1,"
+31 DO ^DIE
+32 ;
+33 SET DA(1)=ACRD0
+34 SET DA=ACRD1
+35 SET DIE="^AFSLODOC("_DA(1)_",1,"
+36 SET DR="19////"_$PIECE(DATA,U,2)
+37 DO ^DIE
+38 ;
+39 DO BAL(ACRD0,ACRD1)
+40 QUIT
KP(ACRFY,ACRDOCNO,ACRBATNO,ACRSEQNO) ;EP
+1 ;----- ENTRY POINT TO DELETE OPEN DOCUMENT FILE PAYMENT ENTRY
+2 ; WHEN DELETING PAYMENT FROM ARMS PAYMENT BATCH
+3 ; CALLED BY DELETE^ACRFPAY4
+4 ;
+5 ; FROM 1166 APPROVALS FOR PAYMENT FILE:
+6 ; ACRFY = EXTERNAL FISCAL YEAR
+7 ; ACRDOCNO = DOCUMENT NUMBER
+8 ; ACRBATNO = PAYMENT BATCH NUMBER
+9 ; ACRSEQNO = PAYMENT SEQUENCE NUMBER
+10 ;
+11 ;ACR*2.1*3.34
IF ACRFY']""
QUIT
+12 ;ACR*2.1*3.34
IF ACRDOCNO']""
QUIT
+13 ;ACR*2.1*3.34
IF ACRBATNO']""
QUIT
+14 ;ACR*2.1*3.34
IF ACRSEQNO']""
QUIT
+15 SET ACRD0=$ORDER(^AFSLODOC("B",ACRFY,0))
+16 IF 'ACRD0
QUIT
+17 SET ACRD1=$ORDER(^AFSLODOC(ACRD0,1,"B",ACRDOCNO,0))
+18 IF 'ACRD1
QUIT
+19 SET ACRD2=$ORDER(^AFSLODOC(ACRD0,1,ACRD1,1,"C",ACRBATNO,ACRSEQNO,0))
+20 IF 'ACRD2
QUIT
+21 DO KPMT(ACRD0,ACRD1,ACRD2)
+22 QUIT
KPMT(ACRD0,ACRD1,ACRD2) ;EP
+1 ;----- DELETE OPEN DOCUMENT FILE PAYMENT ENTRY
+2 ;
+3 ; ACRD0 = FISCAL YEAR IEN
+4 ; ACRD1 = DOCUMENT NUMBER SUBFILE IEN
+5 ; ACRD2 = PAYMENT NUMBER SUBFILE IEN
+6 ;
+7 NEW DA,DIK,X,Y
+8 SET DA(2)=ACRD0
+9 IF 'DA(2)
QUIT
+10 SET DA(1)=ACRD1
+11 SET DA=ACRD2
+12 SET DIK="^AFSLODOC("_DA(2)_",1,"_DA(1)_",1,"
+13 DO ^DIK
+14 DO BAL(ACRD0,ACRD1)
+15 QUIT
AFY(X,Y) ;EP -- ADD NEW FISCAL YEAR ENTRY
+1 ;
+2 ; X = EXTERNAL FISCAL YEAR
+3 ;
+4 NEW DIC,DD,DO,DLAYGO
+5 SET DIC="^AFSLODOC("
+6 SET DIC(0)=""
+7 IF '$ORDER(^AFSLODOC("B",X,0))
Begin DoDot:1
+8 SET DIC(0)="L"
+9 SET DLAYGO=9002325.3
End DoDot:1
+10 DO ^DIC
+11 QUIT
FIND(ACRFY,ACRBATNO,ACRSEQNO,ACRDOC) ;EP
+1 ;----- FIND PMT NODE BELONGING TO BATCH AND SEQUENCE
+2 ;
+3 ; ACRFY = EXTERNAL FISCAL YEAR
+4 ; ACRBATNO = EXTERNAL 1166 BATCH NUMBER
+5 ; ACRSEQNO = EXTERNAL 1166 SEQUENCE NUMBER
+6 ; ACRDOC = EXTERNAL DOCUMENT NUMBER
+7 ;
+8 NEW DATA,ACRD0,ACRD1,ACRD2
+9 SET (ACRD0,ACRD1,ACRD2)=""
+10 SET ACRD0=$ORDER(^AFSLODOC("B",ACRFY,0))
+11 SET ACRD1=0
+12 FOR
SET ACRD1=$ORDER(^AFSLODOC("G",ACRBATNO,ACRD0,ACRD1))
IF 'ACRD1
QUIT
Begin DoDot:1
+13 IF $PIECE(^AFSLODOC(ACRD0,1,ACRD1,0),U)'=ACRDOC
QUIT
+14 SET ACRD2=0
+15 FOR
SET ACRD2=$ORDER(^AFSLODOC("G",ACRBATNO,ACRD0,ACRD1,ACRD2))
IF 'ACRD2
QUIT
Begin DoDot:2
+16 SET DATA=$GET(^AFSLODOC(ACRD0,1,ACRD1,1,ACRD2,0))
+17 IF $PIECE(DATA,U,4)'=ACRBATNO
QUIT
+18 IF $PIECE(DATA,U,10)'=ACRSEQNO
QUIT
End DoDot:2
End DoDot:1
+19 QUIT
GETODOC(ACRD0,X) ;EP
+1 ;----- GET OPEN DOCUMENT SUBFILE DOCUMENT ENTRY IEN
+2 ;
+3 ; ACRD0 = FISCAL YEAR IEN
+4 ; X = EXTERNAL DOCUMENT NUMBER
+5 ;
+6 NEW Y
+7 SET Y=$ORDER(^AFSLODOC(ACRD0,1,"B",X,0))
+8 QUIT $GET(Y)
SETC(ACRD0,ACRD1,ACRD2) ;EP
+1 ;EP -- CALLED BY "C" CROSSREFERENCE IN OPEN DOCUMENT FILE
+2 ;
+3 NEW X
+4 IF 'ACRD0
QUIT
+5 IF 'ACRD1
QUIT
+6 IF 'ACRD2
QUIT
+7 SET X=$GET(^AFSLODOC(ACRD0,1,ACRD1,1,ACRD2,0))
+8 IF $PIECE(X,U,4)=""
QUIT
+9 IF $PIECE(X,U,10)=""
QUIT
+10 SET ^AFSLODOC(ACRD0,1,ACRD1,1,"C",$PIECE(X,U,4),$PIECE(X,U,10),ACRD2)=""
+11 QUIT
KILLC(ACRD0,ACRD1,ACRD2) ;EP
+1 ;EP -- CALLED BY "C" CROSSREFERENCE IN OPEN DOCUMENT FILE
+2 ;
+3 NEW X
+4 IF 'ACRD0
QUIT
+5 IF 'ACRD1
QUIT
+6 IF 'ACRD2
QUIT
+7 SET X=$GET(^AFSLODOC(ACRD0,1,ACRD1,1,ACRD2,0))
+8 IF $PIECE(X,U,4)=""
QUIT
+9 IF $PIECE(X,U,10)=""
QUIT
+10 KILL ^AFSLODOC(ACRD0,1,ACRD1,1,"C",$PIECE(X,U,4),$PIECE(X,U,10),ACRD2)
+11 QUIT
BAL(ACRD0,ACRD1) ;EP
+1 ;----- CALCULATE AND ADJUST OPEN DOCUMENT BALANCE
+2 ;
+3 ; ACRD0 = FISCAL YEAR IEN
+4 ; ACRD1 = DOCUMENT ENTRY IEN
+5 ;
+6 NEW ACRBAL,DA,DIE,DR
+7 DO CALC(ACRD0,ACRD1,.ACRBAL)
+8 SET DA=ACRD1
+9 SET DA(1)=ACRD0
+10 SET DIE="^AFSLODOC("_DA(1)_",1,"
+11 SET DR="27////"_ACRBAL
+12 DO ^DIE
+13 ;
+14 QUIT
CALC(ACRD0,ACRD1,ACRBAL) ;EP
+1 ;----- CALCULATE OPEN DOCUMENT BALANCE
+2 ;
+3 ; RETURNS:
+4 ; ACRBAL = BALANCE OF OBLIGATIONS MINUS PAYMENTS
+5 ;
+6 NEW ACRAMT,ACRDHR,ACRDOC,ACRDOCDA,ACRREV,ACRD2,DATA
+7 SET ACRBAL=0
+8 SET ACRDOC=$PIECE($GET(^AFSLODOC(ACRD0,1,ACRD1,0)),U)
+9 IF ACRDOC']""
QUIT
+10 SET ACRDOCDA=0
+11 FOR
SET ACRDOCDA=$ORDER(^ACRDOC("C",ACRDOC,ACRDOCDA))
IF 'ACRDOCDA
QUIT
Begin DoDot:1
+12 SET ACRDHR=0
+13 FOR
SET ACRDHR=$ORDER(^ACRDHR("E",ACRDOCDA,ACRDHR))
IF 'ACRDHR
QUIT
Begin DoDot:2
+14 SET DATA=$GET(^ACRDHR(ACRDHR,1))
+15 IF $PIECE(DATA,U,3)'="050"
QUIT
+16 SET ACRREV=$PIECE(DATA,U,4)
+17 SET ACRAMT=$PIECE(DATA,U,14)
+18 SET ACRAMT=$$DOL^ACRFUTL(ACRAMT/100)
+19 IF ACRREV=2
SET ACRAMT=0-ACRAMT
+20 SET ACRBAL=ACRBAL+ACRAMT
+21 SET ACRBAL=$$DOL^ACRFUTL(ACRBAL)
+22 IF ACRBAL["("
SET ACRBAL=$TRANSLATE(ACRBAL,"()","")
SET ACRBAL="-"_ACRBAL
End DoDot:2
End DoDot:1
+23 SET ACRD2=0
+24 FOR
SET ACRD2=$ORDER(^AFSLODOC(ACRD0,1,ACRD1,1,ACRD2))
IF 'ACRD2
QUIT
Begin DoDot:1
+25 SET ACRAMT=$PIECE(^AFSLODOC(ACRD0,1,ACRD1,1,ACRD2,0),U,3)
+26 SET ACRBAL=ACRBAL-ACRAMT
+27 SET ACRBAL=$$DOL^ACRFUTL(ACRBAL)
+28 IF ACRBAL["("
SET ACRBAL=$TRANSLATE(ACRBAL,"()","")
SET ACRBAL="-"_ACRBAL
End DoDot:1
+29 QUIT
