AFSLLDO2.m

AFSLLDO2 ;IHS/OIRM/DSD/JDM,HJT - LOAD ODF FROM DOWNLOAD FILE;   [ 10/27/2004   4:21 PM ]

 ;;3.0t1;1166 APPROVALS FOR PAYMENT;**1,13**;JAN 31, 1999

 ;;ACR*2.1*9   MODIFIED FOR CACHE' COMPLIANCE

 ;Modified for Y2k compliance   IHS/DSD/HJT   1/15/1999

 ;Read & check records from H.A.S. download file

FRD D ^XBCLS

 W !,"READY TO IMPORT SELECTED DOWNLOAD FILE."

 W !!,"Some Area Offices make obligations/payments for multiple accounting points."

 W !,"I must CLEAR the local obligations database before importing the 1ST",!,"Accounting Point download file ONLY."

 W !!,@AFSLRVON,"***WARNING!  ANSWERING ""Y"" TO THE NEXT QUESTION WILL CLEAR THE DATABASE.",@AFSLRVOF,*7

 N DIR,X,Y                                      ; ACR*2.1*13.02 IM13574

 S DIR(0)="Y^A"                                 ; ACR*2.1*13.02 IM13574

 S DIR("A")="IS THIS THE 1ST ACCOUNTING POINT (OF THIS DOWNLOAD) TO BE IMPORTED? (Y/N/^)" ; ACR*2.1*13.02 IM13574

 S DIR("B")="N"                                 ; ACR*2.1*13.02 IM13574

 D DIR^ACRFDIC                                   ; ACR*2.1*13.02 IM13574

 S AFSLAPIN=$S(ACRY=1:"Y",1:"N")                 ; ACR*2.1*13.02 IM13574

 N DIR,X,Y                                      ; ACR*2.1*13.02 IM13574

 S DIR(0)="Y^A"                                 ; ACR*2.1*13.02 IM13574

 S DIR("A")="ENTER ""Y"" AGAIN TO BEGIN (Y/N)"   ; ACR*2.1*13.02 IM13574

 S DIR("B")="N"                                 ; ACR*2.1*13.02 IM13574

 D DIR^ACRFDIC                                   ; ACR*2.1*13.02 IM13574

 S AFSLCONT=$S(ACRY=1:"Y",1:"N")  ;AFSLCONT IS EXPECTED TO BE Y OR N

 I AFSLCONT="N"!($D(ACRQUIT))!($D(ACROUT)) Q     ; ACR*2.1*13.02 IM13574

 D ^XBCLS

 S %FN=AFSEXFN,%IN=1 S (AFSLXY,AFSLXZ)="",AFSLDUP=0,AFSLZROS="000000000000",AFSLDUPF=""

 W !,"LOADING RECORDS FOR A/P ",AFSLAPN,!,"WORKING "

 I AFSLAPIN'="Y"&(AFSLAPIN'="y") G SKPCLR

 K ^AFSLODOC,^AFSLREJT ;EXEMPTION ************** H.A.S. DOWNLOAD GBLS

 S ^AFSLODOC(0)="1166 AFP OPEN DOCUMENTS^9002325.3^0^0",^AFSLREJT(0)="1166 AFP REJECTED HAS RCDS^9002325.7^0^0"

