- 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 Jan 18, 2025@02:56:41 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