- 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 Jan 18, 2025@02:56:39 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