FBXI165A ;OI&T/LKG - POST-INIT CONVERSION FB*3.5*165 ;11/17/15 17:07
;;3.5;FEE BASIS;**165**;JAN 30, 1995;Build 7
;;Per VA Directive 6402, this routine should not be modified.
;
W !,"This FB*3.5*165 conversion routine should not be called directly." Q
;
; ICRs
; #2053 FILE^DIE
; #2054 CLEAN^DILF
; #10141 BMES^XPDUTL, MES^XPDUTL
;
IN ;Entry point for removing payment lines with populated DATE PAID
; or CANCELLATION DATE from in process but not yet transmitted batches
D BMES^XPDUTL(" Removing paid or payment cancelled payment lines from")
D MES^XPDUTL(" not yet transmitted batches.")
N FBCANDT,FBCHANGE,FBH,FBLCNT,FBPAID,FBSTATUS,FBTOTAL,FBTYPE
N FBB2L,FBB3L,FBB5L,FBB9L,FBBCTR S (FBB2L,FBB3L,FBB5L,FBB9L)=0
S FBH=0
F S FBH=$O(^FBAA(161.7,FBH)) Q:+FBH'=FBH S FBSTATUS=$P($G(^FBAA(161.7,FBH,"ST")),U) I "^T^F^V^"'[("^"_FBSTATUS_"^") D
. S FBTYPE=$P($G(^FBAA(161.7,FBH,0)),U,3) Q:"^B2^B3^B5^B9^"'[("^"_FBTYPE_"^")
. S FBCHANGE=0
. I FBTYPE="B3" D
. . N FBCHK,FBI,FBJ,FBK,FBL S (FBI,FBJ,FBK,FBL)=0
. . F S FBI=$O(^FBAAC("AC",FBH,FBI)) Q:'FBI F S FBJ=$O(^FBAAC("AC",FBH,FBI,FBJ)) Q:'FBJ F S FBK=$O(^FBAAC("AC",FBH,FBI,FBJ,FBK)) Q:'FBK F S FBL=$O(^FBAAC("AC",FBH,FBI,FBJ,FBK,FBL)) Q:'FBL D
. . . S FBPAID=$P($P($G(^FBAAC(FBI,1,FBJ,1,FBK,1,FBL,0)),U,14),".")
. . . S FBCANDT=$P($P($G(^FBAAC(FBI,1,FBJ,1,FBK,1,FBL,2)),U,4),"."),FBCHK=$P($G(^(2)),U,3)
. . . Q:FBPAID=""&(FBCANDT="")
. . . I FBCANDT="",FBPAID<3110107,FBCHK="" Q
. . . Q:FBPAID>3130306 Q:FBCANDT>3130306
. . . S FBCHANGE=1,FBB3L=FBB3L+1
. . . N FBARR,FBIENS,FBDATE,FBERR S FBIENS=FBL_","_FBK_","_FBJ_","_FBI_","
. . . S ^XTMP("FB*3.5*165","RMVPAY",162.03,FBH,FBIENS)="7^5:"_$P($G(^FBAAC(FBI,1,FBJ,1,FBK,1,FBL,0)),U,6)
. . . S FBDATE=$S(FBCANDT>FBPAID:FBCANDT,1:FBPAID)
. . . S FBARR(162.03,FBIENS,7)="@",FBARR(162.03,FBIENS,5)=FBDATE
. . . D FILE^DIE("K","FBARR","FBERR")
. . . D:$D(FBERR) MES^XPDUTL(" Error updating file 162.03 record with IENS "_FBIENS)
. I FBTYPE="B9" D
. . N FBI S FBI=0
. . F S FBI=$O(^FBAAI("AC",FBH,FBI)) Q:'FBI D
. . . S FBPAID=$P($P($G(^FBAAI(FBI,2)),U),"."),FBCANDT=$P($P($G(^(2)),U,5),".")
. . . Q:FBPAID=""&(FBCANDT="")
. . . Q:FBPAID>3130306 Q:FBCANDT>3130306
. . . S FBCHANGE=1,FBB9L=FBB9L+1
. . . N FBARR,FBIENS,FBDATE,FBERR S FBIENS=FBI_","
. . . S ^XTMP("FB*3.5*165","RMVPAY",162.5,FBH,FBIENS)="20^19:"_$P($G(^FBAAI(FBI,0)),U,16)
. . . S FBDATE=$S(FBCANDT>FBPAID:FBCANDT,1:FBPAID)
. . . S FBARR(162.5,FBIENS,20)="@",FBARR(162.5,FBIENS,19)=FBDATE
. . . D FILE^DIE("K","FBARR","FBERR")
. . . D:$D(FBERR) MES^XPDUTL(" Error updating file 162.5 record with IENS "_FBIENS)
. I FBTYPE="B2" D
. . N FBI,FBJ S (FBI,FBJ)=0
. . F S FBI=$O(^FBAAC("AD",FBH,FBI)) Q:'FBI F S FBJ=$O(^FBAAC("AD",FBH,FBI,FBJ)) Q:'FBJ D
. . . S FBPAID=$P($P($G(^FBAAC(FBI,3,FBJ,0)),U,6),".")
. . . S FBCANDT=$P($P($G(^FBAAC(FBI,3,FBJ,0)),U,8),".")
. . . Q:FBPAID=""&(FBCANDT="")
. . . Q:FBPAID>3130306 Q:FBCANDT>3130306
. . . S FBCHANGE=1,FBB2L=FBB2L+1
. . . N FBARR,FBIENS,FBERR S FBIENS=FBJ_","_FBI_","
. . . S ^XTMP("FB*3.5*165","RMVPAY",162.04,FBH,FBIENS)="1"
. . . S FBARR(162.04,FBIENS,1)="@"
. . . D FILE^DIE("K","FBARR","FBERR")
. . . D:$D(FBERR) MES^XPDUTL(" Error updating file 162.04 record with IENS "_FBIENS)
. I FBTYPE="B5" D
. . N FBI,FBJ S (FBI,FBJ)=0
. . F S FBI=$O(^FBAA(162.1,"AE",FBH,FBI)) Q:'FBI F S FBJ=$O(^FBAA(162.1,"AE",FBH,FBI,FBJ)) Q:'FBJ D
. . . S FBPAID=$P($P($G(^FBAA(162.1,FBI,"RX",FBJ,2)),U,8),".")
. . . S FBCANDT=$P($P($G(^FBAA(162.1,FBI,"RX",FBJ,2)),U,11),".")
. . . Q:FBPAID=""&(FBCANDT="")
. . . Q:FBPAID>3130306 Q:FBCANDT>3130306
. . . S FBCHANGE=1,FBB5L=FBB5L+1
. . . N FBARR,FBIENS,FBERR S FBIENS=FBJ_","_FBI_","
. . . S ^XTMP("FB*3.5*165","RMVPAY",162.11,FBH,FBIENS)="13"
. . . S FBARR(162.11,FBIENS,13)="@"
. . . D FILE^DIE("K","FBARR","FBERR")
. . . D:$D(FBERR) MES^XPDUTL(" Error updating file 162.11 record with IENS "_FBIENS)
. I FBCHANGE D
. . S:FBSTATUS="" FBSTATUS="NULL" S FBBCTR(FBSTATUS)=$G(FBBCTR(FBSTATUS))+1
. . D CNTTOT^FBAARB(FBH)
. . N FBARR,FBIENS,FBERR S FBIENS=FBH_","
. . S FBARR(161.7,FBIENS,8)=FBTOTAL,FBARR(161.7,FBIENS,10)=FBLCNT
. . I FBTYPE="B9" S FBARR(161.7,FBIENS,9)=FBLCNT
. . I FBTYPE="B5" D
. . . N FBMCNT,FBM S FBMCNT=0,FBM=""
. . . F S FBM=$O(^FBAA(162.1,"AE",FBH,FBM)) Q:FBM="" S FBMCNT=FBMCNT+1
. . . S FBARR(161.7,FBIENS,9)=FBMCNT
. . D FILE^DIE("K","FBARR","FBERR")
. . D:$D(FBERR) MES^XPDUTL(" Error updating batch file 161.7 entry with IENS "_FBIENS)
;Output statistics
D BMES^XPDUTL("*** Statistics For Removing Payments From Batches ***")
N FBCNT S FBCNT=0
S FBSTATUS=""
F S FBSTATUS=$O(FBBCTR(FBSTATUS)) Q:FBSTATUS="" D
. S FBH="Batches of Status '"_FBSTATUS_"' Updated: "_FBBCTR(FBSTATUS)
. D MES^XPDUTL(FBH)
. S FBCNT=FBCNT+FBBCTR(FBSTATUS)
D BMES^XPDUTL("Total Number of Batches Updated: "_FBCNT)
S FBH="B2 Batch Payment Lines Edited: "_FBB2L D BMES^XPDUTL(FBH)
S FBH="B3 Batch Payment Lines Edited: "_FBB3L D MES^XPDUTL(FBH)
S FBH="B5 Batch Payment Lines Edited: "_FBB5L D MES^XPDUTL(FBH)
S FBH="B9 Batch Payment Lines Edited: "_FBB9L D MES^XPDUTL(FBH)
D BMES^XPDUTL("Total Number of Payment Lines Edited: "_(FBB2L+FBB3L+FBB5L+FBB9L))
D CLEAN^DILF
Q
;
;FBXI165A
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBXI165A 5388 printed Nov 22, 2024@17:11:09 Page 2
FBXI165A ;OI&T/LKG - POST-INIT CONVERSION FB*3.5*165 ;11/17/15 17:07
+1 ;;3.5;FEE BASIS;**165**;JAN 30, 1995;Build 7
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 WRITE !,"This FB*3.5*165 conversion routine should not be called directly."
QUIT
+5 ;
+6 ; ICRs
+7 ; #2053 FILE^DIE
+8 ; #2054 CLEAN^DILF
+9 ; #10141 BMES^XPDUTL, MES^XPDUTL
+10 ;
IN ;Entry point for removing payment lines with populated DATE PAID
+1 ; or CANCELLATION DATE from in process but not yet transmitted batches
+2 DO BMES^XPDUTL(" Removing paid or payment cancelled payment lines from")
+3 DO MES^XPDUTL(" not yet transmitted batches.")
+4 NEW FBCANDT,FBCHANGE,FBH,FBLCNT,FBPAID,FBSTATUS,FBTOTAL,FBTYPE
+5 NEW FBB2L,FBB3L,FBB5L,FBB9L,FBBCTR
SET (FBB2L,FBB3L,FBB5L,FBB9L)=0
+6 SET FBH=0
+7 FOR
SET FBH=$ORDER(^FBAA(161.7,FBH))
if +FBH'=FBH
QUIT
SET FBSTATUS=$PIECE($GET(^FBAA(161.7,FBH,"ST")),U)
IF "^T^F^V^"'[("^"_FBSTATUS_"^")
Begin DoDot:1
+8 SET FBTYPE=$PIECE($GET(^FBAA(161.7,FBH,0)),U,3)
if "^B2^B3^B5^B9^"'[("^"_FBTYPE_"^")
QUIT
+9 SET FBCHANGE=0
+10 IF FBTYPE="B3"
Begin DoDot:2
+11 NEW FBCHK,FBI,FBJ,FBK,FBL
SET (FBI,FBJ,FBK,FBL)=0
+12 FOR
SET FBI=$ORDER(^FBAAC("AC",FBH,FBI))
if 'FBI
QUIT
FOR
SET FBJ=$ORDER(^FBAAC("AC",FBH,FBI,FBJ))
if 'FBJ
QUIT
FOR
SET FBK=$ORDER(^FBAAC("AC",FBH,FBI,FBJ,FBK))
if 'FBK
QUIT
FOR
SET FBL=$ORDER(^FBAAC("AC",FBH,FBI,FBJ,FBK,FBL))
if 'FBL
QUIT
Begin DoDot:3
+13 SET FBPAID=$PIECE($PIECE($GET(^FBAAC(FBI,1,FBJ,1,FBK,1,FBL,0)),U,14),".")
+14 SET FBCANDT=$PIECE($PIECE($GET(^FBAAC(FBI,1,FBJ,1,FBK,1,FBL,2)),U,4),".")
SET FBCHK=$PIECE($GET(^(2)),U,3)
+15 if FBPAID=""&(FBCANDT="")
QUIT
+16 IF FBCANDT=""
IF FBPAID<3110107
IF FBCHK=""
QUIT
+17 if FBPAID>3130306
QUIT
if FBCANDT>3130306
QUIT
+18 SET FBCHANGE=1
SET FBB3L=FBB3L+1
+19 NEW FBARR,FBIENS,FBDATE,FBERR
SET FBIENS=FBL_","_FBK_","_FBJ_","_FBI_","
+20 SET ^XTMP("FB*3.5*165","RMVPAY",162.03,FBH,FBIENS)="7^5:"_$PIECE($GET(^FBAAC(FBI,1,FBJ,1,FBK,1,FBL,0)),U,6)
+21 SET FBDATE=$SELECT(FBCANDT>FBPAID:FBCANDT,1:FBPAID)
+22 SET FBARR(162.03,FBIENS,7)="@"
SET FBARR(162.03,FBIENS,5)=FBDATE
+23 DO FILE^DIE("K","FBARR","FBERR")
+24 if $DATA(FBERR)
DO MES^XPDUTL(" Error updating file 162.03 record with IENS "_FBIENS)
End DoDot:3
End DoDot:2
+25 IF FBTYPE="B9"
Begin DoDot:2
+26 NEW FBI
SET FBI=0
+27 FOR
SET FBI=$ORDER(^FBAAI("AC",FBH,FBI))
if 'FBI
QUIT
Begin DoDot:3
+28 SET FBPAID=$PIECE($PIECE($GET(^FBAAI(FBI,2)),U),".")
SET FBCANDT=$PIECE($PIECE($GET(^(2)),U,5),".")
+29 if FBPAID=""&(FBCANDT="")
QUIT
+30 if FBPAID>3130306
QUIT
if FBCANDT>3130306
QUIT
+31 SET FBCHANGE=1
SET FBB9L=FBB9L+1
+32 NEW FBARR,FBIENS,FBDATE,FBERR
SET FBIENS=FBI_","
+33 SET ^XTMP("FB*3.5*165","RMVPAY",162.5,FBH,FBIENS)="20^19:"_$PIECE($GET(^FBAAI(FBI,0)),U,16)
+34 SET FBDATE=$SELECT(FBCANDT>FBPAID:FBCANDT,1:FBPAID)
+35 SET FBARR(162.5,FBIENS,20)="@"
SET FBARR(162.5,FBIENS,19)=FBDATE
+36 DO FILE^DIE("K","FBARR","FBERR")
+37 if $DATA(FBERR)
DO MES^XPDUTL(" Error updating file 162.5 record with IENS "_FBIENS)
End DoDot:3
End DoDot:2
+38 IF FBTYPE="B2"
Begin DoDot:2
+39 NEW FBI,FBJ
SET (FBI,FBJ)=0
+40 FOR
SET FBI=$ORDER(^FBAAC("AD",FBH,FBI))
if 'FBI
QUIT
FOR
SET FBJ=$ORDER(^FBAAC("AD",FBH,FBI,FBJ))
if 'FBJ
QUIT
Begin DoDot:3
+41 SET FBPAID=$PIECE($PIECE($GET(^FBAAC(FBI,3,FBJ,0)),U,6),".")
+42 SET FBCANDT=$PIECE($PIECE($GET(^FBAAC(FBI,3,FBJ,0)),U,8),".")
+43 if FBPAID=""&(FBCANDT="")
QUIT
+44 if FBPAID>3130306
QUIT
if FBCANDT>3130306
QUIT
+45 SET FBCHANGE=1
SET FBB2L=FBB2L+1
+46 NEW FBARR,FBIENS,FBERR
SET FBIENS=FBJ_","_FBI_","
+47 SET ^XTMP("FB*3.5*165","RMVPAY",162.04,FBH,FBIENS)="1"
+48 SET FBARR(162.04,FBIENS,1)="@"
+49 DO FILE^DIE("K","FBARR","FBERR")
+50 if $DATA(FBERR)
DO MES^XPDUTL(" Error updating file 162.04 record with IENS "_FBIENS)
End DoDot:3
End DoDot:2
+51 IF FBTYPE="B5"
Begin DoDot:2
+52 NEW FBI,FBJ
SET (FBI,FBJ)=0
+53 FOR
SET FBI=$ORDER(^FBAA(162.1,"AE",FBH,FBI))
if 'FBI
QUIT
FOR
SET FBJ=$ORDER(^FBAA(162.1,"AE",FBH,FBI,FBJ))
if 'FBJ
QUIT
Begin DoDot:3
+54 SET FBPAID=$PIECE($PIECE($GET(^FBAA(162.1,FBI,"RX",FBJ,2)),U,8),".")
+55 SET FBCANDT=$PIECE($PIECE($GET(^FBAA(162.1,FBI,"RX",FBJ,2)),U,11),".")
+56 if FBPAID=""&(FBCANDT="")
QUIT
+57 if FBPAID>3130306
QUIT
if FBCANDT>3130306
QUIT
+58 SET FBCHANGE=1
SET FBB5L=FBB5L+1
+59 NEW FBARR,FBIENS,FBERR
SET FBIENS=FBJ_","_FBI_","
+60 SET ^XTMP("FB*3.5*165","RMVPAY",162.11,FBH,FBIENS)="13"
+61 SET FBARR(162.11,FBIENS,13)="@"
+62 DO FILE^DIE("K","FBARR","FBERR")
+63 if $DATA(FBERR)
DO MES^XPDUTL(" Error updating file 162.11 record with IENS "_FBIENS)
End DoDot:3
End DoDot:2
+64 IF FBCHANGE
Begin DoDot:2
+65 if FBSTATUS=""
SET FBSTATUS="NULL"
SET FBBCTR(FBSTATUS)=$GET(FBBCTR(FBSTATUS))+1
+66 DO CNTTOT^FBAARB(FBH)
+67 NEW FBARR,FBIENS,FBERR
SET FBIENS=FBH_","
+68 SET FBARR(161.7,FBIENS,8)=FBTOTAL
SET FBARR(161.7,FBIENS,10)=FBLCNT
+69 IF FBTYPE="B9"
SET FBARR(161.7,FBIENS,9)=FBLCNT
+70 IF FBTYPE="B5"
Begin DoDot:3
+71 NEW FBMCNT,FBM
SET FBMCNT=0
SET FBM=""
+72 FOR
SET FBM=$ORDER(^FBAA(162.1,"AE",FBH,FBM))
if FBM=""
QUIT
SET FBMCNT=FBMCNT+1
+73 SET FBARR(161.7,FBIENS,9)=FBMCNT
End DoDot:3
+74 DO FILE^DIE("K","FBARR","FBERR")
+75 if $DATA(FBERR)
DO MES^XPDUTL(" Error updating batch file 161.7 entry with IENS "_FBIENS)
End DoDot:2
End DoDot:1
+76 ;Output statistics
+77 DO BMES^XPDUTL("*** Statistics For Removing Payments From Batches ***")
+78 NEW FBCNT
SET FBCNT=0
+79 SET FBSTATUS=""
+80 FOR
SET FBSTATUS=$ORDER(FBBCTR(FBSTATUS))
if FBSTATUS=""
QUIT
Begin DoDot:1
+81 SET FBH="Batches of Status '"_FBSTATUS_"' Updated: "_FBBCTR(FBSTATUS)
+82 DO MES^XPDUTL(FBH)
+83 SET FBCNT=FBCNT+FBBCTR(FBSTATUS)
End DoDot:1
+84 DO BMES^XPDUTL("Total Number of Batches Updated: "_FBCNT)
+85 SET FBH="B2 Batch Payment Lines Edited: "_FBB2L
DO BMES^XPDUTL(FBH)
+86 SET FBH="B3 Batch Payment Lines Edited: "_FBB3L
DO MES^XPDUTL(FBH)
+87 SET FBH="B5 Batch Payment Lines Edited: "_FBB5L
DO MES^XPDUTL(FBH)
+88 SET FBH="B9 Batch Payment Lines Edited: "_FBB9L
DO MES^XPDUTL(FBH)
+89 DO BMES^XPDUTL("Total Number of Payment Lines Edited: "_(FBB2L+FBB3L+FBB5L+FBB9L))
+90 DO CLEAN^DILF
+91 QUIT
+92 ;
+93 ;FBXI165A
