FBAAFR ;WOIFO/SAB-FILE REMITTANCE REMARKS FOR MEDICAL/ANC PAYMENT ;7/16/2003
;;3.5;FEE BASIS;**61,158**;JAN 30, 1995;Build 94
;;Per VA Directive 6402, this routine should not be modified.
Q
FILERR(FBIENS,FBRRMK) ; File Remittance Remakrs
;
; Input
; FBIENS - required, internal entry numbers for subfile 162.03
; in standard format as specified for FileMan DBS calls
; FBRRMK - required, array passed by reference
; array of remittance remarks to file
; array does not have to contain any data or be defined
; format
; FBRRMK(FBADJ,#)=FBRRMKC
; where
; FBADJ = Adjustment Reason Code IEN
; # = sequentially assigned number starting with 1
; FBRRMKC = remittance remark (internal value file 162.93)
; Output
; Data in File 162.03 will be modified
;
N FB,FBFDA,FBI,FBSIENS,FBADJ,CNTR,ADJDA
;
; delete remitance remarks currently on file
D GETS^DIQ(162.03,FBIENS,"53*","","FB")
K FBFDA
S FBSIENS="" F S FBSIENS=$O(FB(162.08,FBSIENS)) Q:FBSIENS="" D
. S FBFDA(162.08,FBSIENS,.01)="@"
I $D(FBFDA) D FILE^DIE("","FBFDA")
;
; file remarks from input array
K FBFDA
;FB*3.5*158
S (FBADJ,CNTR)=0
D DA^DILF(FBIENS,.FBDA)
F S FBADJ=$O(FBRRMK(FBADJ)) Q:'FBADJ D
. ;S ADJDA=$$GETADJI(FBADJ,.FBDA)
. S ADJDA=$S(FBADJ'=999:$$GETADJI(FBADJ,.FBDA),1:FBADJ) ;999 indicates a CARCless RARC
. S FBI=0
. F S FBI=$O(FBRRMK(FBADJ,FBI)) Q:'FBI D
. . S CNTR=CNTR+1
. . S FBFDA(162.08,"+"_CNTR_","_FBIENS,.01)=$P(FBRRMK(FBADJ,FBI),U)
. . S FBFDA(162.08,"+"_CNTR_","_FBIENS,1)=ADJDA
I $D(FBFDA) D UPDATE^DIE("","FBFDA")
Q
;
GETADJI(ADJI,FBDA) ; get correct DA from ADJUSTMENT multiple
;
N DA
I $D(FBDA)'=11 Q ""
S DA=""
I $G(FBDA),$G(FBDA(1)),$G(FBDA(2)),$G(FBDA(3)),$G(ADJI) D
. I $D(^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,FBDA,7,"B",ADJI)) D
. . S DA=$O(^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,FBDA,7,"B",ADJI,DA))
Q DA
;
LOADRR(FBIENS,FBRRMK) ; Load Remittance Remarks
; Input
; FBIENS - required, internal entry numbers for subfile 162.03
; in standard format as specified for FileMan DBS calls
; FBRRMK - required, array passed by reference
; array to load adjustments into
; Output
; FBRRMK - the FBRRMK input array passed by reference will be modified
; format
; FBRRMK(ADJI,#)=FBRRMKC
; where
; ADJI = ADJUSTMENT REASON IEN
; # = sequentially assigned number starting with 1
; FBRRMKC = remittance remark (internal value file 162.93)
; if no remarks are on file then the array will be undefined
N FB,FBC,FBI,FBSIENS,FBDA,RRI,ADJMI,ADJI
;
K FBRRMK
;
S FBC=0,ADJMI=""
D DA^DILF(FBIENS,.FBDA)
I $D(FBDA)'=11 Q
D GETS^DIQ(162.03,FBIENS,"53*","I","FB")
S FBSIENS=""
F S FBSIENS=$O(FB(162.08,FBSIENS)) Q:FBSIENS="" D
. S RRI=FB(162.08,FBSIENS,.01,"I")
. S ADJMI=FB(162.08,FBSIENS,1,"I")
. I ADJMI,$D(^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,FBDA,7,ADJMI,0)) D
. . S ADJI=$P(^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,FBDA,7,ADJMI,0),U)
. E S ADJI=999
. S FBC=$S($D(FBRRMK(ADJI)):$O(FBRRMK(ADJI,FBC)),1:0)
. S FBRRMK(ADJI,FBC+1)=RRI
;
Q
;
RRL(FBIENS) ; Remittance Remarks List Extrinsic Function
; Input
; FBIENS - required, internal entry numbers for subfile 162.03
; in standard format as specified for FileMan DBS calls
; Result
; string containing sorted list (by external code) of remarks
; format
; FBRRMKCE 1, FBRRMKCE 2
; where
; FBRRMKCE = remittance remark code (external value)
N FBRET,FBRRMK
D LOADRR^FBAAFR(FBIENS,.FBRRMK)
S FBRET=$$RRL^FBUTL4(.FBRRMK)
Q FBRET
;
KILLRR(X,DA) ; Called from FEE BASIS PAYMENT (#162),
; ADJUSTMENT (#162.03,52), ADJUSTMENT REASON (162.07, .01)
; to delete remittance remarks associated with adjustment
; reasons being deleted.
;
N FBIENS,FB,FBFDA,FBSIENS
;
S FBIENS=$G(DA(1))_","_$G(DA(2))_","_$G(DA(3))_","_$G(DA(4))_","
D GETS^DIQ(162.03,FBIENS,"53*","","FB")
;
S FBSIENS="" F S FBSIENS=$O(FB(162.08,FBSIENS)) Q:FBSIENS="" D
. I FB(162.08,FBSIENS,1)=$G(DA) S FBFDA(162.08,FBSIENS,.01)="@"
I $D(FBFDA) D FILE^DIE("","FBFDA")
;
Q
;
FILERRCP(FBIENS,FBRRMK) ; File Remittance Remakrs
;
; Input
; FBIENS - required, internal entry numbers for subfile 162.03
; in standard format as specified for FileMan DBS calls
; FBRRMK - required, array passed by reference
; array of remittance remarks to file
; array does not have to contain any data or be defined
; format
; FBRRMK(#)=FBRRMKC
; where
; # = sequentially assigned number starting with 1
; FBRRMKC = remittance remark (internal value file 162.93)
; Output
; Data in File 162.03 will be modified
;
N FB,FBFDA,FBI,FBSIENS
;
; delete remitance remarks currently on file
D GETS^DIQ(162.03,FBIENS,"53*","","FB")
K FBFDA
S FBSIENS="" F S FBSIENS=$O(FB(162.08,FBSIENS)) Q:FBSIENS="" D
. S FBFDA(162.08,FBSIENS,.01)="@"
I $D(FBFDA) D FILE^DIE("","FBFDA")
;
; file remarks from input array
K FBFDA
S FBI=0 F S FBI=$O(FBRRMK(FBI)) Q:'FBI D
. S FBFDA(162.08,"+"_FBI_","_FBIENS,.01)=$P(FBRRMK(FBI),U)
I $D(FBFDA) D UPDATE^DIE("","FBFDA")
;
Q
;
;FBAAFR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAFR 5539 printed Oct 16, 2024@17:56:18 Page 2
FBAAFR ;WOIFO/SAB-FILE REMITTANCE REMARKS FOR MEDICAL/ANC PAYMENT ;7/16/2003
+1 ;;3.5;FEE BASIS;**61,158**;JAN 30, 1995;Build 94
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
FILERR(FBIENS,FBRRMK) ; File Remittance Remakrs
+1 ;
+2 ; Input
+3 ; FBIENS - required, internal entry numbers for subfile 162.03
+4 ; in standard format as specified for FileMan DBS calls
+5 ; FBRRMK - required, array passed by reference
+6 ; array of remittance remarks to file
+7 ; array does not have to contain any data or be defined
+8 ; format
+9 ; FBRRMK(FBADJ,#)=FBRRMKC
+10 ; where
+11 ; FBADJ = Adjustment Reason Code IEN
+12 ; # = sequentially assigned number starting with 1
+13 ; FBRRMKC = remittance remark (internal value file 162.93)
+14 ; Output
+15 ; Data in File 162.03 will be modified
+16 ;
+17 NEW FB,FBFDA,FBI,FBSIENS,FBADJ,CNTR,ADJDA
+18 ;
+19 ; delete remitance remarks currently on file
+20 DO GETS^DIQ(162.03,FBIENS,"53*","","FB")
+21 KILL FBFDA
+22 SET FBSIENS=""
FOR
SET FBSIENS=$ORDER(FB(162.08,FBSIENS))
if FBSIENS=""
QUIT
Begin DoDot:1
+23 SET FBFDA(162.08,FBSIENS,.01)="@"
End DoDot:1
+24 IF $DATA(FBFDA)
DO FILE^DIE("","FBFDA")
+25 ;
+26 ; file remarks from input array
+27 KILL FBFDA
+28 ;FB*3.5*158
+29 SET (FBADJ,CNTR)=0
+30 DO DA^DILF(FBIENS,.FBDA)
+31 FOR
SET FBADJ=$ORDER(FBRRMK(FBADJ))
if 'FBADJ
QUIT
Begin DoDot:1
+32 ;S ADJDA=$$GETADJI(FBADJ,.FBDA)
+33 ;999 indicates a CARCless RARC
SET ADJDA=$SELECT(FBADJ'=999:$$GETADJI(FBADJ,.FBDA),1:FBADJ)
+34 SET FBI=0
+35 FOR
SET FBI=$ORDER(FBRRMK(FBADJ,FBI))
if 'FBI
QUIT
Begin DoDot:2
+36 SET CNTR=CNTR+1
+37 SET FBFDA(162.08,"+"_CNTR_","_FBIENS,.01)=$PIECE(FBRRMK(FBADJ,FBI),U)
+38 SET FBFDA(162.08,"+"_CNTR_","_FBIENS,1)=ADJDA
End DoDot:2
End DoDot:1
+39 IF $DATA(FBFDA)
DO UPDATE^DIE("","FBFDA")
+40 QUIT
+41 ;
GETADJI(ADJI,FBDA) ; get correct DA from ADJUSTMENT multiple
+1 ;
+2 NEW DA
+3 IF $DATA(FBDA)'=11
QUIT ""
+4 SET DA=""
+5 IF $GET(FBDA)
IF $GET(FBDA(1))
IF $GET(FBDA(2))
IF $GET(FBDA(3))
IF $GET(ADJI)
Begin DoDot:1
+6 IF $DATA(^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,FBDA,7,"B",ADJI))
Begin DoDot:2
+7 SET DA=$ORDER(^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,FBDA,7,"B",ADJI,DA))
End DoDot:2
End DoDot:1
+8 QUIT DA
+9 ;
LOADRR(FBIENS,FBRRMK) ; Load Remittance Remarks
+1 ; Input
+2 ; FBIENS - required, internal entry numbers for subfile 162.03
+3 ; in standard format as specified for FileMan DBS calls
+4 ; FBRRMK - required, array passed by reference
+5 ; array to load adjustments into
+6 ; Output
+7 ; FBRRMK - the FBRRMK input array passed by reference will be modified
+8 ; format
+9 ; FBRRMK(ADJI,#)=FBRRMKC
+10 ; where
+11 ; ADJI = ADJUSTMENT REASON IEN
+12 ; # = sequentially assigned number starting with 1
+13 ; FBRRMKC = remittance remark (internal value file 162.93)
+14 ; if no remarks are on file then the array will be undefined
+15 NEW FB,FBC,FBI,FBSIENS,FBDA,RRI,ADJMI,ADJI
+16 ;
+17 KILL FBRRMK
+18 ;
+19 SET FBC=0
SET ADJMI=""
+20 DO DA^DILF(FBIENS,.FBDA)
+21 IF $DATA(FBDA)'=11
QUIT
+22 DO GETS^DIQ(162.03,FBIENS,"53*","I","FB")
+23 SET FBSIENS=""
+24 FOR
SET FBSIENS=$ORDER(FB(162.08,FBSIENS))
if FBSIENS=""
QUIT
Begin DoDot:1
+25 SET RRI=FB(162.08,FBSIENS,.01,"I")
+26 SET ADJMI=FB(162.08,FBSIENS,1,"I")
+27 IF ADJMI
IF $DATA(^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,FBDA,7,ADJMI,0))
Begin DoDot:2
+28 SET ADJI=$PIECE(^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,FBDA,7,ADJMI,0),U)
End DoDot:2
+29 IF '$TEST
SET ADJI=999
+30 SET FBC=$SELECT($DATA(FBRRMK(ADJI)):$ORDER(FBRRMK(ADJI,FBC)),1:0)
+31 SET FBRRMK(ADJI,FBC+1)=RRI
End DoDot:1
+32 ;
+33 QUIT
+34 ;
RRL(FBIENS) ; Remittance Remarks List Extrinsic Function
+1 ; Input
+2 ; FBIENS - required, internal entry numbers for subfile 162.03
+3 ; in standard format as specified for FileMan DBS calls
+4 ; Result
+5 ; string containing sorted list (by external code) of remarks
+6 ; format
+7 ; FBRRMKCE 1, FBRRMKCE 2
+8 ; where
+9 ; FBRRMKCE = remittance remark code (external value)
+10 NEW FBRET,FBRRMK
+11 DO LOADRR^FBAAFR(FBIENS,.FBRRMK)
+12 SET FBRET=$$RRL^FBUTL4(.FBRRMK)
+13 QUIT FBRET
+14 ;
KILLRR(X,DA) ; Called from FEE BASIS PAYMENT (#162),
+1 ; ADJUSTMENT (#162.03,52), ADJUSTMENT REASON (162.07, .01)
+2 ; to delete remittance remarks associated with adjustment
+3 ; reasons being deleted.
+4 ;
+5 NEW FBIENS,FB,FBFDA,FBSIENS
+6 ;
+7 SET FBIENS=$GET(DA(1))_","_$GET(DA(2))_","_$GET(DA(3))_","_$GET(DA(4))_","
+8 DO GETS^DIQ(162.03,FBIENS,"53*","","FB")
+9 ;
+10 SET FBSIENS=""
FOR
SET FBSIENS=$ORDER(FB(162.08,FBSIENS))
if FBSIENS=""
QUIT
Begin DoDot:1
+11 IF FB(162.08,FBSIENS,1)=$GET(DA)
SET FBFDA(162.08,FBSIENS,.01)="@"
End DoDot:1
+12 IF $DATA(FBFDA)
DO FILE^DIE("","FBFDA")
+13 ;
+14 QUIT
+15 ;
FILERRCP(FBIENS,FBRRMK) ; File Remittance Remakrs
+1 ;
+2 ; Input
+3 ; FBIENS - required, internal entry numbers for subfile 162.03
+4 ; in standard format as specified for FileMan DBS calls
+5 ; FBRRMK - required, array passed by reference
+6 ; array of remittance remarks to file
+7 ; array does not have to contain any data or be defined
+8 ; format
+9 ; FBRRMK(#)=FBRRMKC
+10 ; where
+11 ; # = sequentially assigned number starting with 1
+12 ; FBRRMKC = remittance remark (internal value file 162.93)
+13 ; Output
+14 ; Data in File 162.03 will be modified
+15 ;
+16 NEW FB,FBFDA,FBI,FBSIENS
+17 ;
+18 ; delete remitance remarks currently on file
+19 DO GETS^DIQ(162.03,FBIENS,"53*","","FB")
+20 KILL FBFDA
+21 SET FBSIENS=""
FOR
SET FBSIENS=$ORDER(FB(162.08,FBSIENS))
if FBSIENS=""
QUIT
Begin DoDot:1
+22 SET FBFDA(162.08,FBSIENS,.01)="@"
End DoDot:1
+23 IF $DATA(FBFDA)
DO FILE^DIE("","FBFDA")
+24 ;
+25 ; file remarks from input array
+26 KILL FBFDA
+27 SET FBI=0
FOR
SET FBI=$ORDER(FBRRMK(FBI))
if 'FBI
QUIT
Begin DoDot:1
+28 SET FBFDA(162.08,"+"_FBI_","_FBIENS,.01)=$PIECE(FBRRMK(FBI),U)
End DoDot:1
+29 IF $DATA(FBFDA)
DO UPDATE^DIE("","FBFDA")
+30 ;
+31 QUIT
+32 ;
+33 ;FBAAFR
