- FBRXFA ;WOIFO/SAB-FILE ADJUSTMENTS FOR PHARMACY 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.11
- ; 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.11 will be modified
- ;
- N FB,FBFDA,FBHIGH,FBI,FBMSR,FBSC,FBSIENS,FBTAS
- ;
- ; delete adjustment reasons currently on file
- D GETS^DIQ(162.11,FBIENS,"37*","","FB")
- K FBFDA
- S FBSIENS="" F S FBSIENS=$O(FB(162.14,FBSIENS)) Q:FBSIENS="" D
- . S FBFDA(162.14,FBSIENS,.01)="@"
- I $D(FBFDA) D FILE^DIE("","FBFDA")
- ;
- ; delete suspend data currently on file
- K FBFDA
- S FBFDA(162.11,FBIENS,6)="@"
- S FBFDA(162.11,FBIENS,7)="@"
- I $D(FBFDA) D FILE^DIE("","FBFDA")
- ;
- ; delete suspension description currently on file
- D WP^DIE(162.11,FBIENS,20,,"@")
- ;
- ; 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.14,"+"_FBI_","_FBIENS,.01)=$P(FBADJ(FBI),U)
- . S FBFDA(162.14,"+"_FBI_","_FBIENS,1)=$P(FBADJ(FBI),U,2)
- . S FBFDA(162.14,"+"_FBI_","_FBIENS,2)=+$P(FBADJ(FBI),U,3)
- I $D(FBFDA) D UPDATE^DIE("","FBFDA")
- ;
- ; file derived suspend data
- K FBFDA
- S FBFDA(162.11,FBIENS,6)=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.11,FBIENS,7)=FBSC
- I $D(FBFDA) D FILE^DIE("","FBFDA")
- ;
- ; if suspend code = 4 (other) then file suspension description
- I FBSC=4,FBMSR,$P(FBADJ(FBMSR),U) D WP^DIE(162.11,FBIENS,20,,"^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.11
- ; 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.11,FBIENS,"37*","I","FB")
- D MSG^DIALOG()
- S FBSIENS="" F S FBSIENS=$O(FB(162.14,FBSIENS)) Q:FBSIENS="" D
- . S FBC=FBC+1
- . S FBADJ(FBC)=FB(162.14,FBSIENS,.01,"I")
- . S FBADJ(FBC)=FBADJ(FBC)_U_FB(162.14,FBSIENS,1,"I")
- . S FBADJ(FBC)=FBADJ(FBC)_U_FB(162.14,FBSIENS,2,"I")
- ;
- Q
- ;
- ADJLRA(FBIENS) ; Adjustment Reason^Amount List Extrinsic Function
- ; Input
- ; FBIENS - required, internal entry numbers for subfile 162.11
- ; 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^FBRXFA(FBIENS,.FBADJ)
- S FBADJL=$$ADJL^FBUTL2(.FBADJ)
- S FBADJLR=$$ADJLR^FBUTL2(FBADJL)
- S FBADJLA=$$ADJLA^FBUTL2(FBADJL)
- S FBRET=FBADJLR_U_FBADJLA
- Q FBRET
- ;
- ;FBRXFA
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBRXFA 4570 printed Jan 18, 2025@03:01:05 Page 2
- FBRXFA ;WOIFO/SAB-FILE ADJUSTMENTS FOR PHARMACY 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.11
- +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.11 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.11,FBIENS,"37*","","FB")
- +22 KILL FBFDA
- +23 SET FBSIENS=""
- FOR
- SET FBSIENS=$ORDER(FB(162.14,FBSIENS))
- if FBSIENS=""
- QUIT
- Begin DoDot:1
- +24 SET FBFDA(162.14,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.11,FBIENS,6)="@"
- +30 SET FBFDA(162.11,FBIENS,7)="@"
- +31 IF $DATA(FBFDA)
- DO FILE^DIE("","FBFDA")
- +32 ;
- +33 ; delete suspension description currently on file
- +34 DO WP^DIE(162.11,FBIENS,20,,"@")
- +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.14,"+"_FBI_","_FBIENS,.01)=$PIECE(FBADJ(FBI),U)
- +54 SET FBFDA(162.14,"+"_FBI_","_FBIENS,1)=$PIECE(FBADJ(FBI),U,2)
- +55 SET FBFDA(162.14,"+"_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.11,FBIENS,6)=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.11,FBIENS,7)=FBSC
- +64 IF $DATA(FBFDA)
- DO FILE^DIE("","FBFDA")
- +65 ;
- +66 ; if suspend code = 4 (other) then file suspension description
- +67 IF FBSC=4
- IF FBMSR
- IF $PIECE(FBADJ(FBMSR),U)
- DO WP^DIE(162.11,FBIENS,20,,"^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.11
- +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.11,FBIENS,"37*","I","FB")
- +23 DO MSG^DIALOG()
- +24 SET FBSIENS=""
- FOR
- SET FBSIENS=$ORDER(FB(162.14,FBSIENS))
- if FBSIENS=""
- QUIT
- Begin DoDot:1
- +25 SET FBC=FBC+1
- +26 SET FBADJ(FBC)=FB(162.14,FBSIENS,.01,"I")
- +27 SET FBADJ(FBC)=FBADJ(FBC)_U_FB(162.14,FBSIENS,1,"I")
- +28 SET FBADJ(FBC)=FBADJ(FBC)_U_FB(162.14,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.11
- +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^FBRXFA(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 ;FBRXFA