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

FBRXFR.m

Go to the documentation of this file.
  1. FBRXFR ;WOIFO/SAB-FILE REMITTANCE REMARKS FOR PHARMACY PAYMENT ;7/17/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.11
  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 IEN (internal value from file 161.91)
  1. ; # = sequentially assigned number starting with 1
  1. ; FBRRMKC = remittance remark (internal value file 162.93)
  1. ; Output
  1. ; Data in File 162.11 will be modified
  1. ;
  1. N FB,FBFDA,FBI,FBSIENS,FBADJ,FBDA,CNTR,ADJDA
  1. ;
  1. ; delete remitance remarks currently on file
  1. D GETS^DIQ(162.11,FBIENS,"38*","IE","FB")
  1. K FBFDA
  1. S FBSIENS="" F S FBSIENS=$O(FB(162.15,FBSIENS)) Q:FBSIENS="" D
  1. . S FBFDA(162.15,FBSIENS,.01)="@"
  1. I $D(FBFDA) D FILE^DIE("","FBFDA")
  1. ;
  1. ; file remarks from input array
  1. K FBFDA
  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.15,"+"_CNTR_","_FBIENS,.01)=$P(FBRRMK(FBADJ,FBI),U)
  1. . . S FBFDA(162.15,"+"_CNTR_","_FBIENS,1)=ADJDA
  1. I $D(FBFDA) D UPDATE^DIE("","FBFDA")
  1. ;
  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(ADJI),$D(^FBAA(162.1,FBDA(1),"RX",FBDA,4,"B",ADJI)) D
  1. . S DA=$O(^FBAA(162.1,FBDA(1),"RX",FBDA,4,"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.11
  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(#)=FBRRMKC
  1. ; where
  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,ADJMI,FBDA,RRI,ADJI
  1. ;
  1. K FBRRMK
  1. ;
  1. S FBC=0,ADJMI=""
  1. D DA^DILF(FBIENS,.FBDA)
  1. D GETS^DIQ(162.11,FBIENS,"38*","I","FB")
  1. S FBSIENS=""
  1. F S FBSIENS=$O(FB(162.15,FBSIENS)) Q:FBSIENS="" D
  1. . S RRI=FB(162.15,FBSIENS,.01,"I")
  1. . S ADJMI=FB(162.15,FBSIENS,1,"I")
  1. . I ADJMI,$D(^FBAA(162.1,FBDA(1),"RX",FBDA,4,ADJMI,0)) D
  1. . . S ADJI=$P(^FBAA(162.1,FBDA(1),"RX",FBDA,4,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.11
  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^FBRXFR(FBIENS,.FBRRMK)
  1. S FBRET=$$RRL^FBUTL4(.FBRRMK)
  1. Q FBRET
  1. ;
  1. KILLRR(X,DA) ; Called from FEE BASIS PHARMACY INVOICE (#162.1),
  1. ; ADJUSTMENT (#162.11,37), ADJUSTMENT REASON (162.14, .01)
  1. ; to delete REMITTANCE REMARK (#162.11,38) entries associated
  1. ; with adjustment reasons being deleted.
  1. ;
  1. N FBIENS,FB,FBFDA,FBSIENS
  1. ;
  1. S FBIENS=$G(DA(1))_","_$G(DA(2))_","
  1. D GETS^DIQ(162.11,FBIENS,"38*","","FB")
  1. ;
  1. S FBSIENS="" F S FBSIENS=$O(FB(162.15,FBSIENS)) Q:FBSIENS="" D
  1. . I FB(162.15,FBSIENS,1)=$G(DA) S FBFDA(162.15,FBSIENS,.01)="@"
  1. I $D(FBFDA) D FILE^DIE("","FBFDA")
  1. ;
  1. Q
  1. ;FBRXFR