SKPCLR ;

 I '$D(X) S X="000"

 S AFSLWCTR=0

 D OPENHFS^AFSLCK1                               ; ACR*2.1*13.02 IM13574

 ;S IO=%DEV                                      ; ACR*2.1*13.02 IM13574

 F AFSLI=1:1 S AFSLWCTR=AFSLWCTR+1 U IO R X:60 D ^AFSLCKZC Q:X=""  Q:AFSLNZC=-1  D CHKS D:AFSLDUP=1 @(AFSLEMSG) I AFSLWCTR=1000 U IO(0) W "." S AFSLWCTR=0

 U IO(0) W AFSLI K AFSLWCTR

 U IO(0) W !!,"BEGINNING COMPILED RE-CROSSREFERENCING.  PLEASE WAIT WHILE FILEMAN REINDEXES.",!,"BEGIN: " D NOW^%DTC,YX^%DTC W Y

 S DIK="^AFSLODOC(" D IXALL^DIK

 U IO(0) W !?58,"END: " D NOW^%DTC,YX^%DTC W Y

 L -^AFSLODOC

 ;D ^%ZISC                                       ; ACR*2.1*13.02 IM13574

 D CLOSE^%ZISH("")                               ; ACR*2.1*13.02 IM13574

 D VARKIL K %FN,%IN,AFSLXY,AFSLXZ,AFSLXZ2,%DEV

 K AFSEXFN,AFSLCMD,AFSLCONT,AFSLDNOD,AFSLDNXT,AFSLDOCX,AFSLDT,AFSLDUP,AFSLDUPV,AFSLFFND,AFSLFY,AFSLI,AFSLLTDL,AFSLLTH,AFSLLTR

 K AFSLOBLD,AFSLOK,AFSLSN,AFSLSNX,AFSLVAL,AFSLXC,AFSLXFND,AFSLXY2,AFSLYNOD,AFSLYNXT,AFSLZROS,AFSLRVOF,AFSLRVON,DIK,DX,DY,I,K,X,XY

 Q

