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

FBRXFA.m

Go to the documentation of this file.
  1. FBRXFA ;WOIFO/SAB-FILE ADJUSTMENTS FOR PHARMACY PAYMENT ;9/9/2003
  1. ;;3.5;FEE BASIS;**61**;JAN 30, 1995
  1. Q
  1. FILEADJ(FBIENS,FBADJ) ; File Adjustments
  1. ;
  1. ; Input
  1. ; FBIENS - required, internal entry numbers for subfile 162.11
  1. ; in standard format as specified for FileMan DBS calls
  1. ; FBADJ - required, array passed by reference
  1. ; array of adjustments to file
  1. ; array does not have to contain any data or be defined
  1. ; format
  1. ; FBADJ(#)=FBADJR^FBADJG^FBADJA
  1. ; where
  1. ; # = sequentially assigned number starting with 1
  1. ; FBADJR = adjustment reason (internal value file 162.91)
  1. ; FBADJG = adjustment group (internal value file 162.92)
  1. ; FBADJA = adjustment amount (dollar value)
  1. ; Output
  1. ; Data in File 162.11 will be modified
  1. ;
  1. N FB,FBFDA,FBHIGH,FBI,FBMSR,FBSC,FBSIENS,FBTAS
  1. ;
  1. ; delete adjustment reasons currently on file
  1. D GETS^DIQ(162.11,FBIENS,"37*","","FB")
  1. K FBFDA
  1. S FBSIENS="" F S FBSIENS=$O(FB(162.14,FBSIENS)) Q:FBSIENS="" D
  1. . S FBFDA(162.14,FBSIENS,.01)="@"
  1. I $D(FBFDA) D FILE^DIE("","FBFDA")
  1. ;
  1. ; delete suspend data currently on file
  1. K FBFDA
  1. S FBFDA(162.11,FBIENS,6)="@"
  1. S FBFDA(162.11,FBIENS,7)="@"
  1. I $D(FBFDA) D FILE^DIE("","FBFDA")
  1. ;
  1. ; delete suspension description currently on file
  1. D WP^DIE(162.11,FBIENS,20,,"@")
  1. ;
  1. ; compute total amount suspended and determine most significant reason
  1. ; loop thru reasons
  1. S (FBTAS,FBI,FBHIGH)=0,FBMSR=""
  1. F S FBI=$O(FBADJ(FBI)) Q:'FBI D
  1. . N FBADJA
  1. . ; get adjustment amount for reason
  1. . S FBADJA=$P(FBADJ(FBI),U,3)
  1. . ; add amount to total
  1. . S FBTAS=FBTAS+FBADJA
  1. . ; check if reason has largest absolute $ impact
  1. . I $FN(FBADJA,"-")>$G(FBHIGH) S FBMSR=FBI,FBHIGH=$FN(FBADJA,"-")
  1. ;
  1. I +FBTAS=0 Q ; quit since total amount suspended is 0
  1. ;
  1. ; file adjustments from input array
  1. K FBFDA
  1. S FBI=0 F S FBI=$O(FBADJ(FBI)) Q:'FBI D
  1. . S FBFDA(162.14,"+"_FBI_","_FBIENS,.01)=$P(FBADJ(FBI),U)
  1. . S FBFDA(162.14,"+"_FBI_","_FBIENS,1)=$P(FBADJ(FBI),U,2)
  1. . S FBFDA(162.14,"+"_FBI_","_FBIENS,2)=+$P(FBADJ(FBI),U,3)
  1. I $D(FBFDA) D UPDATE^DIE("","FBFDA")
  1. ;
  1. ; file derived suspend data
  1. K FBFDA
  1. S FBFDA(162.11,FBIENS,6)=FBTAS
  1. I FBMSR,$P(FBADJ(FBMSR),U) S FBSC=$$GET1^DIQ(161.91,$P(FBADJ(FBMSR),U),3)
  1. I '$G(FBSC) S FBSC=4
  1. S FBFDA(162.11,FBIENS,7)=FBSC
  1. I $D(FBFDA) D FILE^DIE("","FBFDA")
  1. ;
  1. ; if suspend code = 4 (other) then file suspension description
  1. I FBSC=4,FBMSR,$P(FBADJ(FBMSR),U) D WP^DIE(162.11,FBIENS,20,,"^FB(161.91,"_$P(FBADJ(FBMSR),U)_",4)")
  1. D MSG^DIALOG()
  1. ;
  1. Q
  1. ;
  1. LOADADJ(FBIENS,FBADJ) ; Load Adjustments
  1. ; Input
  1. ; FBIENS - required, internal entry numbers for subfile 162.11
  1. ; in standard format as specified for FileMan DBS calls
  1. ; FBADJ - required, array passed by reference
  1. ; array to load adjustments into
  1. ; Output
  1. ; FBADJ - the FBADJ input array passed by reference will be modified
  1. ; format
  1. ; FBADJ(#)=FBADJR^FBADJG^FBADJA
  1. ; where
  1. ; # = sequentially assigned number starting with 1
  1. ; FBADJR = adjustment reason (internal value file 162.91)
  1. ; FBADJG = adjustment group (internal value file 162.92)
  1. ; FBADJA = adjustment amount (dollar value)
  1. ; if no adjustments are on file then the array will be
  1. ; undefined
  1. N FB,FBC,FBI,FBSIENS
  1. ;
  1. K FBADJ
  1. ;
  1. S FBC=0
  1. D GETS^DIQ(162.11,FBIENS,"37*","I","FB")
  1. D MSG^DIALOG()
  1. S FBSIENS="" F S FBSIENS=$O(FB(162.14,FBSIENS)) Q:FBSIENS="" D
  1. . S FBC=FBC+1
  1. . S FBADJ(FBC)=FB(162.14,FBSIENS,.01,"I")
  1. . S FBADJ(FBC)=FBADJ(FBC)_U_FB(162.14,FBSIENS,1,"I")
  1. . S FBADJ(FBC)=FBADJ(FBC)_U_FB(162.14,FBSIENS,2,"I")
  1. ;
  1. Q
  1. ;
  1. ADJLRA(FBIENS) ; Adjustment Reason^Amount 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 reason^amounts
  1. ; format
  1. ; FBADJE 1, FBADJE 2^FBADJA 1,FBADJA2
  1. ; where
  1. ; FBADJE = adjustment reason code (external value)
  1. ; FBADJA = adjustment amount
  1. N FBRET,FBADJ,FBADJL,FBADJLA,FBADJLR
  1. D LOADADJ^FBRXFA(FBIENS,.FBADJ)
  1. S FBADJL=$$ADJL^FBUTL2(.FBADJ)
  1. S FBADJLR=$$ADJLR^FBUTL2(FBADJL)
  1. S FBADJLA=$$ADJLA^FBUTL2(FBADJL)
  1. S FBRET=FBADJLR_U_FBADJLA
  1. Q FBRET
  1. ;
  1. ;FBRXFA