FBAASLP ;AISC/GRR-PRINT SUSPENSION LETTERS ;7/NOV/2006
;;3.5;FEE BASIS;**12,4,23,69,101**;JAN 30, 1995;Build 2
;;Per VHA Directive 2004-038, this routine should not be modified.
D DATE^FBAAUTL G END:FBPOP K FBAAS S (FBAAOUT,FBSLW,FBPRG,FBCTR,FBY)=0,UL="",$P(UL,"=",80)="="
D ^FBAASL G END:FBAAOUT
RDCODE S DIR(0)="Y",DIR("A")="For All Suspension codes",DIR("B")="YES",DIR("?")="'Yes' to print suspension letters for all suspension codes, 'No' to select specific codes." D ^DIR K DIR W ! G END:$D(DUOUT),END:$D(DTOUT),SEL:'Y
;ask edi/non-edi/all claims
AHEAD S DIR(0)="SA^1:EDI;2:NON-EDI;3:ALL",DIR("A")="Only print letters for claims that were submitted via (EDI/NON-EDI/ALL):",DIR("B")="ALL"
S DIR("?",1)=" Enter EDI to just print suspension letters for EDI claims from the FPPS system."
S DIR("?",2)=" Enter NON-EDI to just print suspension letters for claims that are not EDI."
S DIR("?",3)=" Enter ALL to print suspension letters for both EDI and NON-EDI claims."
S DIR("?")=" "
D ^DIR K DIR G END:$D(DIRUT)
S FBENA=Y
S VAR="BEGDATE^ENDDATE^FBSLW",VAL=BEGDATE_"^"_ENDDATE_"^"_FBSLW
I $G(DFN) S VAR="DFN^"_VAR,VAL=DFN_"^"_VAL
I $G(IFN) S VAR="IFN^"_VAR,VAL=IFN_"^"_VAL
I $G(FBDEN) S VAR="FBDEN^"_VAR,VAL=FBDEN_"^"_VAL
I $G(FBENA) S VAR="FBENA^"_VAR,VAL=FBENA_"^"_VAL
S K=0 F J=1:1:FBCTR S K=$O(FBPRG(K)) S VAR=VAR_"^FBPRG("""_K_""")",VAL=VAL_"^"_+FBPRG(K)
I $D(FBAAS) F J=0:0 S J=$O(FBAAS(J)) Q:J'>0 S VAR=VAR_"^FBAAS("_J_")",VAL=VAL_"^"
S PGM="START^FBAASLP",IOP="Q" D ZIS^FBAAUTL G:FBPOP END
START K ^UTILITY($J),^TMP($J) U IO S UL="",$P(UL,"=",80)="=",FBPG=1
I $G(FBPRG("O")) S FBLET=+FBPRG("O") F K=0:0 S K=$O(^FBAAC("AI",K)) Q:K'>0 I $S($G(IFN):IFN=K,1:1) D STRT
I $G(FBPRG("P")),$D(^FBAA(162.1,"AG")) S FBLET=+FBPRG("P") D ^FBAASL1 K ^TMP($J)
I $G(FBPRG("C")),$D(^FBAA(162.2,"AI")) S FBLET=+FBPRG("C") D ^FBCHSLP
I $G(FBPRG("I")),$D(^FBAAI("AI")) S FBLET=+FBPRG("I") D ^FBCHSL1
I '$G(FBGOT) W !,"There are no suspension letters found that meet the criteria you have",!,"specified."
END K FBAAS,UL,X,J,K,L,M,VNAM,VST1,VST2,VCITY,VSTATE,FBDT,FBA,VZIP,PNAME,A1,A2,CPT,FBDOS,FBRR,FBXX,DIC,DIWL,DIWF,BEGDATE,ENDDATE,FBAA,FBDRUG,FBFORM,FBI,FBLET,FBPDT,FBRX,FBSLW,FBSW,I,PGM,VAL,VAR,Z,ZZ,FBAAPGM,Y,PSSN,DIRUT
K FBAAOUT,FBCTR,FBPRG,FBY,FBMOD,FBMODLE,DFN,IFN,FBDEN,FBGOT,FBENA
K ^UTILITY($J),^TMP($J)
D CLOSE^FBAAUTL Q
MORE F J=0:0 S J=$O(^FBAAC("AI",K,FBDT,J)) Q:J'>0 I $S($G(DFN):DFN=J,1:1) D:$D(^DPT(J,0)) GOTP I $D(^FBAAV(K,0)) D MID
Q
GOTV S Y(0)=^FBAAV(K,0),VNAM=$P(Y(0),"^",1),FBSW=0
I VNAM["," S VNAM=$P(VNAM,",",2)_" "_$P(VNAM,",",1)
S VST1=$P(Y(0),"^",3),VST2=$P(Y(0),"^",14),VCITY=$P(Y(0),"^",4),VSTATE=$S($D(^DIC(5,+$P(Y(0),"^",5),0)):$P(^(0),"^",2),1:" "),VZIP=$P(Y(0),"^",6) S Y=DT D PDATE^FBAAUTL
W:'$G(FBPG) @IOF K:$G(FBPG) FBPG W:(IOSL)>70 !!!! W !!!!!!!!!!!,?5,VNAM,?60,FBPDT,!,?5,VST1,! I VST2]"" W ?5,VST2,!
W ?5,VCITY," ",VSTATE," ",VZIP,!!!!
WPBEG S DIWL=1,DIWF="WC79" K ^UTILITY($J,"W")
I $D(^FBAA(161.3,FBLET,1,1)) F FBRR=0:0 S FBRR=$O(^FBAA(161.3,FBLET,1,FBRR)) Q:FBRR'>0 S FBXX=^(FBRR,0),X=FBXX D ^DIWP
D ^DIWW:$D(FBXX) K FBXX
Q
MID S FBA=0 F FBAA=0:0 S FBA=$O(^FBAAC("AI",K,FBDT,J,FBA)) Q:FBA="" I $S(FBSLW=0:1,FBSLW=1&($D(FBAAS(FBA))):1,1:0) D MORE2
Q
MORE2 F L=0:0 S L=$O(^FBAAC("AI",K,FBDT,J,FBA,L)) Q:L'>0 F M=0:0 S M=$O(^FBAAC("AI",K,FBDT,J,FBA,L,M)) Q:M'>0 I $D(^FBAAC(J,1,K,1,L,1,M,0)) S Z(0)=^(0) D:$P(Z(0),"^",20)'="R" BOT
Q
WPBOT D ACT:$D(FBACRR) K FBACRR
S DIWL=1,DIWF="WC79" K ^UTILITY($J,"W") W !!
I $D(^FBAA(161.3,FBLET,2)) F FBRR=0:0 S FBRR=$O(^FBAA(161.3,FBLET,2,FBRR)) Q:FBRR'>0 S FBXX=^(FBRR,0),X=FBXX D ^DIWP
D ^DIWW:$D(FBXX) K FBXX
Q
BOT Q:$S($G(FBDEN):$P(Z(0),U,3)>0,1:0)
N FBY3,FBFPPSC
S FBY3=$G(^FBAAC(J,1,K,1,L,1,M,3))
S FBFPPSC=$P(FBY3,U)
Q:$S(FBENA=2&(FBFPPSC]""):1,FBENA=1&(FBFPPSC=""):1,1:0)
N FBY,FBX,T,TAMT,FBAC,FBJ,FBCSID,FBUNITS,FBADJLR,FBADJLA,FBRRMKL,FBFPPSL
I FBSW=1 D GOTV,HED S FBSW=0,FBGOT=1
S FBDOS=$S($D(^FBAAC(J,1,K,1,L,0)):$P(^(0),"^",1),1:"")
S CPT=$P(Z(0),"^",1),A1=$P(Z(0),"^",2)+.0001,A2=$P(Z(0),"^",3)+.0001,A1=$P(A1,".",1)_"."_$E($P(A1,".",2),1,2),A2=$P(A2,".",1)_"."_$E($P(A2,".",2),1,2)
I CPT]"" S CPT=$$CPT^FBAAUTL4(CPT)
S T=$P(Z(0),U,5)
I T]"" S T=$P($G(^FBAA(161.27,+T,0)),U)
S TAMT=$FN($P(Z(0),U,4),"",2)
S FBX=$$ADJLRA^FBAAFA(M_","_L_","_K_","_J_",")
S FBY=$G(^FBAAC(J,1,K,1,L,1,M,2))
S FBFPPSL=$P(FBY3,U,2)
S FBCSID=$P(FBY,U,16)
S FBUNITS=$P(FBY,U,14)
S FBADJLR=$P(FBX,U)
F FBJ=1:1 S FBAC=$P(FBADJLR,",",FBJ) Q:FBAC="" S FBACRR(FBAC)=""
S FBADJLA=$P(FBX,U,2)
S FBRRMKL=$$RRL^FBAAFR(M_","_L_","_K_","_J_",")
S FBMODLE=$$MODL^FBAAUTL4("^FBAAC("_J_",1,"_K_",1,"_L_",1,"_M_",""M"")","E")
I $Y+4>IOSL W @IOF D HED
W !!,$E(PNAME,1,26),?33,PSSN,?49,FBCSID
W !,$$DATX^FBAAUTL(FBDOS),?10,CPT_$S($G(FBMODLE)]"":"-"_$P(FBMODLE,","),1:""),?33,FBUNITS
I $P($G(FBMODLE),",",2)]"" D
. N FBI
. F FBI=2:1 S FBMOD=$P(FBMODLE,",",FBI) Q:FBMOD="" D
. . I $Y+4>IOSL W @IOF D HED W !," (continued)"
. . W !,?15,"-",FBMOD
W !,?10,$J(A1,6),?24,$J(A2,6)
; write adjustment reasons, if null then write suspend code
W ?35,$S(FBADJLR]"":FBADJLR,1:T)
; write adjustment amounts, if null then write amount suspended
W ?49,$S(FBADJLA]"":FBADJLA,1:TAMT)
W ?66,FBRRMKL
I FBFPPSC]"" W !,?10,"FPPS Claim ID: ",FBFPPSC,?38,"FPPS Line Item: ",FBFPPSL
W !
I FBADJLR="" G:FBA=4&($D(^FBAAC(J,1,K,1,L,1,M,1))) WPFT D
. S DIWL=1,DIWF="WC79",FBI=FBA K ^UTILITY($J,"W")
. F FBRR=0:0 S FBRR=$O(^FBAA(161.27,FBI,1,FBRR)) Q:FBRR'>0 S FBXX=^(FBRR,0),X=FBXX D ^DIWP
. D ^DIWW:$D(FBXX) K FBXX
Q
ACT ; print table of adjustment reason descriptions
; Input
; FBACRR( - required, array
; FBACRR(FBADJRE)=""
; where FBADJRE = adjustment reason code, external value
N FBADJRE,FBI,FBACT
W !,"*Adjustment Code Text:"
S FBADJRE="" F S FBADJRE=$O(FBACRR(FBADJRE)) Q:FBADJRE="" D
. ; get description of code in FBACT
. I $$AR^FBUTL1(,FBADJRE,FBSCDT,"FBACT")<0 Q ; quit if error
. ; print code and description
. K ^UTILITY($J,"W")
. S DIWL=1,DIWF="WC79"
. ; include code in output
. S X=$$LJ^XLFSTR("("_FBADJRE_")",7," ") D ^DIWP
. S DIWF="WC79I7"
. ; include description in output
. S FBI=0 F S FBI=$O(FBACT(FBI)) Q:FBI="" S X=FBACT(FBI) I X]"" D ^DIWP
. D ^DIWW
Q
;
HED W !,"PATIENT NAME",?33,"SSN",?49,"PATIENT ACCOUNT NUMBER"
W !,"SVC DATE",?10,"CPT-MOD",?33,"UNITS"
W !,?10,"AMT CLAIMED",?24,"AMT PAID",?35,"ADJ CODE",?49,"ADJ AMT",?66,"REMIT REMARKS"
W !,UL Q
;
GOTP ; Utilize new API for Name Standardization
;
S Y(0)=^DPT(J,0),PNAME=$P(Y(0),"^",1),PSSN=$TR($$SSNL4^FBAAUTL($$SSN^FBAAUTL(J)),"-","")
I PNAME["," D
.N FBNAMES
.S FBNAMES("FILE")=2,FBNAMES("IENS")=J_",",FBNAMES("FIELD")=.01
.S PNAME=$$NAMEFMT^XLFNAME(.FBNAMES)
Q
SEL W !! S DIC="^FBAA(161.27,",DIC(0)="AEQM" D ^DIC G ENDSL:X=""!(X="^"),SEL:Y<0 S DA=+Y,FBAAS(DA)="",FBSLW=1 G SEL
ENDSL I '$D(FBAAS) W !!,*7,"No suspension codes selected!" G END
G AHEAD
PSEL F FBA=0:0 S FBA=$O(FBAAS(FBA)) Q:FBA'>0 I $D(^FBAAC("AI",FBA)) F FBDT=BEGDATE-.001:0 S FBDT=$O(^FBAAC("AI",FBA,FBDT)) Q:FBDT'>0!(FBDT>ENDDATE) D MORE
G END
WPFT S DIWL=1,DIWF="WC79" K ^UTILITY($J,"W")
F FBRR=0:0 S FBRR=$O(^FBAAC(J,1,K,1,L,1,M,1,FBRR)) Q:FBRR'>0 S FBXX=^(FBRR,0),X=FBXX D ^DIWP
D ^DIWW:$D(FBXX) K FBXX
Q
STRT N FBACRR,FBSCDT S FBSW=1 S Z=$O(^FBAAC("AI",K,BEGDATE-.001)) S FBDT=BEGDATE-.001 F ZZ=0:0 S FBDT=$O(^FBAAC("AI",K,FBDT)) D WPBOT:FBDT'>0&(FBSW=0)!(FBDT>ENDDATE)&(FBSW=0) Q:FBDT'>0!(FBDT>ENDDATE) S FBSCDT=FBDT D MORE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAASLP 7591 printed Dec 13, 2024@01:56:42 Page 2
FBAASLP ;AISC/GRR-PRINT SUSPENSION LETTERS ;7/NOV/2006
+1 ;;3.5;FEE BASIS;**12,4,23,69,101**;JAN 30, 1995;Build 2
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 DO DATE^FBAAUTL
if FBPOP
GOTO END
KILL FBAAS
SET (FBAAOUT,FBSLW,FBPRG,FBCTR,FBY)=0
SET UL=""
SET $PIECE(UL,"=",80)="="
+4 DO ^FBAASL
if FBAAOUT
GOTO END
RDCODE SET DIR(0)="Y"
SET DIR("A")="For All Suspension codes"
SET DIR("B")="YES"
SET DIR("?")="'Yes' to print suspension letters for all suspension codes, 'No' to select specific codes."
DO ^DIR
KILL DIR
WRITE !
if $DATA(DUOUT)
GOTO END
if $DATA(DTOUT)
GOTO END
if 'Y
GOTO SEL
+1 ;ask edi/non-edi/all claims
AHEAD SET DIR(0)="SA^1:EDI;2:NON-EDI;3:ALL"
SET DIR("A")="Only print letters for claims that were submitted via (EDI/NON-EDI/ALL):"
SET DIR("B")="ALL"
+1 SET DIR("?",1)=" Enter EDI to just print suspension letters for EDI claims from the FPPS system."
+2 SET DIR("?",2)=" Enter NON-EDI to just print suspension letters for claims that are not EDI."
+3 SET DIR("?",3)=" Enter ALL to print suspension letters for both EDI and NON-EDI claims."
+4 SET DIR("?")=" "
+5 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO END
+6 SET FBENA=Y
+7 SET VAR="BEGDATE^ENDDATE^FBSLW"
SET VAL=BEGDATE_"^"_ENDDATE_"^"_FBSLW
+8 IF $GET(DFN)
SET VAR="DFN^"_VAR
SET VAL=DFN_"^"_VAL
+9 IF $GET(IFN)
SET VAR="IFN^"_VAR
SET VAL=IFN_"^"_VAL
+10 IF $GET(FBDEN)
SET VAR="FBDEN^"_VAR
SET VAL=FBDEN_"^"_VAL
+11 IF $GET(FBENA)
SET VAR="FBENA^"_VAR
SET VAL=FBENA_"^"_VAL
+12 SET K=0
FOR J=1:1:FBCTR
SET K=$ORDER(FBPRG(K))
SET VAR=VAR_"^FBPRG("""_K_""")"
SET VAL=VAL_"^"_+FBPRG(K)
+13 IF $DATA(FBAAS)
FOR J=0:0
SET J=$ORDER(FBAAS(J))
if J'>0
QUIT
SET VAR=VAR_"^FBAAS("_J_")"
SET VAL=VAL_"^"
+14 SET PGM="START^FBAASLP"
SET IOP="Q"
DO ZIS^FBAAUTL
if FBPOP
GOTO END
START KILL ^UTILITY($JOB),^TMP($JOB)
USE IO
SET UL=""
SET $PIECE(UL,"=",80)="="
SET FBPG=1
+1 IF $GET(FBPRG("O"))
SET FBLET=+FBPRG("O")
FOR K=0:0
SET K=$ORDER(^FBAAC("AI",K))
if K'>0
QUIT
IF $SELECT($GET(IFN):IFN=K,1:1)
DO STRT
+2 IF $GET(FBPRG("P"))
IF $DATA(^FBAA(162.1,"AG"))
SET FBLET=+FBPRG("P")
DO ^FBAASL1
KILL ^TMP($JOB)
+3 IF $GET(FBPRG("C"))
IF $DATA(^FBAA(162.2,"AI"))
SET FBLET=+FBPRG("C")
DO ^FBCHSLP
+4 IF $GET(FBPRG("I"))
IF $DATA(^FBAAI("AI"))
SET FBLET=+FBPRG("I")
DO ^FBCHSL1
+5 IF '$GET(FBGOT)
WRITE !,"There are no suspension letters found that meet the criteria you have",!,"specified."
END KILL FBAAS,UL,X,J,K,L,M,VNAM,VST1,VST2,VCITY,VSTATE,FBDT,FBA,VZIP,PNAME,A1,A2,CPT,FBDOS,FBRR,FBXX,DIC,DIWL,DIWF,BEGDATE,ENDDATE,FBAA,FBDRUG,FBFORM,FBI,FBLET,FBPDT,FBRX,FBSLW,FBSW,I,PGM,VAL,VAR,Z,ZZ,FBAAPGM,Y,PSSN,DIRUT
+1 KILL FBAAOUT,FBCTR,FBPRG,FBY,FBMOD,FBMODLE,DFN,IFN,FBDEN,FBGOT,FBENA
+2 KILL ^UTILITY($JOB),^TMP($JOB)
+3 DO CLOSE^FBAAUTL
QUIT
MORE FOR J=0:0
SET J=$ORDER(^FBAAC("AI",K,FBDT,J))
if J'>0
QUIT
IF $SELECT($GET(DFN):DFN=J,1:1)
if $DATA(^DPT(J,0))
DO GOTP
IF $DATA(^FBAAV(K,0))
DO MID
+1 QUIT
GOTV SET Y(0)=^FBAAV(K,0)
SET VNAM=$PIECE(Y(0),"^",1)
SET FBSW=0
+1 IF VNAM[","
SET VNAM=$PIECE(VNAM,",",2)_" "_$PIECE(VNAM,",",1)
+2 SET VST1=$PIECE(Y(0),"^",3)
SET VST2=$PIECE(Y(0),"^",14)
SET VCITY=$PIECE(Y(0),"^",4)
SET VSTATE=$SELECT($DATA(^DIC(5,+$PIECE(Y(0),"^",5),0)):$PIECE(^(0),"^",2),1:" ")
SET VZIP=$PIECE(Y(0),"^",6)
SET Y=DT
DO PDATE^FBAAUTL
+3 if '$GET(FBPG)
WRITE @IOF
if $GET(FBPG)
KILL FBPG
if (IOSL)>70
WRITE !!!!
WRITE !!!!!!!!!!!,?5,VNAM,?60,FBPDT,!,?5,VST1,!
IF VST2]""
WRITE ?5,VST2,!
+4 WRITE ?5,VCITY," ",VSTATE," ",VZIP,!!!!
WPBEG SET DIWL=1
SET DIWF="WC79"
KILL ^UTILITY($JOB,"W")
+1 IF $DATA(^FBAA(161.3,FBLET,1,1))
FOR FBRR=0:0
SET FBRR=$ORDER(^FBAA(161.3,FBLET,1,FBRR))
if FBRR'>0
QUIT
SET FBXX=^(FBRR,0)
SET X=FBXX
DO ^DIWP
+2 if $DATA(FBXX)
DO ^DIWW
KILL FBXX
+3 QUIT
MID SET FBA=0
FOR FBAA=0:0
SET FBA=$ORDER(^FBAAC("AI",K,FBDT,J,FBA))
if FBA=""
QUIT
IF $SELECT(FBSLW=0:1,FBSLW=1&($DATA(FBAAS(FBA))):1,1:0)
DO MORE2
+1 QUIT
MORE2 FOR L=0:0
SET L=$ORDER(^FBAAC("AI",K,FBDT,J,FBA,L))
if L'>0
QUIT
FOR M=0:0
SET M=$ORDER(^FBAAC("AI",K,FBDT,J,FBA,L,M))
if M'>0
QUIT
IF $DATA(^FBAAC(J,1,K,1,L,1,M,0))
SET Z(0)=^(0)
if $PIECE(Z(0),"^",20)'="R"
DO BOT
+1 QUIT
WPBOT if $DATA(FBACRR)
DO ACT
KILL FBACRR
+1 SET DIWL=1
SET DIWF="WC79"
KILL ^UTILITY($JOB,"W")
WRITE !!
+2 IF $DATA(^FBAA(161.3,FBLET,2))
FOR FBRR=0:0
SET FBRR=$ORDER(^FBAA(161.3,FBLET,2,FBRR))
if FBRR'>0
QUIT
SET FBXX=^(FBRR,0)
SET X=FBXX
DO ^DIWP
+3 if $DATA(FBXX)
DO ^DIWW
KILL FBXX
+4 QUIT
BOT if $SELECT($GET(FBDEN)
QUIT
+1 NEW FBY3,FBFPPSC
+2 SET FBY3=$GET(^FBAAC(J,1,K,1,L,1,M,3))
+3 SET FBFPPSC=$PIECE(FBY3,U)
+4 if $SELECT(FBENA=2&(FBFPPSC]"")
QUIT
+5 NEW FBY,FBX,T,TAMT,FBAC,FBJ,FBCSID,FBUNITS,FBADJLR,FBADJLA,FBRRMKL,FBFPPSL
+6 IF FBSW=1
DO GOTV
DO HED
SET FBSW=0
SET FBGOT=1
+7 SET FBDOS=$SELECT($DATA(^FBAAC(J,1,K,1,L,0)):$PIECE(^(0),"^",1),1:"")
+8 SET CPT=$PIECE(Z(0),"^",1)
SET A1=$PIECE(Z(0),"^",2)+.0001
SET A2=$PIECE(Z(0),"^",3)+.0001
SET A1=$PIECE(A1,".",1)_"."_$EXTRACT($PIECE(A1,".",2),1,2)
SET A2=$PIECE(A2,".",1)_"."_$EXTRACT($PIECE(A2,".",2),1,2)
+9 IF CPT]""
SET CPT=$$CPT^FBAAUTL4(CPT)
+10 SET T=$PIECE(Z(0),U,5)
+11 IF T]""
SET T=$PIECE($GET(^FBAA(161.27,+T,0)),U)
+12 SET TAMT=$FNUMBER($PIECE(Z(0),U,4),"",2)
+13 SET FBX=$$ADJLRA^FBAAFA(M_","_L_","_K_","_J_",")
+14 SET FBY=$GET(^FBAAC(J,1,K,1,L,1,M,2))
+15 SET FBFPPSL=$PIECE(FBY3,U,2)
+16 SET FBCSID=$PIECE(FBY,U,16)
+17 SET FBUNITS=$PIECE(FBY,U,14)
+18 SET FBADJLR=$PIECE(FBX,U)
+19 FOR FBJ=1:1
SET FBAC=$PIECE(FBADJLR,",",FBJ)
if FBAC=""
QUIT
SET FBACRR(FBAC)=""
+20 SET FBADJLA=$PIECE(FBX,U,2)
+21 SET FBRRMKL=$$RRL^FBAAFR(M_","_L_","_K_","_J_",")
+22 SET FBMODLE=$$MODL^FBAAUTL4("^FBAAC("_J_",1,"_K_",1,"_L_",1,"_M_",""M"")","E")
+23 IF $Y+4>IOSL
WRITE @IOF
DO HED
+24 WRITE !!,$EXTRACT(PNAME,1,26),?33,PSSN,?49,FBCSID
+25 WRITE !,$$DATX^FBAAUTL(FBDOS),?10,CPT_$SELECT($GET(FBMODLE)]"":"-"_$PIECE(FBMODLE,","),1:""),?33,FBUNITS
+26 IF $PIECE($GET(FBMODLE),",",2)]""
Begin DoDot:1
+27 NEW FBI
+28 FOR FBI=2:1
SET FBMOD=$PIECE(FBMODLE,",",FBI)
if FBMOD=""
QUIT
Begin DoDot:2
+29 IF $Y+4>IOSL
WRITE @IOF
DO HED
WRITE !," (continued)"
+30 WRITE !,?15,"-",FBMOD
End DoDot:2
End DoDot:1
+31 WRITE !,?10,$JUSTIFY(A1,6),?24,$JUSTIFY(A2,6)
+32 ; write adjustment reasons, if null then write suspend code
+33 WRITE ?35,$SELECT(FBADJLR]"":FBADJLR,1:T)
+34 ; write adjustment amounts, if null then write amount suspended
+35 WRITE ?49,$SELECT(FBADJLA]"":FBADJLA,1:TAMT)
+36 WRITE ?66,FBRRMKL
+37 IF FBFPPSC]""
WRITE !,?10,"FPPS Claim ID: ",FBFPPSC,?38,"FPPS Line Item: ",FBFPPSL
+38 WRITE !
+39 IF FBADJLR=""
if FBA=4&($DATA(^FBAAC(J,1,K,1,L,1,M,1)))
GOTO WPFT
Begin DoDot:1
+40 SET DIWL=1
SET DIWF="WC79"
SET FBI=FBA
KILL ^UTILITY($JOB,"W")
+41 FOR FBRR=0:0
SET FBRR=$ORDER(^FBAA(161.27,FBI,1,FBRR))
if FBRR'>0
QUIT
SET FBXX=^(FBRR,0)
SET X=FBXX
DO ^DIWP
+42 if $DATA(FBXX)
DO ^DIWW
KILL FBXX
End DoDot:1
+43 QUIT
ACT ; print table of adjustment reason descriptions
+1 ; Input
+2 ; FBACRR( - required, array
+3 ; FBACRR(FBADJRE)=""
+4 ; where FBADJRE = adjustment reason code, external value
+5 NEW FBADJRE,FBI,FBACT
+6 WRITE !,"*Adjustment Code Text:"
+7 SET FBADJRE=""
FOR
SET FBADJRE=$ORDER(FBACRR(FBADJRE))
if FBADJRE=""
QUIT
Begin DoDot:1
+8 ; get description of code in FBACT
+9 ; quit if error
IF $$AR^FBUTL1(,FBADJRE,FBSCDT,"FBACT")<0
QUIT
+10 ; print code and description
+11 KILL ^UTILITY($JOB,"W")
+12 SET DIWL=1
SET DIWF="WC79"
+13 ; include code in output
+14 SET X=$$LJ^XLFSTR("("_FBADJRE_")",7," ")
DO ^DIWP
+15 SET DIWF="WC79I7"
+16 ; include description in output
+17 SET FBI=0
FOR
SET FBI=$ORDER(FBACT(FBI))
if FBI=""
QUIT
SET X=FBACT(FBI)
IF X]""
DO ^DIWP
+18 DO ^DIWW
End DoDot:1
+19 QUIT
+20 ;
HED WRITE !,"PATIENT NAME",?33,"SSN",?49,"PATIENT ACCOUNT NUMBER"
+1 WRITE !,"SVC DATE",?10,"CPT-MOD",?33,"UNITS"
+2 WRITE !,?10,"AMT CLAIMED",?24,"AMT PAID",?35,"ADJ CODE",?49,"ADJ AMT",?66,"REMIT REMARKS"
+3 WRITE !,UL
QUIT
+4 ;
GOTP ; Utilize new API for Name Standardization
+1 ;
+2 SET Y(0)=^DPT(J,0)
SET PNAME=$PIECE(Y(0),"^",1)
SET PSSN=$TRANSLATE($$SSNL4^FBAAUTL($$SSN^FBAAUTL(J)),"-","")
+3 IF PNAME[","
Begin DoDot:1
+4 NEW FBNAMES
+5 SET FBNAMES("FILE")=2
SET FBNAMES("IENS")=J_","
SET FBNAMES("FIELD")=.01
+6 SET PNAME=$$NAMEFMT^XLFNAME(.FBNAMES)
End DoDot:1
+7 QUIT
SEL WRITE !!
SET DIC="^FBAA(161.27,"
SET DIC(0)="AEQM"
DO ^DIC
if X=""!(X="^")
GOTO ENDSL
if Y<0
GOTO SEL
SET DA=+Y
SET FBAAS(DA)=""
SET FBSLW=1
GOTO SEL
ENDSL IF '$DATA(FBAAS)
WRITE !!,*7,"No suspension codes selected!"
GOTO END
+1 GOTO AHEAD
PSEL FOR FBA=0:0
SET FBA=$ORDER(FBAAS(FBA))
if FBA'>0
QUIT
IF $DATA(^FBAAC("AI",FBA))
FOR FBDT=BEGDATE-.001:0
SET FBDT=$ORDER(^FBAAC("AI",FBA,FBDT))
if FBDT'>0!(FBDT>ENDDATE)
QUIT
DO MORE
+1 GOTO END
WPFT SET DIWL=1
SET DIWF="WC79"
KILL ^UTILITY($JOB,"W")
+1 FOR FBRR=0:0
SET FBRR=$ORDER(^FBAAC(J,1,K,1,L,1,M,1,FBRR))
if FBRR'>0
QUIT
SET FBXX=^(FBRR,0)
SET X=FBXX
DO ^DIWP
+2 if $DATA(FBXX)
DO ^DIWW
KILL FBXX
+3 QUIT
STRT NEW FBACRR,FBSCDT
SET FBSW=1
SET Z=$ORDER(^FBAAC("AI",K,BEGDATE-.001))
SET FBDT=BEGDATE-.001
FOR ZZ=0:0
SET FBDT=$ORDER(^FBAAC("AI",K,FBDT))
if FBDT'>0&(FBSW=0)!(FBDT>ENDDATE)&(FBSW=0)
DO WPBOT
if FBDT'>0!(FBDT>ENDDATE)
QUIT
SET FBSCDT=FBDT
DO MORE
+1 QUIT