CHKS ;

 S X=$E(X,1,132)

 I $E(X,4)="J" S X=$E(X,2,132)

 Q:$E(X,1,2)'=AFSLAPN

 U IO(0) L +^AFSLODOC:15 I '$T S AFSLDUPF=1 W !,"FILE IN USE AT THIS TIME. TRY LATER." H 3 Q

 S AFSLDUP=0,AFSLEMSG="",AFSLOFLG=0,AFSLCFLG=0

 S AFSLFY=$E(X,43,44),AFSLDOC=$E(X,17,26),AFSLCAN=$E(X,27,33),AFSLOBJ=$E(X,34,37),AFSLDREF=$E(X,14,16),AFSLLCD=$E(X,125,127),AFSLOBDT=$E(X,39,44)

 S AFSLIMN=$E(X,4,6),AFSLCRDT=$E(X,45,50),AFSLLADT=$E(X,51,56),AFSLACRL=$E(X,99,111),AFSLDSBT=$E(X,112,124)

 I AFSLFY'?2N S AFSLEMSG=5 G CHKEND

 I AFSLDOC="          " S AFSLEMSG=6 G CHKEND

 I AFSLCAN'?1UN2N4UN S AFSLEMSG=12 G CHKEND

 I $E(AFSLCAN,2,3)'=AFSLAPN S AFSLEMSG=12 G CHKEND

 I AFSLOBJ[" " S AFSLEMSG=8 G CHKEND

 I AFSLLCD="   " S AFSLLCD="000"

 I AFSLLCD?1" "2N S AFSLLCD="0"_$E(AFSLLCD,2,3)

 I AFSLLCD?1"  "1N S AFSLLCD="00"_$E(AFSLLCD,3)

 I AFSLLCD?1N1"  " S AFSLLCD="00"_$E(AFSLLCD,1)

 I AFSLLCD?2N1" " S AFSLLCD="0"_$E(AFSLLCD,1,2)

 I AFSLLCD'?3E S AFSLEMSG=9 G CHKEND

CHKSX ;

 I AFSLOBDT'?6N S AFSLEMSG=10 G CHKEND

 I AFSLDREF'?3N S AFSLEMSG=11 G CHKEND

 ;Begin Y2k fix   HJT1/15/1999

 ;  Var AFSLFY must be converted to a 4-digit date before looking up

 ;  in glob ^AFSLODOC("B"..).  The subscript is 4 digits (i.e. 1999)

 S XSAVEX=X ;ACR*2.0T1*1

 S X=AFSLFY D ^%DT S AFSLFY=Y\10000+1700   ;Y2000

 S X=XSAVEX ;ACR*2.0T1*1

 ;End Y2k fix

 I $D(^AFSLODOC("B",AFSLFY)) S AFSLFYN=$O(^AFSLODOC("B",AFSLFY,0))

 E  S AFSLDUP=0 G CHKEND

 I $D(^AFSLODOC(AFSLFYN,1,"B",AFSLDOC)) S AFSLDOCN=$O(^AFSLODOC(AFSLFYN,1,"B",AFSLDOC,0))

 E  S AFSLDUP=0 G CHKEND

 I $D(^AFSLODOC("C",AFSLCAN,AFSLFYN,AFSLDOCN)) S AFSLCFLG=1

 E  S AFSLDUP=0 G CHKEND

 I $D(^AFSLODOC("D",AFSLOBJ,AFSLFYN,AFSLDOCN)) S AFSLOFLG=1,AFSLDUP=1,AFSLEMSG=1

CHKEND ;

 I AFSLEMSG=5 D @(AFSLEMSG),VARKIL Q  ;OBLIG.YR ERROR

 I AFSLEMSG=6 D @(AFSLEMSG),VARKIL Q  ;DOC# ERROR

 I AFSLEMSG=8 D @(AFSLEMSG),VARKIL Q  ;OBJ CLASS ERROR

 I AFSLEMSG=9 D @(AFSLEMSG),VARKIL Q  ;LOC CODE ERROR

 I AFSLEMSG=10 D @(AFSLEMSG),VARKIL Q  ;OBLIG.DT ERROR

 I AFSLEMSG=11 D @(AFSLEMSG),VARKIL Q  ;DOC REF ERROR

 I AFSLEMSG=12 D @(AFSLEMSG),VARKIL Q  ;CAN NUM ERROR

 I AFSLDUP'=1 D ^AFSLLDO3,VARKIL ;IF NOT DUPLICATE, DO ROUT TO SAVE RCD

 I AFSLDUP=1 D @(AFSLEMSG),VARKIL

 Q

EMSG ;ERROR MESSAGES

1 W !!,"DUPLICATE ENTRY! DOC.# "_$E(X,17,26)_" ALREADY EXISTS YOU CANNOT CREATE A DUPLICATE." D NOSAV S AFSLDUP=0 K AFSLEMSG Q

3 W !!,"CHS FI PAYMENT!  DOC.# "_$P(AFSLXZ,U,1)_" CANNOT BE ENTERED INTO THE 1166 DOCUMENTS FILE." D NOSAV K AFSLEMSG Q

5 W !!,"OBLIGATION YR FORMAT ERROR ON RECORD# "_AFSLI D NOSAV K AFSLEMSG Q

6 W !!,"DOCUMENT NO. FORMAT ERROR ON RECORD# "_AFSLI D NOSAV K AFSLEMSG Q

7 W !!,"RECORD# ",AFSLI," DOC# ",$P(AFSLXZ,U,1)," NOT SAVED (CLOSED & AGE>",AFSLPY," YRS." D NOSAV K AFSLEMSG Q

8 W !!,"OBJECT CLASS FORMAT ERROR ON RECORD# "_AFSLI D NOSAV K AFSLEMSG Q

9 W !!,"LOCATION CODE FORMAT ERROR ON RECORD# "_AFSLI D NOSAV K AFSLEMSG Q

10 W !!,"OBLIGATION DT FORMAT ERROR ON RECORD# "_AFSLI D NOSAV K AFSLEMSG Q

11 W !!,"DOC.REF. CODE FORMAT ERROR ON RECORD# "_AFSLI D NOSAV K AFSLEMSG Q

12 W !!,"CAN NUMBER FORMAT ERROR ON RECORD# "_AFSLI D NOSAV K AFSLEMSG Q

VARKIL ;

 K DIE,DR,DA,AFSLEMSG,AFSLOFLG,AFSLCFLG,AFSLDOC

 K AFSLCAN,AFSLOBJ,AFSLFYN,AFSLDOCN,AFSLYY,AFSLDDAT,AFSLFNUM

 S (AFSLXY,AFSLXY2,AFSLXZ)=""

 Q

NOSAV ;

 I K=0 S ^AFSLREJT(K)="1166 AFP REJECTED HAS RCDS^9002325.7^0^0"

 S K=K+1,$P(^AFSLREJT(0),U,3)=K,$P(^AFSLREJT(0),U,4)=K,$P(^AFSLREJT(K,0),U,1)=K

 I AFSLEMSG=5 S $P(^AFSLREJT(K,0),U,2)=$E(X,1,52)_"^"_AFSLEMSG_"^"_AFSLI,^AFSLREJT("B",K,K)="" Q

 S $P(^AFSLREJT(K,0),U,2)=$E(X,14,16)_"  "_$E(X,17,26)_"  "_$E(X,27,33)_"  "_$E(X,34,37)_"  "_$E(X,39,44)_"  "_$E(X,60,73)_"^"_AFSLEMSG_"^"_AFSLI

 S ^AFSLREJT("B",K,K)=""

 Q

AFSLLDO2  ;IHS/OIRM/DSD/JDM,HJT - LOAD ODF FROM DOWNLOAD FILE;   [ 10/27/2004   4:21 PM ]

 +1       ;;3.0t1;1166 APPROVALS FOR PAYMENT;**1,13**;JAN 31, 1999

 +2       ;;ACR*2.1*9   MODIFIED FOR CACHE' COMPLIANCE

 +3       ;Modified for Y2k compliance   IHS/DSD/HJT   1/15/1999

 +4       ;Read & check records from H.A.S. download file

FRD        DO ^XBCLS

 +1        WRITE !,"READY TO IMPORT SELECTED DOWNLOAD FILE."

 +2        WRITE !!,"Some Area Offices make obligations/payments for multiple accounting points."

 +3        WRITE !,"I must CLEAR the local obligations database before importing the 1ST",!,"Accounting Point download file ONLY."

 +4        WRITE !!,@AFSLRVON,"***WARNING!  ANSWERING ""Y"" TO THE NEXT QUESTION WILL CLEAR THE DATABASE.",@AFSLRVOF,*7

 +5       ; ACR*2.1*13.02 IM13574

           NEW DIR,X,Y

 +6       ; ACR*2.1*13.02 IM13574

           SET DIR(0)="Y^A"

 +7       ; ACR*2.1*13.02 IM13574

           SET DIR("A")="IS THIS THE 1ST ACCOUNTING POINT (OF THIS DOWNLOAD) TO BE IMPORTED? (Y/N/^)"

 +8       ; ACR*2.1*13.02 IM13574

           SET DIR("B")="N"

 +9       ; ACR*2.1*13.02 IM13574

           DO DIR^ACRFDIC

 +10      ; ACR*2.1*13.02 IM13574

           SET AFSLAPIN=$SELECT(ACRY=1:"Y",1:"N")

 +11      ; ACR*2.1*13.02 IM13574

           NEW DIR,X,Y

 +12      ; ACR*2.1*13.02 IM13574

           SET DIR(0)="Y^A"

 +13      ; ACR*2.1*13.02 IM13574

           SET DIR("A")="ENTER ""Y"" AGAIN TO BEGIN (Y/N)"

 +14      ; ACR*2.1*13.02 IM13574

           SET DIR("B")="N"

 +15      ; ACR*2.1*13.02 IM13574

           DO DIR^ACRFDIC

 +16      ;AFSLCONT IS EXPECTED TO BE Y OR N

           SET AFSLCONT=$SELECT(ACRY=1:"Y",1:"N")

 +17      ; ACR*2.1*13.02 IM13574

           IF AFSLCONT="N"!($DATA(ACRQUIT))!($DATA(ACROUT))

               QUIT 

 +18       DO ^XBCLS

 +19       SET %FN=AFSEXFN

           SET %IN=1

           SET (AFSLXY,AFSLXZ)=""

           SET AFSLDUP=0

           SET AFSLZROS="000000000000"

           SET AFSLDUPF=""

 +20       WRITE !,"LOADING RECORDS FOR A/P ",AFSLAPN,!,"WORKING "

 +21       IF AFSLAPIN'="Y"&(AFSLAPIN'="y")

               GOTO SKPCLR

 +22      ;EXEMPTION ************** H.A.S. DOWNLOAD GBLS

           KILL ^AFSLODOC,^AFSLREJT

 +23       SET ^AFSLODOC(0)="1166 AFP OPEN DOCUMENTS^9002325.3^0^0"

           SET ^AFSLREJT(0)="1166 AFP REJECTED HAS RCDS^9002325.7^0^0"

