Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FBAAFR

FBAAFR.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. FILERR(FBIENS,FBRRMK) ; File Remittance Remakrs
  1. ;
  1. ; Input
  1. ; FBIENS - required, internal entry numbers for subfile 162.03
  1. ; in standard format as specified for FileMan DBS calls
  1. ; FBRRMK - required, array passed by reference
  1. ; array of remittance remarks to file
  1. ; array does not have to contain any data or be defined
  1. ; format
  1. ; FBRRMK(FBADJ,#)=FBRRMKC
  1. ; where
  1. ; FBADJ = Adjustment Reason Code IEN
  1. ; # = sequentially assigned number starting with 1
  1. ; FBRRMKC = remittance remark (internal value file 162.93)
  1. ; Output
  1. ; Data in File 162.03 will be modified
  1. ;
  1. N FB,FBFDA,FBI,FBSIENS,FBADJ,CNTR,ADJDA
  1. ;
  1. ; delete remitance remarks currently on file
  1. D GETS^DIQ(162.03,FBIENS,"53*","","FB")
  1. K FBFDA
  1. S FBSIENS="" F S FBSIENS=$O(FB(162.08,FBSIENS)) Q:FBSIENS="" D
  1. . S FBFDA(162.08,FBSIENS,.01)="@"
  1. I $D(FBFDA) D FILE^DIE("","FBFDA")
  1. ;
  1. ; file remarks from input array
  1. K FBFDA
  1. ;FB*3.5*158
  1. S (FBADJ,CNTR)=0
  1. D DA^DILF(FBIENS,.FBDA)
  1. F S FBADJ=$O(FBRRMK(FBADJ)) Q:'FBADJ D
  1. . ;S ADJDA=$$GETADJI(FBADJ,.FBDA)
  1. . S ADJDA=$S(FBADJ'=999:$$GETADJI(FBADJ,.FBDA),1:FBADJ) ;999 indicates a CARCless RARC
  1. . S FBI=0
  1. . F S FBI=$O(FBRRMK(FBADJ,FBI)) Q:'FBI D
  1. . . S CNTR=CNTR+1
  1. . . S FBFDA(162.08,"+"_CNTR_","_FBIENS,.01)=$P(FBRRMK(FBADJ,FBI),U)
  1. . . S FBFDA(162.08,"+"_CNTR_","_FBIENS,1)=ADJDA
  1. I $D(FBFDA) D UPDATE^DIE("","FBFDA")
  1. Q
  1. ;
  1. GETADJI(ADJI,FBDA) ; get correct DA from ADJUSTMENT multiple
  1. ;
  1. N DA
  1. I $D(FBDA)'=11 Q ""
  1. S DA=""
  1. I $G(FBDA),$G(FBDA(1)),$G(FBDA(2)),$G(FBDA(3)),$G(ADJI) D
  1. . I $D(^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,FBDA,7,"B",ADJI)) D
  1. . . S DA=$O(^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,FBDA,7,"B",ADJI,DA))
  1. Q DA
  1. ;
  1. LOADRR(FBIENS,FBRRMK) ; Load Remittance Remarks
  1. ; Input
  1. ; FBIENS - required, internal entry numbers for subfile 162.03
  1. ; in standard format as specified for FileMan DBS calls
  1. ; FBRRMK - required, array passed by reference
  1. ; array to load adjustments into
  1. ; Output
  1. ; FBRRMK - the FBRRMK input array passed by reference will be modified
  1. ; format
  1. ; FBRRMK(ADJI,#)=FBRRMKC
  1. ; where
  1. ; ADJI = ADJUSTMENT REASON IEN
  1. ; # = sequentially assigned number starting with 1
  1. ; FBRRMKC = remittance remark (internal value file 162.93)
  1. ; if no remarks are on file then the array will be undefined
  1. N FB,FBC,FBI,FBSIENS,FBDA,RRI,ADJMI,ADJI
  1. ;
  1. K FBRRMK
  1. ;
  1. S FBC=0,ADJMI=""
  1. D DA^DILF(FBIENS,.FBDA)
  1. I $D(FBDA)'=11 Q
  1. D GETS^DIQ(162.03,FBIENS,"53*","I","FB")
  1. S FBSIENS=""
  1. F S FBSIENS=$O(FB(162.08,FBSIENS)) Q:FBSIENS="" D
  1. . S RRI=FB(162.08,FBSIENS,.01,"I")
  1. . S ADJMI=FB(162.08,FBSIENS,1,"I")
  1. . I ADJMI,$D(^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,FBDA,7,ADJMI,0)) D
  1. . . S ADJI=$P(^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,FBDA,7,ADJMI,0),U)
  1. . E S ADJI=999
  1. . S FBC=$S($D(FBRRMK(ADJI)):$O(FBRRMK(ADJI,FBC)),1:0)
  1. . S FBRRMK(ADJI,FBC+1)=RRI
  1. ;
  1. Q
  1. ;
  1. RRL(FBIENS) ; Remittance Remarks List Extrinsic Function
  1. ; Input
  1. ; FBIENS - required, internal entry numbers for subfile 162.03
  1. ; in standard format as specified for FileMan DBS calls
  1. ; Result
  1. ; string containing sorted list (by external code) of remarks
  1. ; format
  1. ; FBRRMKCE 1, FBRRMKCE 2
  1. ; where
  1. ; FBRRMKCE = remittance remark code (external value)
  1. N FBRET,FBRRMK
  1. D LOADRR^FBAAFR(FBIENS,.FBRRMK)
  1. S FBRET=$$RRL^FBUTL4(.FBRRMK)
  1. Q FBRET
  1. ;
  1. KILLRR(X,DA) ; Called from FEE BASIS PAYMENT (#162),
  1. ; ADJUSTMENT (#162.03,52), ADJUSTMENT REASON (162.07, .01)
  1. ; to delete remittance remarks associated with adjustment
  1. ; reasons being deleted.
  1. ;
  1. N FBIENS,FB,FBFDA,FBSIENS
  1. ;
  1. S FBIENS=$G(DA(1))_","_$G(DA(2))_","_$G(DA(3))_","_$G(DA(4))_","
  1. D GETS^DIQ(162.03,FBIENS,"53*","","FB")
  1. ;
  1. S FBSIENS="" F S FBSIENS=$O(FB(162.08,FBSIENS)) Q:FBSIENS="" D
  1. . I FB(162.08,FBSIENS,1)=$G(DA) S FBFDA(162.08,FBSIENS,.01)="@"
  1. I $D(FBFDA) D FILE^DIE("","FBFDA")
  1. ;
  1. Q
  1. ;
  1. FILERRCP(FBIENS,FBRRMK) ; File Remittance Remakrs
  1. ;
  1. ; Input
  1. ; FBIENS - required, internal entry numbers for subfile 162.03
  1. ; in standard format as specified for FileMan DBS calls
  1. ; FBRRMK - required, array passed by reference
  1. ; array of remittance remarks to file
  1. ; array does not have to contain any data or be defined
  1. ; format
  1. ; FBRRMK(#)=FBRRMKC
  1. ; where
  1. ; # = sequentially assigned number starting with 1
  1. ; FBRRMKC = remittance remark (internal value file 162.93)
  1. ; Output
  1. ; Data in File 162.03 will be modified
  1. ;
  1. N FB,FBFDA,FBI,FBSIENS
  1. ;
  1. ; delete remitance remarks currently on file
  1. D GETS^DIQ(162.03,FBIENS,"53*","","FB")
  1. K FBFDA
  1. S FBSIENS="" F S FBSIENS=$O(FB(162.08,FBSIENS)) Q:FBSIENS="" D
  1. . S FBFDA(162.08,FBSIENS,.01)="@"
  1. I $D(FBFDA) D FILE^DIE("","FBFDA")
  1. ;
  1. ; file remarks from input array
  1. K FBFDA
  1. S FBI=0 F S FBI=$O(FBRRMK(FBI)) Q:'FBI D
  1. . S FBFDA(162.08,"+"_FBI_","_FBIENS,.01)=$P(FBRRMK(FBI),U)
  1. I $D(FBFDA) D UPDATE^DIE("","FBFDA")
  1. ;
  1. Q
  1. ;
  1. ;FBAAFR