FBXI165C ;OI&T/LKG - FB*3.5*165 PAYMENT REMOVAL FROM BATCH REPORT ;11/30/15 11:28
;;3.5;FEE BASIS;**165**;JAN 30, 1995;Build 7
;;Per VA Directive 6402, this routine should not be modified.
;
; ICRs
; 2056 $$GET1^DIQ(), GETS^DIQ()
; 10103 $$FMTE^XLFDT()
I '$D(^XTMP("FB*3.5*165")) D Q
. W !,?5,"There are no entries in the compile file for the FB*3.5*165 conversion.",!?10,"The file must have been purged."
. R !,"Hit <RETURN> to continue. ",X:DTIME
N POP S %ZIS="Q" D ^%ZIS Q:POP
I $D(IO("Q")) D Q
. S ZTRTN="ENTRY^FBXI165C",ZTDESC="RPT: FB*3.5*165 PAYMENT REMOVAL FROM BATCH"
. D ^%ZTLOAD,HOME^%ZIS K ZTSK,IO("Q")
ENTRY ;
U IO
N FBABORT,FBFILE,FBBATCH,FBIENS,FBL,FBP,FBQUIT,FBSTRG,X S FBP=0,FBABORT=0
D HDR
I '$D(^XTMP("FB*3.5*165","RMVPAY")) W !!,"There are no payment entries removed from batches." G EXIT
S FBFILE="",FBBATCH="",FBIENS=""
F S FBFILE=$O(^XTMP("FB*3.5*165","RMVPAY",FBFILE)) Q:FBFILE="" D Q:FBABORT
. F S FBBATCH=$O(^XTMP("FB*3.5*165","RMVPAY",FBFILE,FBBATCH)) Q:FBBATCH="" D Q:FBABORT
. . F S FBIENS=$O(^XTMP("FB*3.5*165","RMVPAY",FBFILE,FBBATCH,FBIENS)) Q:FBIENS="" D Q:FBABORT
. . . N FBVALS
. . . S FBSTRG=^XTMP("FB*3.5*165","RMVPAY",FBFILE,FBBATCH,FBIENS)
. . . D GETDATA(FBFILE,FBBATCH,FBIENS,FBSTRG,.FBVALS)
. . . D:FBL+8>IOSL HDR Q:FBABORT
. . . W !,"BATCH TYPE: ",FBVALS("FBTYPE"),?25,"STATUS: ",$$GET1^DIQ(161.7,FBBATCH_",",11) S FBL=FBL+1
. . . W !," DATE PAID: ",FBVALS("DATE PAID"),?40,"CHECK NUMBER: ",FBVALS("CHECK") S FBL=FBL+1
. . . W !," CANCELLATION DATE: ",FBVALS("CANCEL DT") S FBL=FBL+1
. . . W !," CURRENT BATCH: ",FBVALS("BATCH"),?40,"FORMER BATCH: ",FBVALS("OLD BATCH") S FBL=FBL+1
. . . W !," DATE FINALIZED: ",FBVALS("DATE FINAL"),?40,"FORMER DATE FINAL: ",$G(FBVALS("OLD DT FINAL")) S FBL=FBL+1
EXIT I 'FBABORT W !!,"<End of Report>" R:$E(IOST,1,2)="C-" X:DTIME
W:FBABORT !!,"<Report Aborted>"
D ^%ZISC
S:$D(ZTQUEUED) ZTREQ="@"
Q
GETDATA(FBFNBR,FBBAT,FBIENS,FBSTR,FBARR) ;Returns values in FBARR
N X,Y
S FBARR("OLD BATCH")=$$GET1^DIQ(161.7,FBBAT_",",.01)
I FBFNBR=162.04 D Q
. N FBERR,FBTMP
. D GETS^DIQ(FBFNBR,FBIENS,"1;8;9;10;7","","FBTMP","FBERR")
. S FBARR("BATCH")=FBTMP(FBFNBR,FBIENS,1),FBARR("DATE PAID")=FBTMP(FBFNBR,FBIENS,8)
. S FBARR("CHECK")=FBTMP(FBFNBR,FBIENS,9),FBARR("CANCEL DT")=FBTMP(FBFNBR,FBIENS,10)
. S FBARR("DATE FINAL")=FBTMP(FBFNBR,FBIENS,7),FBARR("FBTYPE")="B2"
I FBFNBR=162.03 D Q
. N FBERR,FBTMP,FBX,X,Y
. D GETS^DIQ(FBFNBR,FBIENS,"7;12;35;36;5","","FBTMP","FBERR")
. S FBARR("BATCH")=FBTMP(FBFNBR,FBIENS,7),FBARR("DATE PAID")=FBTMP(FBFNBR,FBIENS,12)
. S FBARR("CHECK")=FBTMP(FBFNBR,FBIENS,35),FBARR("CANCEL DT")=FBTMP(FBFNBR,FBIENS,36)
. S FBARR("DATE FINAL")=FBTMP(FBFNBR,FBIENS,5),FBARR("FBTYPE")="B3"
. S FBX=$P($P(FBSTR,"^",2),":",2),X=$$FMTE^XLFDT(FBX,1) X ^%ZOSF("UPPERCASE")
. S FBARR("OLD DT FINAL")=Y
I FBFNBR=162.11 D Q
. N FBERR,FBTMP
. D GETS^DIQ(FBFNBR,FBIENS,"13;28;30;31","","FBTMP","FBERR")
. S FBARR("BATCH")=FBTMP(FBFNBR,FBIENS,13),FBARR("DATE PAID")=FBTMP(FBFNBR,FBIENS,28)
. S FBARR("CHECK")=FBTMP(FBFNBR,FBIENS,30),FBARR("CANCEL DT")=FBTMP(FBFNBR,FBIENS,31)
. S FBARR("DATE FINAL")="",FBARR("FBTYPE")="B5"
I FBFNBR=162.5 D Q
. N FBERR,FBTMP,FBX,X,Y
. D GETS^DIQ(FBFNBR,FBIENS,"20;45;48;49;19","","FBTMP","FBERR")
. S FBARR("BATCH")=FBTMP(FBFNBR,FBIENS,20),FBARR("DATE PAID")=FBTMP(FBFNBR,FBIENS,45)
. S FBARR("CHECK")=FBTMP(FBFNBR,FBIENS,48),FBARR("CANCEL DT")=FBTMP(FBFNBR,FBIENS,49)
. S FBARR("DATE FINAL")=FBTMP(FBFNBR,FBIENS,19),FBARR("FBTYPE")="B9"
. S FBX=$P($P(FBSTR,"^",2),":",2),X=$$FMTE^XLFDT(FBX,1) X ^%ZOSF("UPPERCASE")
. S FBARR("OLD DT FINAL")=Y
Q
HDR ;
I $E(IOST,1,2)="C-",FBP R !,"Hit <RETURN> to continue, '^' to Exit",FBQUIT:DTIME I FBQUIT["^" S FBABORT=1 Q
S FBP=FBP+1 W @IOF,?20,"REPORT OF PAYMENTS REMOVED FROM BATCHES",?65,"Page: ",FBP,!
S FBL=2
Q
;
;FBXI165C
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBXI165C 3950 printed Dec 13, 2024@02:00:59 Page 2
FBXI165C ;OI&T/LKG - FB*3.5*165 PAYMENT REMOVAL FROM BATCH REPORT ;11/30/15 11:28
+1 ;;3.5;FEE BASIS;**165**;JAN 30, 1995;Build 7
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; ICRs
+5 ; 2056 $$GET1^DIQ(), GETS^DIQ()
+6 ; 10103 $$FMTE^XLFDT()
+7 IF '$DATA(^XTMP("FB*3.5*165"))
Begin DoDot:1
+8 WRITE !,?5,"There are no entries in the compile file for the FB*3.5*165 conversion.",!?10,"The file must have been purged."
+9 READ !,"Hit <RETURN> to continue. ",X:DTIME
End DoDot:1
QUIT
+10 NEW POP
SET %ZIS="Q"
DO ^%ZIS
if POP
QUIT
+11 IF $DATA(IO("Q"))
Begin DoDot:1
+12 SET ZTRTN="ENTRY^FBXI165C"
SET ZTDESC="RPT: FB*3.5*165 PAYMENT REMOVAL FROM BATCH"
+13 DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK,IO("Q")
End DoDot:1
QUIT
ENTRY ;
+1 USE IO
+2 NEW FBABORT,FBFILE,FBBATCH,FBIENS,FBL,FBP,FBQUIT,FBSTRG,X
SET FBP=0
SET FBABORT=0
+3 DO HDR
+4 IF '$DATA(^XTMP("FB*3.5*165","RMVPAY"))
WRITE !!,"There are no payment entries removed from batches."
GOTO EXIT
+5 SET FBFILE=""
SET FBBATCH=""
SET FBIENS=""
+6 FOR
SET FBFILE=$ORDER(^XTMP("FB*3.5*165","RMVPAY",FBFILE))
if FBFILE=""
QUIT
Begin DoDot:1
+7 FOR
SET FBBATCH=$ORDER(^XTMP("FB*3.5*165","RMVPAY",FBFILE,FBBATCH))
if FBBATCH=""
QUIT
Begin DoDot:2
+8 FOR
SET FBIENS=$ORDER(^XTMP("FB*3.5*165","RMVPAY",FBFILE,FBBATCH,FBIENS))
if FBIENS=""
QUIT
Begin DoDot:3
+9 NEW FBVALS
+10 SET FBSTRG=^XTMP("FB*3.5*165","RMVPAY",FBFILE,FBBATCH,FBIENS)
+11 DO GETDATA(FBFILE,FBBATCH,FBIENS,FBSTRG,.FBVALS)
+12 if FBL+8>IOSL
DO HDR
if FBABORT
QUIT
+13 WRITE !,"BATCH TYPE: ",FBVALS("FBTYPE"),?25,"STATUS: ",$$GET1^DIQ(161.7,FBBATCH_",",11)
SET FBL=FBL+1
+14 WRITE !," DATE PAID: ",FBVALS("DATE PAID"),?40,"CHECK NUMBER: ",FBVALS("CHECK")
SET FBL=FBL+1
+15 WRITE !," CANCELLATION DATE: ",FBVALS("CANCEL DT")
SET FBL=FBL+1
+16 WRITE !," CURRENT BATCH: ",FBVALS("BATCH"),?40,"FORMER BATCH: ",FBVALS("OLD BATCH")
SET FBL=FBL+1
+17 WRITE !," DATE FINALIZED: ",FBVALS("DATE FINAL"),?40,"FORMER DATE FINAL: ",$GET(FBVALS("OLD DT FINAL"))
SET FBL=FBL+1
End DoDot:3
if FBABORT
QUIT
End DoDot:2
if FBABORT
QUIT
End DoDot:1
if FBABORT
QUIT
EXIT IF 'FBABORT
WRITE !!,"<End of Report>"
if $EXTRACT(IOST,1,2)="C-"
READ X:DTIME
+1 if FBABORT
WRITE !!,"<Report Aborted>"
+2 DO ^%ZISC
+3 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+4 QUIT
GETDATA(FBFNBR,FBBAT,FBIENS,FBSTR,FBARR) ;Returns values in FBARR
+1 NEW X,Y
+2 SET FBARR("OLD BATCH")=$$GET1^DIQ(161.7,FBBAT_",",.01)
+3 IF FBFNBR=162.04
Begin DoDot:1
+4 NEW FBERR,FBTMP
+5 DO GETS^DIQ(FBFNBR,FBIENS,"1;8;9;10;7","","FBTMP","FBERR")
+6 SET FBARR("BATCH")=FBTMP(FBFNBR,FBIENS,1)
SET FBARR("DATE PAID")=FBTMP(FBFNBR,FBIENS,8)
+7 SET FBARR("CHECK")=FBTMP(FBFNBR,FBIENS,9)
SET FBARR("CANCEL DT")=FBTMP(FBFNBR,FBIENS,10)
+8 SET FBARR("DATE FINAL")=FBTMP(FBFNBR,FBIENS,7)
SET FBARR("FBTYPE")="B2"
End DoDot:1
QUIT
+9 IF FBFNBR=162.03
Begin DoDot:1
+10 NEW FBERR,FBTMP,FBX,X,Y
+11 DO GETS^DIQ(FBFNBR,FBIENS,"7;12;35;36;5","","FBTMP","FBERR")
+12 SET FBARR("BATCH")=FBTMP(FBFNBR,FBIENS,7)
SET FBARR("DATE PAID")=FBTMP(FBFNBR,FBIENS,12)
+13 SET FBARR("CHECK")=FBTMP(FBFNBR,FBIENS,35)
SET FBARR("CANCEL DT")=FBTMP(FBFNBR,FBIENS,36)
+14 SET FBARR("DATE FINAL")=FBTMP(FBFNBR,FBIENS,5)
SET FBARR("FBTYPE")="B3"
+15 SET FBX=$PIECE($PIECE(FBSTR,"^",2),":",2)
SET X=$$FMTE^XLFDT(FBX,1)
XECUTE ^%ZOSF("UPPERCASE")
+16 SET FBARR("OLD DT FINAL")=Y
End DoDot:1
QUIT
+17 IF FBFNBR=162.11
Begin DoDot:1
+18 NEW FBERR,FBTMP
+19 DO GETS^DIQ(FBFNBR,FBIENS,"13;28;30;31","","FBTMP","FBERR")
+20 SET FBARR("BATCH")=FBTMP(FBFNBR,FBIENS,13)
SET FBARR("DATE PAID")=FBTMP(FBFNBR,FBIENS,28)
+21 SET FBARR("CHECK")=FBTMP(FBFNBR,FBIENS,30)
SET FBARR("CANCEL DT")=FBTMP(FBFNBR,FBIENS,31)
+22 SET FBARR("DATE FINAL")=""
SET FBARR("FBTYPE")="B5"
End DoDot:1
QUIT
+23 IF FBFNBR=162.5
Begin DoDot:1
+24 NEW FBERR,FBTMP,FBX,X,Y
+25 DO GETS^DIQ(FBFNBR,FBIENS,"20;45;48;49;19","","FBTMP","FBERR")
+26 SET FBARR("BATCH")=FBTMP(FBFNBR,FBIENS,20)
SET FBARR("DATE PAID")=FBTMP(FBFNBR,FBIENS,45)
+27 SET FBARR("CHECK")=FBTMP(FBFNBR,FBIENS,48)
SET FBARR("CANCEL DT")=FBTMP(FBFNBR,FBIENS,49)
+28 SET FBARR("DATE FINAL")=FBTMP(FBFNBR,FBIENS,19)
SET FBARR("FBTYPE")="B9"
+29 SET FBX=$PIECE($PIECE(FBSTR,"^",2),":",2)
SET X=$$FMTE^XLFDT(FBX,1)
XECUTE ^%ZOSF("UPPERCASE")
+30 SET FBARR("OLD DT FINAL")=Y
End DoDot:1
QUIT
+31 QUIT
HDR ;
+1 IF $EXTRACT(IOST,1,2)="C-"
IF FBP
READ !,"Hit <RETURN> to continue, '^' to Exit",FBQUIT:DTIME
IF FBQUIT["^"
SET FBABORT=1
QUIT
+2 SET FBP=FBP+1
WRITE @IOF,?20,"REPORT OF PAYMENTS REMOVED FROM BATCHES",?65,"Page: ",FBP,!
+3 SET FBL=2
+4 QUIT
+5 ;
+6 ;FBXI165C