SKPCLR    ;

 +1        IF '$DATA(X)

               SET X="000"

 +2        SET AFSLWCTR=0

 +3       ; ACR*2.1*13.02 IM13574

           DO OPENHFS^AFSLCK1

 +4       ;S IO=%DEV                                      ; ACR*2.1*13.02 IM13574

 +5        FOR AFSLI=1:1

               SET AFSLWCTR=AFSLWCTR+1

               USE IO

               READ X:60

               DO ^AFSLCKZC

               IF X=""

                   QUIT 

               IF AFSLNZC=-1

                   QUIT 

               DO CHKS

               IF AFSLDUP=1

                   DO @(AFSLEMSG)

               IF AFSLWCTR=1000

                   USE IO(0)

                   WRITE "."

                   SET AFSLWCTR=0

 +6        USE IO(0)

           WRITE AFSLI

           KILL AFSLWCTR

 +7        USE IO(0)

           WRITE !!,"BEGINNING COMPILED RE-CROSSREFERENCING.  PLEASE WAIT WHILE FILEMAN REINDEXES.",!,"BEGIN: "

           DO NOW^%DTC

           DO YX^%DTC

           WRITE Y

 +8        SET DIK="^AFSLODOC("

           DO IXALL^DIK

 +9        USE IO(0)

           WRITE !?58,"END: "

           DO NOW^%DTC

           DO YX^%DTC

           WRITE Y

 +10       LOCK -^AFSLODOC

 +11      ;D ^%ZISC                                       ; ACR*2.1*13.02 IM13574

 +12      ; ACR*2.1*13.02 IM13574

           DO CLOSE^%ZISH("")

 +13       DO VARKIL

           KILL %FN,%IN,AFSLXY,AFSLXZ,AFSLXZ2,%DEV

 +14       KILL AFSEXFN,AFSLCMD,AFSLCONT,AFSLDNOD,AFSLDNXT,AFSLDOCX,AFSLDT,AFSLDUP,AFSLDUPV,AFSLFFND,AFSLFY,AFSLI,AFSLLTDL,AFSLLTH,AFSLLTR

 +15       KILL AFSLOBLD,AFSLOK,AFSLSN,AFSLSNX,AFSLVAL,AFSLXC,AFSLXFND,AFSLXY2,AFSLYNOD,AFSLYNXT,AFSLZROS,AFSLRVOF,AFSLRVON,DIK,DX,DY,I,K,X,XY

 +16       QUIT 

