ACRFODOC.m

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