AFSLCKSQ ;IHS/OIRM/DSD/JLG - CK PAYMENTS; [ 09/26/2005 5:04 PM ]
;;3.0t1;1166 APPROVALS FOR PAYMENT;**19**;AUG 31, 2005
;Modified for Y2k compliance IHS/DSD/JLG/HJT 1/27/1999
;Original JDM
;Payment record edit - part 1
;
;User input of a 2 digit FY has been changed to 4 digits at tag NDEYR
;
EN1 ; EP; ENTRY POINT FOR CALLING ROUTINES
S AFSLZROS="0000000000"
D ^XBCLS
W !,"We must do the following checks on the payment batch(es):"
W !!,"1 ... Check all payments if corrupt or not recorded in the document."
W !,"2 ... Check all payments for PAY NAME vs. PAY-ID"
W !,"3 ... List and verify 'hash' totals for each batch."
W !,"4 ... Check each batch for blank/incomplete payments.",!
R !,"NOW PRESS RETURN TO BEGIN",AFSLRTNX:300
D ^XBCLS
D CRTSETUP^AFSLCRTS
I '$D(AFSLDDX) S AFSLDDX=""
S DY=2
S DX=28
X XY
W @AFSLRVON,"1166 AFP DATA ENTRY",@AFSLRVOF
S DY=3
S DX=21
X XY
W @AFSLRVON,"PAYMENT RECORD CHECK PROCESS",@AFSLRVOF
S DY=23
S DX=23
X XY
W AFSLDDX
H 2
S AFSLDDX=""
NDE ;
S AFSLNXT="E"
I AFSLNXT="" S AFSLNXT="Q"
I $E(AFSLNXT,1)'="E" G ENDIT
S AFSLANSD="E"
NDEYR ;
S AFSLSQNO="0000"
S DY=23
S DX=23
X XY
W " "
S DY=9
S DX=8
X XY
;Begin Y2k fix IHS/DSD/HJT 1/27/1999
;W "FISCAL YR: **"
W "FISCAL YR: ****" ;Need 4 *'s to designate 4 yr date HJT 1/27/99
;End Y2k fix
S DX=19
;Begin Y2K fix ;IHS/DSD/JLG 12/28/98
;This code has been changed to request a 4 digit year.
;After tag LOOK rtn AFSLYRLU is called which stores AFSLFYR as the
;.01 field of 9002325 which is being changed to 4 digit year
;S AFSLCHRS=2
S AFSLCHRS=4 ;Y2000
X XY
D READCHRS^AFSLSRDR
S AFSLFYR=AFSLVOUT
I AFSLFYR["^" S AFSLANSD="Q" G ENDIT
I AFSLFYR["?" D G NDEYR
.S DX=26
.X XY
.;W @AFSLRVON,"ENTER A 2 DIGIT YR UNDER WHICH BATCH IS FILED ",@AFSLRVOF
.W @AFSLRVON,"ENTER A 4 DIGIT YR UNDER WHICH BATCH IS FILED ",@AFSLRVOF ;Y2000
.H 3
.X XY
.W " "
;I $L(AFSLFYR)<2 D G NDEYR
I $L(AFSLFYR)<4 D G NDEYR ;Y2000
.S DX=26
.X XY
.W @AFSLRVON,"ENTER 4 DIGIT YR UNDER WHICH BATCH IS FILED ",@AFSLRVOF ;Y2000
.;W @AFSLRVON,"ENTER 2 DIGIT YR UNDER WHICH BATCH IS FILED ",@AFSLRVOF
.;End Y2K fix
.H 3
.X XY
.W " "
S DX=19
X XY
W @AFSLRVON,AFSLFYR,@AFSLRVOF
S DY=9
S DX=24
X XY
W " BATCH: ******"
S DX=35
S AFSLCHRS=6
X XY
D READCHRS^AFSLSRDR
S AFSLSCHD=AFSLVOUT
I AFSLSCHD["^" S AFSLANSD="Q" G ENDIT
S AFSLLNTH=$L(AFSLSCHD),AFSLZLTH=6-AFSLLNTH
I AFSLZLTH<0 D
.S AFSLZFIL=$E($$ZERO^AFSLUTLM(50),1,AFSLZLTH)
.S AFSLSCHD=AFSLZFIL_AFSLSCHD
S DX=35
X XY
W @AFSLRVON,AFSLSCHD,@AFSLRVOF
S AFSLSCHE=AFSLSCHD
I AFSLSCHE["^" S AFSLANSD="Q" G ENDIT
S AFSLLNTH=$L(AFSLSCHE)
S AFSLZLTH=6-AFSLLNTH
I AFSLZLTH<0 D
.S AFSLZFIL=$E($$ZERO^AFSLUTLM(50),1,AFSLZLTH)
.S AFSLSCHE=AFSLZFIL_AFSLSCHE
I AFSLSQNO["^" S AFSLANSD="Q" G ENDIT
S AFSLLNTH=$L(AFSLSQNO)
S AFSLZLTH=4-AFSLLNTH
I AFSLZLTH>0 D
.S AFSLZFIL=$E($$ZERO^AFSLUTLM(50),1,AFSLZLTH)
.S AFSLSQNO=AFSLZFIL_AFSLSQNO
S DX=75
X XY
W @AFSLRVON,AFSLSQNO,@AFSLRVOF
LOOPS ;
I AFSLANSD="Q" QUIT
S AFSLSQNO="0000"
S AFSLSQNO="0000"
Q:AFSLANSD="Q"
D PMTLOOP
I $G(AFSLANSD)="Q" K AFSLANSD Q
Q
PMTLOOP ;
S AFSLSQNO=$E($$ZERO^AFSLUTLM(4),1,4-$L(AFSLSQNO))_AFSLSQNO
LOOK ;
D ^AFSLYRLU
I Y="-1" S AFSLDDX="INVALID FISCAL YR " G EN1
D ^AFSLSCLU
I Y="-1" S AFSLDDX="INVALID BATCH " G EN1
PMTLOOP2 ;
Q:'$O(^AFSLAFP(AFSLYNOD,1,AFSLSNOD,1,"B",AFSLSQNO))
S AFSLSQNO=$O(^AFSLAFP(AFSLYNOD,1,AFSLSNOD,1,"B",AFSLSQNO))
S DY=9
S DX=75
X XY
W @AFSLRVON,AFSLSQNO,@AFSLRVOF
D ^AFSLSQLU
I Y="-1" S AFSLDDX="INVALID SEQUENCE " G EN1
S $P(AFSLNZRO,U,30)=""
CKSEQ ;EIN
S AFSLEINO=$P(AFSLNZRO,U,10)
I AFSLEINO="" S AFSLPEIN="" G CKSEQ1
I '$D(^AUTTVNDR(AFSLEINO,11)) G CKSEQ2
S AFSLPEIN=$P(^AUTTVNDR(AFSLEINO,11),U,1)
S AFSLPSFX=$P(^AUTTVNDR(AFSLEINO,11),U,2)
S AFSLVEIN=AFSLPEIN_AFSLPSFX
CKSEQ1 ;SSN
S AFSLSSNO=$P(AFSLNZRO,U,24)
I AFSLSSNO="" S AFSLSSN="" G CKSEQ1A
I '$D(^VA(200,AFSLSSNO,0)) S AFSLSSN="" G CKSEQ1A
;S AFSLSSN=$P(^VA(200,AFSLSSNO,0),U,1) ;ACR*2.1*19.02 IM16848
S AFSLSSN=$$NAME2^ACRFUTL1(AFSLSSNO) ;ACR*2.1*19.02 IM16848
CKSEQ1A ;PAY NAME
I '$D(AFSLNOD1) D
.S AFSLHERR=1
.S DY=17
.S DX=12
.X XY
.W @AFSLRVON,"THIS PAYMENT RECORD IS CORRUPTED. DELETE IT & RE-ENTER.",@AFSLRVOF D PRESS S AFSLNOD1="^^^^^^^^^^^^^^^^^^^^"
S AFSLPNAM=$P(AFSLNOD1,U,4)
CKSEQ1B ;PAY-ID
S AFSLPID=$P(AFSLNOD1,U,22)
CKSEQ2 ;
S DY=11
S DX=13
X XY
W "FOUND FYR: ",AFSLFYR," BATCH: ",AFSLSCHD," SEQUENCE: ",AFSLSQNO
S AFSLCAN=""
S AFSLOBJ=""
S AFSLPTY=""
S AFSLDTY=""
S DY=13,DX=6
X XY
W "DOC REF: ",$P(AFSLNZRO,U,5)
S DX=45
X XY
W "DOCUMENT: ",$P(AFSLNZRO,U,20)
S DY=14,DX=6
X XY
W "OTH REF: ",$P(AFSLNZRO,U,6)
S DX=45
X XY
W "OTH DOC#: ",$P(AFSLNZRO,U,21)
S AFSLCAN=$P(AFSLNZRO,U,7)
I AFSLCAN'="" S AFSLCAN=$P(^AUTTCAN(AFSLCAN,0),U,1)
S AFSLOBJ=$P(AFSLNZRO,U,8)
I AFSLOBJ'="" S AFSLOBJ=$P(^AUTTOBJC(AFSLOBJ,0),U,1)
S DY=15,DX=6
X XY
W "CAN NUM: ",AFSLCAN
S DX=45
X XY
W "OBJ CLAS: ",AFSLOBJ
S AFSLPTY=$P(AFSLNZRO,U,22),AFSLTYPE=AFSLPTY
I AFSLPTY'="" S AFSLPTY=$P(^AFSLPTYP(AFSLPTY,0),U,2)
S AFSLPTYP=AFSLPTY
S AFSLDTY=$P(AFSLNZRO,U,9)
S DY=16,DX=6
X XY
W "DOC TYP: ",AFSLDTY
S DX=26
X XY
W "AMOUNT: ",$P(AFSLNZRO,U,11)
S DX=45
X XY
W "PAY TYPE: ",AFSLPTY
CKPYX ;
I '$D(AFSLVEIN) S AFSLVEIN=""
S DY=19,DX=8
X XY
F M=1:1:32 W " "
S DX=44
X XY
F M=1:1:12 W " "
S DX=66
X XY
F M=1:1:12 W " "
S DY=20,DX=66
X XY
F M=1:1:12 W " "
S DY=19,DX=2
X XY
W "NAME: ",AFSLPNAM
S DX=40
X XY
W "ID: ",AFSLPID
S DX=58
X XY
W "VN-EIN: ",AFSLVEIN
S DY=20,DX=58
X XY
W "TV-SSN: ",AFSLSSN
S AFSLDELX="N"
I '$D(AFSLNOD1)!('$D(AFSLNZRO)) D Q
.S AFSLHERR=1
.S DY=17,DX=12
.X XY
.W @AFSLRVON,"THIS PAYMENT RECORD IS CORRUPTED. DELETE IT & RE-ENTER.",@AFSLRVOF
.D PRESS
I $P(AFSLNOD1,U,15)="" D Q
.S AFSLHERR=1
.S DY=17,DX=12
.X XY
.W @AFSLRVON,"THIS PAYMENT NOT RECORDED IN DOCUMENT. DELETE IT & RE-ENTER.",@AFSLRVOF
.D PRESS
I $P(AFSLNZRO,U,27)="D" D Q
.S AFSLHERR=1
.S DY=17,DX=12
.X XY
.W @AFSLRVON,"***** MARKED BY C.O. TO BE WITHHELD FROM EXPORT *****",@AFSLRVOF
.D PRESS
I AFSLVEIN="" G PMTLOOP2
S X=AFSLPNAM
D ^AFSLPYCR
G PMTLOOP2
Q
ENDIT ;
D ENDIT^AFSLKEDT
QUIT
PRESS ;
S DY=23,DX=2
X XY
W @AFSLRVON,"PRESS RETURN",@AFSLRVOF R AFSLRTNX:300
S DX=2
X XY
W " "
K AFSLDDX
S DY=17,DX=12
X XY W " "
Q
AFSLCKSQ ;IHS/OIRM/DSD/JLG - CK PAYMENTS; [ 09/26/2005 5:04 PM ]
+1 ;;3.0t1;1166 APPROVALS FOR PAYMENT;**19**;AUG 31, 2005
+2 ;Modified for Y2k compliance IHS/DSD/JLG/HJT 1/27/1999
+3 ;Original JDM
+4 ;Payment record edit - part 1
+5 ;
+6 ;User input of a 2 digit FY has been changed to 4 digits at tag NDEYR
+7 ;
EN1 ; EP; ENTRY POINT FOR CALLING ROUTINES
+1 SET AFSLZROS="0000000000"
+2 DO ^XBCLS
+3 WRITE !,"We must do the following checks on the payment batch(es):"
+4 WRITE !!,"1 ... Check all payments if corrupt or not recorded in the document."
+5 WRITE !,"2 ... Check all payments for PAY NAME vs. PAY-ID"
+6 WRITE !,"3 ... List and verify 'hash' totals for each batch."
+7 WRITE !,"4 ... Check each batch for blank/incomplete payments.",!
+8 READ !,"NOW PRESS RETURN TO BEGIN",AFSLRTNX:300
+9 DO ^XBCLS
+10 DO CRTSETUP^AFSLCRTS
+11 IF '$DATA(AFSLDDX)
SET AFSLDDX=""
+12 SET DY=2
+13 SET DX=28
+14 XECUTE XY
+15 WRITE @AFSLRVON,"1166 AFP DATA ENTRY",@AFSLRVOF
+16 SET DY=3
+17 SET DX=21
+18 XECUTE XY
+19 WRITE @AFSLRVON,"PAYMENT RECORD CHECK PROCESS",@AFSLRVOF
+20 SET DY=23
+21 SET DX=23
+22 XECUTE XY
+23 WRITE AFSLDDX
+24 HANG 2
+25 SET AFSLDDX=""
NDE ;
+1 SET AFSLNXT="E"
+2 IF AFSLNXT=""
SET AFSLNXT="Q"
+3 IF $EXTRACT(AFSLNXT,1)'="E"
GOTO ENDIT
+4 SET AFSLANSD="E"
NDEYR ;
+1 SET AFSLSQNO="0000"
+2 SET DY=23
+3 SET DX=23
+4 XECUTE XY
+5 WRITE " "
+6 SET DY=9
+7 SET DX=8
+8 XECUTE XY
+9 ;Begin Y2k fix IHS/DSD/HJT 1/27/1999
+10 ;W "FISCAL YR: **"
+11 ;Need 4 *'s to designate 4 yr date HJT 1/27/99
WRITE "FISCAL YR: ****"
+12 ;End Y2k fix
+13 SET DX=19
+14 ;Begin Y2K fix ;IHS/DSD/JLG 12/28/98
+15 ;This code has been changed to request a 4 digit year.
+16 ;After tag LOOK rtn AFSLYRLU is called which stores AFSLFYR as the
+17 ;.01 field of 9002325 which is being changed to 4 digit year
+18 ;S AFSLCHRS=2
+19 ;Y2000
SET AFSLCHRS=4
+20 XECUTE XY
+21 DO READCHRS^AFSLSRDR
+22 SET AFSLFYR=AFSLVOUT
+23 IF AFSLFYR["^"
SET AFSLANSD="Q"
GOTO ENDIT
+24 IF AFSLFYR["?"
Begin DoDot:1
+25 SET DX=26
+26 XECUTE XY
+27 ;W @AFSLRVON,"ENTER A 2 DIGIT YR UNDER WHICH BATCH IS FILED ",@AFSLRVOF
+28 ;Y2000
WRITE @AFSLRVON,"ENTER A 4 DIGIT YR UNDER WHICH BATCH IS FILED ",@AFSLRVOF
+29 HANG 3
+30 XECUTE XY
+31 WRITE " "
End DoDot:1
GOTO NDEYR
+32 ;I $L(AFSLFYR)<2 D G NDEYR
+33 ;Y2000
IF $LENGTH(AFSLFYR)<4
Begin DoDot:1
+34 SET DX=26
+35 XECUTE XY
+36 ;Y2000
WRITE @AFSLRVON,"ENTER 4 DIGIT YR UNDER WHICH BATCH IS FILED ",@AFSLRVOF
+37 ;W @AFSLRVON,"ENTER 2 DIGIT YR UNDER WHICH BATCH IS FILED ",@AFSLRVOF
+38 ;End Y2K fix
+39 HANG 3
+40 XECUTE XY
+41 WRITE " "
End DoDot:1
GOTO NDEYR
+42 SET DX=19
+43 XECUTE XY
+44 WRITE @AFSLRVON,AFSLFYR,@AFSLRVOF
+45 SET DY=9
+46 SET DX=24
+47 XECUTE XY
+48 WRITE " BATCH: ******"
+49 SET DX=35
+50 SET AFSLCHRS=6
+51 XECUTE XY
+52 DO READCHRS^AFSLSRDR
+53 SET AFSLSCHD=AFSLVOUT
+54 IF AFSLSCHD["^"
SET AFSLANSD="Q"
GOTO ENDIT
+55 SET AFSLLNTH=$LENGTH(AFSLSCHD)
SET AFSLZLTH=6-AFSLLNTH
+56 IF AFSLZLTH<0
Begin DoDot:1
+57 SET AFSLZFIL=$EXTRACT($$ZERO^AFSLUTLM(50),1,AFSLZLTH)
+58 SET AFSLSCHD=AFSLZFIL_AFSLSCHD
End DoDot:1
+59 SET DX=35
+60 XECUTE XY
+61 WRITE @AFSLRVON,AFSLSCHD,@AFSLRVOF
+62 SET AFSLSCHE=AFSLSCHD
+63 IF AFSLSCHE["^"
SET AFSLANSD="Q"
GOTO ENDIT
+64 SET AFSLLNTH=$LENGTH(AFSLSCHE)
+65 SET AFSLZLTH=6-AFSLLNTH
+66 IF AFSLZLTH<0
Begin DoDot:1
+67 SET AFSLZFIL=$EXTRACT($$ZERO^AFSLUTLM(50),1,AFSLZLTH)
+68 SET AFSLSCHE=AFSLZFIL_AFSLSCHE
End DoDot:1
+69 IF AFSLSQNO["^"
SET AFSLANSD="Q"
GOTO ENDIT
+70 SET AFSLLNTH=$LENGTH(AFSLSQNO)
+71 SET AFSLZLTH=4-AFSLLNTH
+72 IF AFSLZLTH>0
Begin DoDot:1
+73 SET AFSLZFIL=$EXTRACT($$ZERO^AFSLUTLM(50),1,AFSLZLTH)
+74 SET AFSLSQNO=AFSLZFIL_AFSLSQNO
End DoDot:1
+75 SET DX=75
+76 XECUTE XY
+77 WRITE @AFSLRVON,AFSLSQNO,@AFSLRVOF
LOOPS ;
+1 IF AFSLANSD="Q"
QUIT
+2 SET AFSLSQNO="0000"
+3 SET AFSLSQNO="0000"
+4 IF AFSLANSD="Q"
QUIT
+5 DO PMTLOOP
+6 IF $GET(AFSLANSD)="Q"
KILL AFSLANSD
QUIT
+7 QUIT
PMTLOOP ;
+1 SET AFSLSQNO=$EXTRACT($$ZERO^AFSLUTLM(4),1,4-$LENGTH(AFSLSQNO))_AFSLSQNO
LOOK ;
+1 DO ^AFSLYRLU
+2 IF Y="-1"
SET AFSLDDX="INVALID FISCAL YR "
GOTO EN1
+3 DO ^AFSLSCLU
+4 IF Y="-1"
SET AFSLDDX="INVALID BATCH "
GOTO EN1
PMTLOOP2 ;
+1 IF '$ORDER(^AFSLAFP(AFSLYNOD,1,AFSLSNOD,1,"B",AFSLSQNO))
QUIT
+2 SET AFSLSQNO=$ORDER(^AFSLAFP(AFSLYNOD,1,AFSLSNOD,1,"B",AFSLSQNO))
+3 SET DY=9
+4 SET DX=75
+5 XECUTE XY
+6 WRITE @AFSLRVON,AFSLSQNO,@AFSLRVOF
+7 DO ^AFSLSQLU
+8 IF Y="-1"
SET AFSLDDX="INVALID SEQUENCE "
GOTO EN1
+9 SET $PIECE(AFSLNZRO,U,30)=""
CKSEQ ;EIN
+1 SET AFSLEINO=$PIECE(AFSLNZRO,U,10)
+2 IF AFSLEINO=""
SET AFSLPEIN=""
GOTO CKSEQ1
+3 IF '$DATA(^AUTTVNDR(AFSLEINO,11))
GOTO CKSEQ2
+4 SET AFSLPEIN=$PIECE(^AUTTVNDR(AFSLEINO,11),U,1)
+5 SET AFSLPSFX=$PIECE(^AUTTVNDR(AFSLEINO,11),U,2)
+6 SET AFSLVEIN=AFSLPEIN_AFSLPSFX
CKSEQ1 ;SSN
+1 SET AFSLSSNO=$PIECE(AFSLNZRO,U,24)
+2 IF AFSLSSNO=""
SET AFSLSSN=""
GOTO CKSEQ1A
+3 IF '$DATA(^VA(200,AFSLSSNO,0))
SET AFSLSSN=""
GOTO CKSEQ1A
+4 ;S AFSLSSN=$P(^VA(200,AFSLSSNO,0),U,1) ;ACR*2.1*19.02 IM16848
+5 ;ACR*2.1*19.02 IM16848
SET AFSLSSN=$$NAME2^ACRFUTL1(AFSLSSNO)
CKSEQ1A ;PAY NAME
+1 IF '$DATA(AFSLNOD1)
Begin DoDot:1
+2 SET AFSLHERR=1
+3 SET DY=17
+4 SET DX=12
+5 XECUTE XY
+6 WRITE @AFSLRVON,"THIS PAYMENT RECORD IS CORRUPTED. DELETE IT & RE-ENTER.",@AFSLRVOF
DO PRESS
SET AFSLNOD1="^^^^^^^^^^^^^^^^^^^^"
End DoDot:1
+7 SET AFSLPNAM=$PIECE(AFSLNOD1,U,4)
CKSEQ1B ;PAY-ID
+1 SET AFSLPID=$PIECE(AFSLNOD1,U,22)
CKSEQ2 ;
+1 SET DY=11
+2 SET DX=13
+3 XECUTE XY
+4 WRITE "FOUND FYR: ",AFSLFYR," BATCH: ",AFSLSCHD," SEQUENCE: ",AFSLSQNO
+5 SET AFSLCAN=""
+6 SET AFSLOBJ=""
+7 SET AFSLPTY=""
+8 SET AFSLDTY=""
+9 SET DY=13
SET DX=6
+10 XECUTE XY
+11 WRITE "DOC REF: ",$PIECE(AFSLNZRO,U,5)
+12 SET DX=45
+13 XECUTE XY
+14 WRITE "DOCUMENT: ",$PIECE(AFSLNZRO,U,20)
+15 SET DY=14
SET DX=6
+16 XECUTE XY
+17 WRITE "OTH REF: ",$PIECE(AFSLNZRO,U,6)
+18 SET DX=45
+19 XECUTE XY
+20 WRITE "OTH DOC#: ",$PIECE(AFSLNZRO,U,21)
+21 SET AFSLCAN=$PIECE(AFSLNZRO,U,7)
+22 IF AFSLCAN'=""
SET AFSLCAN=$PIECE(^AUTTCAN(AFSLCAN,0),U,1)
+23 SET AFSLOBJ=$PIECE(AFSLNZRO,U,8)
+24 IF AFSLOBJ'=""
SET AFSLOBJ=$PIECE(^AUTTOBJC(AFSLOBJ,0),U,1)
+25 SET DY=15
SET DX=6
+26 XECUTE XY
+27 WRITE "CAN NUM: ",AFSLCAN
+28 SET DX=45
+29 XECUTE XY
+30 WRITE "OBJ CLAS: ",AFSLOBJ
+31 SET AFSLPTY=$PIECE(AFSLNZRO,U,22)
SET AFSLTYPE=AFSLPTY
+32 IF AFSLPTY'=""
SET AFSLPTY=$PIECE(^AFSLPTYP(AFSLPTY,0),U,2)
+33 SET AFSLPTYP=AFSLPTY
+34 SET AFSLDTY=$PIECE(AFSLNZRO,U,9)
+35 SET DY=16
SET DX=6
+36 XECUTE XY
+37 WRITE "DOC TYP: ",AFSLDTY
+38 SET DX=26
+39 XECUTE XY
+40 WRITE "AMOUNT: ",$PIECE(AFSLNZRO,U,11)
+41 SET DX=45
+42 XECUTE XY
+43 WRITE "PAY TYPE: ",AFSLPTY
CKPYX ;
+1 IF '$DATA(AFSLVEIN)
SET AFSLVEIN=""
+2 SET DY=19
SET DX=8
+3 XECUTE XY
+4 FOR M=1:1:32
WRITE " "
+5 SET DX=44
+6 XECUTE XY
+7 FOR M=1:1:12
WRITE " "
+8 SET DX=66
+9 XECUTE XY
+10 FOR M=1:1:12
WRITE " "
+11 SET DY=20
SET DX=66
+12 XECUTE XY
+13 FOR M=1:1:12
WRITE " "
+14 SET DY=19
SET DX=2
+15 XECUTE XY
+16 WRITE "NAME: ",AFSLPNAM
+17 SET DX=40
+18 XECUTE XY
+19 WRITE "ID: ",AFSLPID
+20 SET DX=58
+21 XECUTE XY
+22 WRITE "VN-EIN: ",AFSLVEIN
+23 SET DY=20
SET DX=58
+24 XECUTE XY
+25 WRITE "TV-SSN: ",AFSLSSN
+26 SET AFSLDELX="N"
+27 IF '$DATA(AFSLNOD1)!('$DATA(AFSLNZRO))
Begin DoDot:1
+28 SET AFSLHERR=1
+29 SET DY=17
SET DX=12
+30 XECUTE XY
+31 WRITE @AFSLRVON,"THIS PAYMENT RECORD IS CORRUPTED. DELETE IT & RE-ENTER.",@AFSLRVOF
+32 DO PRESS
End DoDot:1
QUIT
+33 IF $PIECE(AFSLNOD1,U,15)=""
Begin DoDot:1
+34 SET AFSLHERR=1
+35 SET DY=17
SET DX=12
+36 XECUTE XY
+37 WRITE @AFSLRVON,"THIS PAYMENT NOT RECORDED IN DOCUMENT. DELETE IT & RE-ENTER.",@AFSLRVOF
+38 DO PRESS
End DoDot:1
QUIT
+39 IF $PIECE(AFSLNZRO,U,27)="D"
Begin DoDot:1
+40 SET AFSLHERR=1
+41 SET DY=17
SET DX=12
+42 XECUTE XY
+43 WRITE @AFSLRVON,"***** MARKED BY C.O. TO BE WITHHELD FROM EXPORT *****",@AFSLRVOF
+44 DO PRESS
End DoDot:1
QUIT
+45 IF AFSLVEIN=""
GOTO PMTLOOP2
+46 SET X=AFSLPNAM
+47 DO ^AFSLPYCR
+48 GOTO PMTLOOP2
+49 QUIT
ENDIT ;
+1 DO ENDIT^AFSLKEDT
+2 QUIT
PRESS ;
+1 SET DY=23
SET DX=2
+2 XECUTE XY
+3 WRITE @AFSLRVON,"PRESS RETURN",@AFSLRVOF
READ AFSLRTNX:300
+4 SET DX=2
+5 XECUTE XY
+6 WRITE " "
+7 KILL AFSLDDX
+8 SET DY=17
SET DX=12
+9 XECUTE XY
WRITE " "
+10 QUIT
