FBCHFA ;WOIFO/SAB-FILE ADJUSTMENTS FOR CH/CNH 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 file 162.5
; 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.5 will be modified
;
N FB,FBFDA,FBHIGH,FBI,FBMSR,FBSC,FBSIENS,FBTAS
;
; delete adjustment reasons currently on file
D GETS^DIQ(162.5,FBIENS,"58*","","FB")
K FBFDA
S FBSIENS="" F S FBSIENS=$O(FB(162.558,FBSIENS)) Q:FBSIENS="" D
. S FBFDA(162.558,FBSIENS,.01)="@"
I $D(FBFDA) D FILE^DIE("","FBFDA")
;
; delete suspend data currently on file
K FBFDA
S FBFDA(162.5,FBIENS,9)="@"
S FBFDA(162.5,FBIENS,10)="@"
I $D(FBFDA) D FILE^DIE("","FBFDA")
;
; delete description of suspension currently on file
D WP^DIE(162.5,FBIENS,18,,"@")
;
; 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.558,"+"_FBI_","_FBIENS,.01)=$P(FBADJ(FBI),U)
. S FBFDA(162.558,"+"_FBI_","_FBIENS,1)=$P(FBADJ(FBI),U,2)
. S FBFDA(162.558,"+"_FBI_","_FBIENS,2)=+$P(FBADJ(FBI),U,3)
I $D(FBFDA) D UPDATE^DIE("","FBFDA")
;
; file derived suspend data
K FBFDA
S FBFDA(162.5,FBIENS,9)=FBTAS
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.5,FBIENS,10)=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.5,FBIENS,18,,"^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.5
; 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.5,FBIENS,"58*","I","FB")
D MSG^DIALOG()
S FBSIENS="" F S FBSIENS=$O(FB(162.558,FBSIENS)) Q:FBSIENS="" D
. S FBC=FBC+1
. S FBADJ(FBC)=FB(162.558,FBSIENS,.01,"I")
. S FBADJ(FBC)=FBADJ(FBC)_U_FB(162.558,FBSIENS,1,"I")
. S FBADJ(FBC)=FBADJ(FBC)_U_FB(162.558,FBSIENS,2,"I")
;
Q
;
ADJLRA(FBIENS) ; Adjustment Reason^Amount 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 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^FBCHFA(FBIENS,.FBADJ)
S FBADJL=$$ADJL^FBUTL2(.FBADJ)
S FBADJLR=$$ADJLR^FBUTL2(FBADJL)
S FBADJLA=$$ADJLA^FBUTL2(FBADJL)
S FBRET=FBADJLR_U_FBADJLA
Q FBRET
;
;FBCHFA
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBCHFA 4566 printed Dec 13, 2024@01:57:43 Page 2
FBCHFA ;WOIFO/SAB-FILE ADJUSTMENTS FOR CH/CNH 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 file 162.5
+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.5 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.5,FBIENS,"58*","","FB")
+22 KILL FBFDA
+23 SET FBSIENS=""
FOR
SET FBSIENS=$ORDER(FB(162.558,FBSIENS))
if FBSIENS=""
QUIT
Begin DoDot:1
+24 SET FBFDA(162.558,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.5,FBIENS,9)="@"
+30 SET FBFDA(162.5,FBIENS,10)="@"
+31 IF $DATA(FBFDA)
DO FILE^DIE("","FBFDA")
+32 ;
+33 ; delete description of suspension currently on file
+34 DO WP^DIE(162.5,FBIENS,18,,"@")
+35 ;
+36 ; compute total amount suspended and determine most significant reason
+37 ; loop thru reasons
+38 SET (FBTAS,FBI,FBHIGH)=0
SET FBMSR=""
+39 FOR
SET FBI=$ORDER(FBADJ(FBI))
if 'FBI
QUIT
Begin DoDot:1
+40 NEW FBADJA
+41 ; get adjustment amount for reason
+42 SET FBADJA=$PIECE(FBADJ(FBI),U,3)
+43 ; add amount to total
+44 SET FBTAS=FBTAS+FBADJA
+45 ; check if reason has largest absolute $ impact
+46 IF $FNUMBER(FBADJA,"-")>$GET(FBHIGH)
SET FBMSR=FBI
SET FBHIGH=$FNUMBER(FBADJA,"-")
End DoDot:1
+47 ;
+48 ; quit since total amount suspended is 0
IF +FBTAS=0
QUIT
+49 ;
+50 ; file adjustments from input array
+51 KILL FBFDA
+52 SET FBI=0
FOR
SET FBI=$ORDER(FBADJ(FBI))
if 'FBI
QUIT
Begin DoDot:1
+53 SET FBFDA(162.558,"+"_FBI_","_FBIENS,.01)=$PIECE(FBADJ(FBI),U)
+54 SET FBFDA(162.558,"+"_FBI_","_FBIENS,1)=$PIECE(FBADJ(FBI),U,2)
+55 SET FBFDA(162.558,"+"_FBI_","_FBIENS,2)=+$PIECE(FBADJ(FBI),U,3)
End DoDot:1
+56 IF $DATA(FBFDA)
DO UPDATE^DIE("","FBFDA")
+57 ;
+58 ; file derived suspend data
+59 KILL FBFDA
+60 SET FBFDA(162.5,FBIENS,9)=FBTAS
+61 IF FBMSR
IF $PIECE(FBADJ(FBMSR),U)
SET FBSC=$$GET1^DIQ(161.91,$PIECE(FBADJ(FBMSR),U),3)
+62 IF '$GET(FBSC)
SET FBSC=4
+63 SET FBFDA(162.5,FBIENS,10)=FBSC
+64 IF $DATA(FBFDA)
DO FILE^DIE("","FBFDA")
+65 ;
+66 ; if suspend code = 4 (other) then file description of suspension
+67 IF FBSC=4
IF FBMSR
IF $PIECE(FBADJ(FBMSR),U)
DO WP^DIE(162.5,FBIENS,18,,"^FB(161.91,"_$PIECE(FBADJ(FBMSR),U)_",4)")
+68 DO MSG^DIALOG()
+69 ;
+70 QUIT
+71 ;
LOADADJ(FBIENS,FBADJ) ; Load Adjustments
+1 ; Input
+2 ; FBIENS - required, internal entry numbers for subfile 162.5
+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.5,FBIENS,"58*","I","FB")
+23 DO MSG^DIALOG()
+24 SET FBSIENS=""
FOR
SET FBSIENS=$ORDER(FB(162.558,FBSIENS))
if FBSIENS=""
QUIT
Begin DoDot:1
+25 SET FBC=FBC+1
+26 SET FBADJ(FBC)=FB(162.558,FBSIENS,.01,"I")
+27 SET FBADJ(FBC)=FBADJ(FBC)_U_FB(162.558,FBSIENS,1,"I")
+28 SET FBADJ(FBC)=FBADJ(FBC)_U_FB(162.558,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 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 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^FBCHFA(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 ;FBCHFA
