- FBCHFR ;WOIFO/SAB-FILE REMITTANCE REMARKS FOR CH/CNH PAYMENT ;7/17/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 Remarks
- ;
- ; Input
- ; FBIENS - required, internal entry numbers for subfile 162.5
- ; 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 IEN (#161.91)
- ; # = sequentially assigned number starting with 1
- ; FBRRMKC = remittance remark (internal value file 162.93)
- ; Output
- ; Data in File 162.5 will be modified
- ;
- N FB,FBFDA,FBI,FBSIENS
- ;
- ; delete remitance remarks currently on file
- D GETS^DIQ(162.5,FBIENS,"59*","","FB")
- K FBFDA
- S FBSIENS="" F S FBSIENS=$O(FB(162.559,FBSIENS)) Q:FBSIENS="" D
- . S FBFDA(162.559,FBSIENS,.01)="@"
- I $D(FBFDA) D FILE^DIE("","FBFDA")
- ;
- ; file remarks from input array
- K FBFDA
- S (FBADJ,CNTR)=0
- D DA^DILF(FBIENS,.FBDA)
- F S FBADJ=$O(FBRRMK(FBADJ)) Q:'FBADJ D
- . 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.559,"+"_CNTR_","_FBIENS,.01)=$P(FBRRMK(FBADJ,FBI),U)
- . . S FBFDA(162.559,"+"_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)'=1 Q ""
- S DA=""
- I $G(ADJI),$D(^FBAAI(FBDA,8,"B",ADJI)) D
- . S DA=$O(^FBAAI(FBDA,8,"B",ADJI,DA))
- Q DA
- ;
- LOADRR(FBIENS,FBRRMK) ; Load Remittance Remarks
- ; Input
- ; FBIENS - required, internal entry numbers for subfile 162.5
- ; 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(#)=FBRRMKC
- ; where
- ; # = 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 FBC,FBI,FBSIENS,ADJMI,FBDA,ADJI,RRI,FB
- ;
- K FBRRMK
- ;
- S FBC=0,ADJMI=""
- D DA^DILF(FBIENS,.FBDA)
- D GETS^DIQ(162.5,FBIENS,"59*","I","FB")
- S FBSIENS=""
- F S FBSIENS=$O(FB(162.559,FBSIENS)) Q:FBSIENS="" D
- . S RRI=FB(162.559,FBSIENS,.01,"I")
- . S ADJMI=FB(162.559,FBSIENS,1,"I")
- . I ADJMI,$D(^FBAAI(FBDA,8,ADJMI,0)) S ADJI=$P(^FBAAI(FBDA,8,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 number for file 162.5
- ; 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^FBCHFR(FBIENS,.FBRRMK)
- S FBRET=$$RRL^FBUTL4(.FBRRMK)
- Q FBRET
- ;
- KILLRR(X,DA) ; Called from FEE BASIS INVOICE (#162.5),
- ; ADJUSTMENT (#58), ADJUSTMENT REASON (.01)
- ; to delete REMITTANCE REMARK (#59) entries associated
- ; with adjustment reasons being deleted.
- ;
- N FBIENS,FB,FBFDA,FBSIENS
- ;
- S FBIENS=$G(DA(1))_","
- D GETS^DIQ(162.5,FBIENS,"59*","","FB")
- ;
- S FBSIENS="" F S FBSIENS=$O(FB(162.559,FBSIENS)) Q:FBSIENS="" D
- . I FB(162.559,FBSIENS,1)=$G(DA) S FBFDA(162.559,FBSIENS,.01)="@"
- I $D(FBFDA) D FILE^DIE("","FBFDA")
- ;
- Q
- ;FBCHFR
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBCHFR 4044 printed Feb 18, 2025@23:24:11 Page 2
- FBCHFR ;WOIFO/SAB-FILE REMITTANCE REMARKS FOR CH/CNH PAYMENT ;7/17/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 Remarks
- +1 ;
- +2 ; Input
- +3 ; FBIENS - required, internal entry numbers for subfile 162.5
- +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 IEN (#161.91)
- +12 ; # = sequentially assigned number starting with 1
- +13 ; FBRRMKC = remittance remark (internal value file 162.93)
- +14 ; Output
- +15 ; Data in File 162.5 will be modified
- +16 ;
- +17 NEW FB,FBFDA,FBI,FBSIENS
- +18 ;
- +19 ; delete remitance remarks currently on file
- +20 DO GETS^DIQ(162.5,FBIENS,"59*","","FB")
- +21 KILL FBFDA
- +22 SET FBSIENS=""
- FOR
- SET FBSIENS=$ORDER(FB(162.559,FBSIENS))
- if FBSIENS=""
- QUIT
- Begin DoDot:1
- +23 SET FBFDA(162.559,FBSIENS,.01)="@"
- End DoDot:1
- +24 IF $DATA(FBFDA)
- DO FILE^DIE("","FBFDA")
- +25 ;
- +26 ; file remarks from input array
- +27 KILL FBFDA
- +28 SET (FBADJ,CNTR)=0
- +29 DO DA^DILF(FBIENS,.FBDA)
- +30 FOR
- SET FBADJ=$ORDER(FBRRMK(FBADJ))
- if 'FBADJ
- QUIT
- Begin DoDot:1
- +31 ;999 indicates a CARCless RARC
- SET ADJDA=$SELECT(FBADJ'=999:$$GETADJI(FBADJ,.FBDA),1:FBADJ)
- +32 SET FBI=0
- +33 FOR
- SET FBI=$ORDER(FBRRMK(FBADJ,FBI))
- if 'FBI
- QUIT
- Begin DoDot:2
- +34 SET CNTR=CNTR+1
- +35 SET FBFDA(162.559,"+"_CNTR_","_FBIENS,.01)=$PIECE(FBRRMK(FBADJ,FBI),U)
- +36 SET FBFDA(162.559,"+"_CNTR_","_FBIENS,1)=ADJDA
- End DoDot:2
- End DoDot:1
- +37 IF $DATA(FBFDA)
- DO UPDATE^DIE("","FBFDA")
- +38 ;
- +39 QUIT
- +40 ;
- GETADJI(ADJI,FBDA) ; get correct DA from ADJUSTMENT multiple
- +1 ;
- +2 NEW DA
- +3 IF $DATA(FBDA)'=1
- QUIT ""
- +4 SET DA=""
- +5 IF $GET(ADJI)
- IF $DATA(^FBAAI(FBDA,8,"B",ADJI))
- Begin DoDot:1
- +6 SET DA=$ORDER(^FBAAI(FBDA,8,"B",ADJI,DA))
- End DoDot:1
- +7 QUIT DA
- +8 ;
- LOADRR(FBIENS,FBRRMK) ; Load Remittance Remarks
- +1 ; Input
- +2 ; FBIENS - required, internal entry numbers for subfile 162.5
- +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(#)=FBRRMKC
- +10 ; where
- +11 ; # = sequentially assigned number starting with 1
- +12 ; FBRRMKC = remittance remark (internal value file 162.93)
- +13 ; if no remarks are on file then the array will be undefined
- +14 NEW FBC,FBI,FBSIENS,ADJMI,FBDA,ADJI,RRI,FB
- +15 ;
- +16 KILL FBRRMK
- +17 ;
- +18 SET FBC=0
- SET ADJMI=""
- +19 DO DA^DILF(FBIENS,.FBDA)
- +20 DO GETS^DIQ(162.5,FBIENS,"59*","I","FB")
- +21 SET FBSIENS=""
- +22 FOR
- SET FBSIENS=$ORDER(FB(162.559,FBSIENS))
- if FBSIENS=""
- QUIT
- Begin DoDot:1
- +23 SET RRI=FB(162.559,FBSIENS,.01,"I")
- +24 SET ADJMI=FB(162.559,FBSIENS,1,"I")
- +25 IF ADJMI
- IF $DATA(^FBAAI(FBDA,8,ADJMI,0))
- SET ADJI=$PIECE(^FBAAI(FBDA,8,ADJMI,0),U)
- +26 IF '$TEST
- SET ADJI=999
- +27 SET FBC=$SELECT($DATA(FBRRMK(ADJI)):$ORDER(FBRRMK(ADJI,FBC)),1:0)
- +28 SET FBRRMK(ADJI,FBC+1)=RRI
- End DoDot:1
- +29 ;
- +30 QUIT
- +31 ;
- RRL(FBIENS) ; Remittance Remarks List Extrinsic Function
- +1 ; Input
- +2 ; FBIENS - required, internal entry number for file 162.5
- +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^FBCHFR(FBIENS,.FBRRMK)
- +12 SET FBRET=$$RRL^FBUTL4(.FBRRMK)
- +13 QUIT FBRET
- +14 ;
- KILLRR(X,DA) ; Called from FEE BASIS INVOICE (#162.5),
- +1 ; ADJUSTMENT (#58), ADJUSTMENT REASON (.01)
- +2 ; to delete REMITTANCE REMARK (#59) entries associated
- +3 ; with adjustment reasons being deleted.
- +4 ;
- +5 NEW FBIENS,FB,FBFDA,FBSIENS
- +6 ;
- +7 SET FBIENS=$GET(DA(1))_","
- +8 DO GETS^DIQ(162.5,FBIENS,"59*","","FB")
- +9 ;
- +10 SET FBSIENS=""
- FOR
- SET FBSIENS=$ORDER(FB(162.559,FBSIENS))
- if FBSIENS=""
- QUIT
- Begin DoDot:1
- +11 IF FB(162.559,FBSIENS,1)=$GET(DA)
- SET FBFDA(162.559,FBSIENS,.01)="@"
- End DoDot:1
- +12 IF $DATA(FBFDA)
- DO FILE^DIE("","FBFDA")
- +13 ;
- +14 QUIT
- +15 ;FBCHFR