CHKS      ;

 +1        SET X=$EXTRACT(X,1,132)

 +2        IF $EXTRACT(X,4)="J"

               SET X=$EXTRACT(X,2,132)

 +3        IF $EXTRACT(X,1,2)'=AFSLAPN

               QUIT 

 +4        USE IO(0)

           LOCK +^AFSLODOC:15

           IF '$TEST

               SET AFSLDUPF=1

               WRITE !,"FILE IN USE AT THIS TIME. TRY LATER."

               HANG 3

               QUIT 

 +5        SET AFSLDUP=0

           SET AFSLEMSG=""

           SET AFSLOFLG=0

           SET AFSLCFLG=0

 +6        SET AFSLFY=$EXTRACT(X,43,44)

           SET AFSLDOC=$EXTRACT(X,17,26)

           SET AFSLCAN=$EXTRACT(X,27,33)

           SET AFSLOBJ=$EXTRACT(X,34,37)

           SET AFSLDREF=$EXTRACT(X,14,16)

           SET AFSLLCD=$EXTRACT(X,125,127)

           SET AFSLOBDT=$EXTRACT(X,39,44)

 +7        SET AFSLIMN=$EXTRACT(X,4,6)

           SET AFSLCRDT=$EXTRACT(X,45,50)

           SET AFSLLADT=$EXTRACT(X,51,56)

           SET AFSLACRL=$EXTRACT(X,99,111)

           SET AFSLDSBT=$EXTRACT(X,112,124)

 +8        IF AFSLFY'?2N

               SET AFSLEMSG=5

               GOTO CHKEND

 +9        IF AFSLDOC="          "

               SET AFSLEMSG=6

               GOTO CHKEND

 +10       IF AFSLCAN'?1UN2N4UN

               SET AFSLEMSG=12

               GOTO CHKEND

 +11       IF $EXTRACT(AFSLCAN,2,3)'=AFSLAPN

               SET AFSLEMSG=12

               GOTO CHKEND

 +12       IF AFSLOBJ[" "

               SET AFSLEMSG=8

               GOTO CHKEND

 +13       IF AFSLLCD="   "

               SET AFSLLCD="000"

 +14       IF AFSLLCD?1" "2N

               SET AFSLLCD="0"_$EXTRACT(AFSLLCD,2,3)

 +15       IF AFSLLCD?1"  "1N

               SET AFSLLCD="00"_$EXTRACT(AFSLLCD,3)

 +16       IF AFSLLCD?1N1"  "

               SET AFSLLCD="00"_$EXTRACT(AFSLLCD,1)

 +17       IF AFSLLCD?2N1" "

               SET AFSLLCD="0"_$EXTRACT(AFSLLCD,1,2)

 +18       IF AFSLLCD'?3E

               SET AFSLEMSG=9

               GOTO CHKEND

CHKSX     ;

 +1        IF AFSLOBDT'?6N

               SET AFSLEMSG=10

               GOTO CHKEND

 +2        IF AFSLDREF'?3N

               SET AFSLEMSG=11

               GOTO CHKEND

 +3       ;Begin Y2k fix   HJT1/15/1999

 +4       ;  Var AFSLFY must be converted to a 4-digit date before looking up

 +5       ;  in glob ^AFSLODOC("B"..).  The subscript is 4 digits (i.e. 1999)

 +6       ;ACR*2.0T1*1

           SET XSAVEX=X

 +7       ;Y2000

           SET X=AFSLFY

           DO ^%DT

           SET AFSLFY=Y\10000+1700

 +8       ;ACR*2.0T1*1

           SET X=XSAVEX

 +9       ;End Y2k fix

 +10       IF $DATA(^AFSLODOC("B",AFSLFY))

               SET AFSLFYN=$ORDER(^AFSLODOC("B",AFSLFY,0))

 +11      IF '$TEST

               SET AFSLDUP=0

               GOTO CHKEND

 +12       IF $DATA(^AFSLODOC(AFSLFYN,1,"B",AFSLDOC))

               SET AFSLDOCN=$ORDER(^AFSLODOC(AFSLFYN,1,"B",AFSLDOC,0))

 +13      IF '$TEST

               SET AFSLDUP=0

               GOTO CHKEND

 +14       IF $DATA(^AFSLODOC("C",AFSLCAN,AFSLFYN,AFSLDOCN))

               SET AFSLCFLG=1

 +15      IF '$TEST

               SET AFSLDUP=0

               GOTO CHKEND

 +16       IF $DATA(^AFSLODOC("D",AFSLOBJ,AFSLFYN,AFSLDOCN))

               SET AFSLOFLG=1

               SET AFSLDUP=1

               SET AFSLEMSG=1

CHKEND    ;

 +1       ;OBLIG.YR ERROR

           IF AFSLEMSG=5

               DO @(AFSLEMSG)

               DO VARKIL

               QUIT 

 +2       ;DOC# ERROR

           IF AFSLEMSG=6

               DO @(AFSLEMSG)

               DO VARKIL

               QUIT 

 +3       ;OBJ CLASS ERROR

           IF AFSLEMSG=8

               DO @(AFSLEMSG)

               DO VARKIL

               QUIT 

 +4       ;LOC CODE ERROR

           IF AFSLEMSG=9

               DO @(AFSLEMSG)

               DO VARKIL

               QUIT 

 +5       ;OBLIG.DT ERROR

           IF AFSLEMSG=10

               DO @(AFSLEMSG)

               DO VARKIL

               QUIT 

 +6       ;DOC REF ERROR

           IF AFSLEMSG=11

               DO @(AFSLEMSG)

               DO VARKIL

               QUIT 

 +7       ;CAN NUM ERROR

           IF AFSLEMSG=12

               DO @(AFSLEMSG)

               DO VARKIL

               QUIT 

 +8       ;IF NOT DUPLICATE, DO ROUT TO SAVE RCD

           IF AFSLDUP'=1

               DO ^AFSLLDO3

               DO VARKIL

 +9        IF AFSLDUP=1

               DO @(AFSLEMSG)

               DO VARKIL

 +10       QUIT 

EMSG      ;ERROR MESSAGES

1          WRITE !!,"DUPLICATE ENTRY! DOC.# "_$EXTRACT(X,17,26)_" ALREADY EXISTS YOU CANNOT CREATE A DUPLICATE."

           DO NOSAV

           SET AFSLDUP=0

           KILL AFSLEMSG

           QUIT 

3          WRITE !!,"CHS FI PAYMENT!  DOC.# "_$PIECE(AFSLXZ,U,1)_" CANNOT BE ENTERED INTO THE 1166 DOCUMENTS FILE."

           DO NOSAV

           KILL AFSLEMSG

           QUIT 

5          WRITE !!,"OBLIGATION YR FORMAT ERROR ON RECORD# "_AFSLI

           DO NOSAV

           KILL AFSLEMSG

           QUIT 

6          WRITE !!,"DOCUMENT NO. FORMAT ERROR ON RECORD# "_AFSLI

           DO NOSAV

           KILL AFSLEMSG

           QUIT 

7          WRITE !!,"RECORD# ",AFSLI," DOC# ",$PIECE(AFSLXZ,U,1)," NOT SAVED (CLOSED & AGE>",AFSLPY," YRS."

           DO NOSAV

           KILL AFSLEMSG

           QUIT 

8          WRITE !!,"OBJECT CLASS FORMAT ERROR ON RECORD# "_AFSLI

           DO NOSAV

           KILL AFSLEMSG

           QUIT 

9          WRITE !!,"LOCATION CODE FORMAT ERROR ON RECORD# "_AFSLI

           DO NOSAV

           KILL AFSLEMSG

           QUIT 

10         WRITE !!,"OBLIGATION DT FORMAT ERROR ON RECORD# "_AFSLI

           DO NOSAV

           KILL AFSLEMSG

           QUIT 

11         WRITE !!,"DOC.REF. CODE FORMAT ERROR ON RECORD# "_AFSLI

           DO NOSAV

           KILL AFSLEMSG

           QUIT 

12         WRITE !!,"CAN NUMBER FORMAT ERROR ON RECORD# "_AFSLI

           DO NOSAV

           KILL AFSLEMSG

           QUIT 

VARKIL    ;

 +1        KILL DIE,DR,DA,AFSLEMSG,AFSLOFLG,AFSLCFLG,AFSLDOC

 +2        KILL AFSLCAN,AFSLOBJ,AFSLFYN,AFSLDOCN,AFSLYY,AFSLDDAT,AFSLFNUM

 +3        SET (AFSLXY,AFSLXY2,AFSLXZ)=""

 +4        QUIT 

NOSAV     ;

 +1        IF K=0

               SET ^AFSLREJT(K)="1166 AFP REJECTED HAS RCDS^9002325.7^0^0"

 +2        SET K=K+1

           SET $PIECE(^AFSLREJT(0),U,3)=K

           SET $PIECE(^AFSLREJT(0),U,4)=K

           SET $PIECE(^AFSLREJT(K,0),U,1)=K

 +3        IF AFSLEMSG=5

               SET $PIECE(^AFSLREJT(K,0),U,2)=$EXTRACT(X,1,52)_"^"_AFSLEMSG_"^"_AFSLI

               SET ^AFSLREJT("B",K,K)=""

               QUIT 

 +4        SET $PIECE(^AFSLREJT(K,0),U,2)=$EXTRACT(X,14,16)_"  "_$EXTRACT(X,17,26)_"  "_$EXTRACT(X,27,33)_"  "_$EXTRACT(X,34,37)_"  "_$EXTRACT(X,39,44)_"  "_$EXTRACT(X,60,73)_"^"_AFSLEMSG_"^"_AFSLI

 +5        SET ^AFSLREJT("B",K,K)=""

 +6        QUIT