FBAAFA ;WOIFO/SAB-FILE ADJUSTMENTS FOR MEDICAL/ANC PAYMENT ;9/9/2003
;;3.5;FEE BASIS;**61**;JAN 30, 1995
Q
FILEADJ(FBIENS,FBADJ) ; File Adjustments
;
; Input
; FBIENS - required, internal entry numbers for subfile 162.03
; in standard format as specified for FileMan DBS calls
; FBADJ - required, array passed by reference
; array of adjustments to file
; array does not have to contain any data or be defined
; format
; FBADJ(#)=FBADJR^FBADJG^FBADJA
; where
; # = sequentially assigned number starting with 1
; FBADJR = adjustment reason (internal value file 162.91)
; FBADJG = adjustment group (internal value file 162.92)
; FBADJA = adjustment amount (dollar value)
; Output
; Data in File 162.03 will be modified
;
N FB,FBFDA,FBHIGH,FBI,FBMSR,FBSC,FBSIENS,FBTAS
;
; delete adjustment reasons currently on file
D GETS^DIQ(162.03,FBIENS,"52*","","FB")
K FBFDA
S FBSIENS="" F S FBSIENS=$O(FB(162.07,FBSIENS)) Q:FBSIENS="" D
. S FBFDA(162.07,FBSIENS,.01)="@"
I $D(FBFDA) D FILE^DIE("","FBFDA")
;
; delete suspend data currently on file
K FBFDA
S FBFDA(162.03,FBIENS,3)="@"
S FBFDA(162.03,FBIENS,3.5)="@"
S FBFDA(162.03,FBIENS,4)="@"
I $D(FBFDA) D FILE^DIE("","FBFDA")
;
; delete description of suspension currently on file
D WP^DIE(162.03,FBIENS,22,,"@")
;
; compute total amount suspended and determine most significant reason
; loop thru reasons
S (FBTAS,FBI,FBHIGH)=0,FBMSR=""
F S FBI=$O(FBADJ(FBI)) Q:'FBI D
. N FBADJA
. ; get adjustment amount for reason
. S FBADJA=$P(FBADJ(FBI),U,3)
. ; add amount to total
. S FBTAS=FBTAS+FBADJA
. ; check if reason has largest absolute $ impact
. I $FN(FBADJA,"-")>$G(FBHIGH) S FBMSR=FBI,FBHIGH=$FN(FBADJA,"-")
;
I +FBTAS=0 Q ; quit since total amount suspended is 0
;
; file adjustments from input array
K FBFDA
S FBI=0 F S FBI=$O(FBADJ(FBI)) Q:'FBI D
. S FBFDA(162.07,"+"_FBI_","_FBIENS,.01)=$P(FBADJ(FBI),U)
. S FBFDA(162.07,"+"_FBI_","_FBIENS,1)=$P(FBADJ(FBI),U,2)
. S FBFDA(162.07,"+"_FBI_","_FBIENS,2)=+$P(FBADJ(FBI),U,3)
I $D(FBFDA) D UPDATE^DIE("","FBFDA")
;
; file derived suspend data
K FBFDA
S FBFDA(162.03,FBIENS,3)=FBTAS
S FBFDA(162.03,FBIENS,3.5)=DT
I FBMSR,$P(FBADJ(FBMSR),U) S FBSC=$$GET1^DIQ(161.91,$P(FBADJ(FBMSR),U),3)
I '$G(FBSC) S FBSC=4
S FBFDA(162.03,FBIENS,4)=FBSC
I $D(FBFDA) D FILE^DIE("","FBFDA")
;
; if suspend code = 4 (other) then file description of suspension
I FBSC=4,FBMSR,$P(FBADJ(FBMSR),U) D WP^DIE(162.03,FBIENS,22,,"^FB(161.91,"_$P(FBADJ(FBMSR),U)_",4)")
D MSG^DIALOG()
;
Q
;
LOADADJ(FBIENS,FBADJ) ; Load Adjustments
; Input
; FBIENS - required, internal entry numbers for subfile 162.03
; in standard format as specified for FileMan DBS calls
; FBADJ - required, array passed by reference
; array to load adjustments into
; Output
; FBADJ - the FBADJ input array passed by reference will be modified
; format
; FBADJ(#)=FBADJR^FBADJG^FBADJA
; where
; # = sequentially assigned number starting with 1
; FBADJR = adjustment reason (internal value file 162.91)
; FBADJG = adjustment group (internal value file 162.92)
; FBADJA = adjustment amount (dollar value)
; if no adjustments are on file then the array will be
; undefined
N FB,FBC,FBI,FBSIENS
;
K FBADJ
;
S FBC=0
D GETS^DIQ(162.03,FBIENS,"52*","I","FB")
D MSG^DIALOG()
S FBSIENS="" F S FBSIENS=$O(FB(162.07,FBSIENS)) Q:FBSIENS="" D
. S FBC=FBC+1
. S FBADJ(FBC)=FB(162.07,FBSIENS,.01,"I")
. S FBADJ(FBC)=FBADJ(FBC)_U_FB(162.07,FBSIENS,1,"I")
. S FBADJ(FBC)=FBADJ(FBC)_U_FB(162.07,FBSIENS,2,"I")
;
Q
;
ADJLRA(FBIENS) ; Adjustment Reason^Amount 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 reason^amounts
; format
; FBADJE 1, FBADJE 2^FBADJA 1,FBADJA2
; where
; FBADJE = adjustment reason code (external value)
; FBADJA = adjustment amount
N FBRET,FBADJ,FBADJL,FBADJLA,FBADJLR
D LOADADJ^FBAAFA(FBIENS,.FBADJ)
S FBADJL=$$ADJL^FBUTL2(.FBADJ)
S FBADJLR=$$ADJLR^FBUTL2(FBADJL)
S FBADJLA=$$ADJLA^FBUTL2(FBADJL)
S FBRET=FBADJLR_U_FBADJLA
Q FBRET
;
;FBAAFA
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAFA 4644 printed Dec 13, 2024@01:55:26 Page 2
FBAAFA ;WOIFO/SAB-FILE ADJUSTMENTS FOR MEDICAL/ANC PAYMENT ;9/9/2003
+1 ;;3.5;FEE BASIS;**61**;JAN 30, 1995
+2 QUIT
FILEADJ(FBIENS,FBADJ) ; File Adjustments
+1 ;
+2 ; Input
+3 ; FBIENS - required, internal entry numbers for subfile 162.03
+4 ; in standard format as specified for FileMan DBS calls
+5 ; FBADJ - required, array passed by reference
+6 ; array of adjustments to file
+7 ; array does not have to contain any data or be defined
+8 ; format
+9 ; FBADJ(#)=FBADJR^FBADJG^FBADJA
+10 ; where
+11 ; # = sequentially assigned number starting with 1
+12 ; FBADJR = adjustment reason (internal value file 162.91)
+13 ; FBADJG = adjustment group (internal value file 162.92)
+14 ; FBADJA = adjustment amount (dollar value)
+15 ; Output
+16 ; Data in File 162.03 will be modified
+17 ;
+18 NEW FB,FBFDA,FBHIGH,FBI,FBMSR,FBSC,FBSIENS,FBTAS
+19 ;
+20 ; delete adjustment reasons currently on file
+21 DO GETS^DIQ(162.03,FBIENS,"52*","","FB")
+22 KILL FBFDA
+23 SET FBSIENS=""
FOR
SET FBSIENS=$ORDER(FB(162.07,FBSIENS))
if FBSIENS=""
QUIT
Begin DoDot:1
+24 SET FBFDA(162.07,FBSIENS,.01)="@"
End DoDot:1
+25 IF $DATA(FBFDA)
DO FILE^DIE("","FBFDA")
+26 ;
+27 ; delete suspend data currently on file
+28 KILL FBFDA
+29 SET FBFDA(162.03,FBIENS,3)="@"
+30 SET FBFDA(162.03,FBIENS,3.5)="@"
+31 SET FBFDA(162.03,FBIENS,4)="@"
+32 IF $DATA(FBFDA)
DO FILE^DIE("","FBFDA")
+33 ;
+34 ; delete description of suspension currently on file
+35 DO WP^DIE(162.03,FBIENS,22,,"@")
+36 ;
+37 ; compute total amount suspended and determine most significant reason
+38 ; loop thru reasons
+39 SET (FBTAS,FBI,FBHIGH)=0
SET FBMSR=""
+40 FOR
SET FBI=$ORDER(FBADJ(FBI))
if 'FBI
QUIT
Begin DoDot:1
+41 NEW FBADJA
+42 ; get adjustment amount for reason
+43 SET FBADJA=$PIECE(FBADJ(FBI),U,3)
+44 ; add amount to total
+45 SET FBTAS=FBTAS+FBADJA
+46 ; check if reason has largest absolute $ impact
+47 IF $FNUMBER(FBADJA,"-")>$GET(FBHIGH)
SET FBMSR=FBI
SET FBHIGH=$FNUMBER(FBADJA,"-")
End DoDot:1
+48 ;
+49 ; quit since total amount suspended is 0
IF +FBTAS=0
QUIT
+50 ;
+51 ; file adjustments from input array
+52 KILL FBFDA
+53 SET FBI=0
FOR
SET FBI=$ORDER(FBADJ(FBI))
if 'FBI
QUIT
Begin DoDot:1
+54 SET FBFDA(162.07,"+"_FBI_","_FBIENS,.01)=$PIECE(FBADJ(FBI),U)
+55 SET FBFDA(162.07,"+"_FBI_","_FBIENS,1)=$PIECE(FBADJ(FBI),U,2)
+56 SET FBFDA(162.07,"+"_FBI_","_FBIENS,2)=+$PIECE(FBADJ(FBI),U,3)
End DoDot:1
+57 IF $DATA(FBFDA)
DO UPDATE^DIE("","FBFDA")
+58 ;
+59 ; file derived suspend data
+60 KILL FBFDA
+61 SET FBFDA(162.03,FBIENS,3)=FBTAS
+62 SET FBFDA(162.03,FBIENS,3.5)=DT
+63 IF FBMSR
IF $PIECE(FBADJ(FBMSR),U)
SET FBSC=$$GET1^DIQ(161.91,$PIECE(FBADJ(FBMSR),U),3)
+64 IF '$GET(FBSC)
SET FBSC=4
+65 SET FBFDA(162.03,FBIENS,4)=FBSC
+66 IF $DATA(FBFDA)
DO FILE^DIE("","FBFDA")
+67 ;
+68 ; if suspend code = 4 (other) then file description of suspension
+69 IF FBSC=4
IF FBMSR
IF $PIECE(FBADJ(FBMSR),U)
DO WP^DIE(162.03,FBIENS,22,,"^FB(161.91,"_$PIECE(FBADJ(FBMSR),U)_",4)")
+70 DO MSG^DIALOG()
+71 ;
+72 QUIT
+73 ;
LOADADJ(FBIENS,FBADJ) ; Load Adjustments
+1 ; Input
+2 ; FBIENS - required, internal entry numbers for subfile 162.03
+3 ; in standard format as specified for FileMan DBS calls
+4 ; FBADJ - required, array passed by reference
+5 ; array to load adjustments into
+6 ; Output
+7 ; FBADJ - the FBADJ input array passed by reference will be modified
+8 ; format
+9 ; FBADJ(#)=FBADJR^FBADJG^FBADJA
+10 ; where
+11 ; # = sequentially assigned number starting with 1
+12 ; FBADJR = adjustment reason (internal value file 162.91)
+13 ; FBADJG = adjustment group (internal value file 162.92)
+14 ; FBADJA = adjustment amount (dollar value)
+15 ; if no adjustments are on file then the array will be
+16 ; undefined
+17 NEW FB,FBC,FBI,FBSIENS
+18 ;
+19 KILL FBADJ
+20 ;
+21 SET FBC=0
+22 DO GETS^DIQ(162.03,FBIENS,"52*","I","FB")
+23 DO MSG^DIALOG()
+24 SET FBSIENS=""
FOR
SET FBSIENS=$ORDER(FB(162.07,FBSIENS))
if FBSIENS=""
QUIT
Begin DoDot:1
+25 SET FBC=FBC+1
+26 SET FBADJ(FBC)=FB(162.07,FBSIENS,.01,"I")
+27 SET FBADJ(FBC)=FBADJ(FBC)_U_FB(162.07,FBSIENS,1,"I")
+28 SET FBADJ(FBC)=FBADJ(FBC)_U_FB(162.07,FBSIENS,2,"I")
End DoDot:1
+29 ;
+30 QUIT
+31 ;
ADJLRA(FBIENS) ; Adjustment Reason^Amount 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 reason^amounts
+6 ; format
+7 ; FBADJE 1, FBADJE 2^FBADJA 1,FBADJA2
+8 ; where
+9 ; FBADJE = adjustment reason code (external value)
+10 ; FBADJA = adjustment amount
+11 NEW FBRET,FBADJ,FBADJL,FBADJLA,FBADJLR
+12 DO LOADADJ^FBAAFA(FBIENS,.FBADJ)
+13 SET FBADJL=$$ADJL^FBUTL2(.FBADJ)
+14 SET FBADJLR=$$ADJLR^FBUTL2(FBADJL)
+15 SET FBADJLA=$$ADJLA^FBUTL2(FBADJL)
+16 SET FBRET=FBADJLR_U_FBADJLA
+17 QUIT FBRET
+18 ;
+19 ;FBAAFA
