- FBAAPIN ;AISC/GRR - INVOICE DISPLAY ;7/17/2003
- ;;3.5;FEE BASIS;**4,61,122,133,108,135,123,164**;JAN 30, 1995;Build 28
- ;;Per VA Directive 6402, this routine should not be modified.
- D DT^DICRW
- RD1 W ! S (FBHDONE,FBAAOUT,FBINTOT)=0,FBSW=0 K FBHED S DIR(0)="NO",DIR("A")="Select Invoice Number",DIR("?")="^D HELP^FBAAPIN1" D ^DIR K DIR G Q:$D(DIRUT)!'Y
- I '$D(^FBAAC("C",X)) W !,*7,"Invalid selection.",! G RD1
- S HX=X,FBAAIN=X D LIST S X=HX G RD1
- LIST S Q="",$P(Q,"=",80)="="
- S IOP=$S($D(ION):ION,1:"HOME") D ^%ZIS K IOP
- F J=0:0 S J=$O(^FBAAC("C",FBAAIN,J)) Q:J'>0!(FBAAOUT) D MMORE
- Q
- SET S FBFILE="^FBAAC("_J_",1,"_K_",1,"_L_",1,"_M_",1,",D=$P($G(^FBAAC(J,1,K,1,L,0)),"^",1),FBYY=$G(^FBAAC(J,1,K,1,L,1,M,0)),FBYY("REJ")=$S($D(^FBAAC(J,1,K,1,L,1,M,"FBREJ")):^("FBREJ"),1:""),FBY=$G(^FBAAC(J,1,K,1,L,1,M,2))
- S FBY3=$G(^FBAAC(J,1,K,1,L,1,M,3))
- S FBAARCE=$$GET1^DIQ(162.03,M_","_L_","_K_","_J_",",48)
- D SET2
- Q
- SET2 ;
- N FBX,FBIA,FBDODINV
- S N=$S($D(^DPT(J,0)):$P(^(0),"^",1),1:""),S=$S(N]"":$P(^DPT(J,0),"^",9),1:""),V=$S($D(^FBAAV(K,0)):$P(^FBAAV(K,0),"^",1),1:"")
- S T=$P(FBYY,"^",5),D2=$P(FBYY,"^",6),ZS=$P(FBYY,"^",20),VP=$P(FBYY,"^",21)
- S T=$P($G(^FBAA(161.27,+T,0)),U)
- S TAMT=$FN($P(FBYY,U,4),"",2)
- S FBAACPT=$P(FBYY,"^",1) I FBAACPT]"" S FBAACPT=$$CPT^FBAAUTL4(FBAACPT)
- S FBMODLE=$$MODL^FBAAUTL4("^FBAAC("_J_",1,"_K_",1,"_L_",1,"_M_",""M"")","E")
- S FBUNITS=$P(FBY,U,14)
- S FBFPPSL=$P(FBY3,U,2)
- S FBX=$$ADJLRA^FBAAFA(M_","_L_","_K_","_J_",")
- S FBADJLR=$P(FBX,U)
- S FBADJLA=$P(FBX,U,2)
- S FBRRMKL=$$RRL^FBAAFR(M_","_L_","_K_","_J_",")
- S FBCNTRN=$S($P(FBY3,U,8):$P($G(^FBAA(161.43,$P(FBY3,U,8),0)),U),1:"")
- S FBIA=+$P($G(^FBAAC(J,1,K,1,L,1,M,3)),U,6) ; IPAC agreement pointer (*123)
- S FBIA=$S(FBIA:$P($G(^FBAA(161.95,FBIA,0)),U,1),1:"") ; IPAC vendor agreement ID (*123)
- S FBDODINV=$P($G(^FBAAC(J,1,K,1,L,1,M,3)),U,7) ; DoD invoice number (*123)
- S A1=$P(FBYY,"^",2)+.0001,A2=$P(FBYY,"^",3)+.0001,A3=$P(FBYY,"^",12)+.0001,A1=$P(A1,".",1)_"."_$E($P(A1,".",2),1,2),A2=$P(A2,".",1)_"."_$E($P(A2,".",2),1,2),A3=$P(A3,".",1)_"."_$E($P(A3,".",2),1,2),FBINTOT=FBINTOT+A2+.0001
- S FBINTOT=$P(FBINTOT,".")_"."_$E($P(FBINTOT,".",2),1,2)
- S FBBN=$S($P(FBYY,"^",8)]"":$S($D(^FBAA(161.7,$P(FBYY,"^",8),0)):$P(^(0),"^",1),1:""),$P(FBYY("REJ"),"^",3)]"":$S($D(^FBAA(161.7,$P(FBYY("REJ"),"^",3),0)):$P(^(0),"^",1),1:""),1:"")
- D FBCKO^FBAACCB2(J,K,L,M)
- I $D(^FBAAC(J,1,K,1,L,1,M,4))!($D(^FBAAC(J,1,K,1,L,1,M,5))) D PROV
- I '$D(FBHED) D HED
- D WRT S FBHED=1
- Q
- WRT I ($Y+5)>IOSL S DIR(0)="E" D ^DIR K DIR S:'Y FBAAOUT=1 Q:FBAAOUT D HED
- W !!,N,?33,$$DATX^FBAAUTL(D),?43,FBAACPT_$S($G(FBMODLE)]"":"-"_$P(FBMODLE,","),1:"")
- I FBAARCE]"" W ?51,"/",FBAARCE
- W ?57,FBBN,?67,$S(FBYY("REJ")]"":"Rejected",1:$$DATX^FBAAUTL(D2))
- I $P($G(FBMODLE),",",2)]"" D Q:FBAAOUT
- . N FBI
- . F FBI=2:1 S FBMOD=$P(FBMODLE,",",FBI) Q:FBMOD="" D Q:FBAAOUT
- . . I $Y+5>IOSL D Q:FBAAOUT W !,"(continued)"
- . . . S DIR(0)="E" D ^DIR K DIR S:'Y FBAAOUT=1 Q:FBAAOUT D HED
- . . W !,?48,"-",FBMOD
- W !,$S(ZS="R":"*",1:""),$S(VP="VP":"#",1:""),$S($G(FBCAN)]"":"+",1:"")
- W ?3,FBFPPSL,?14,"$",$J(A1,8),?26,"$",$J(A2,8),?37,FBUNITS
- ; write adjustment reasons, if null then write suspend code
- W ?43,$S(FBADJLR]"":FBADJLR,1:T)
- ; write adjustment amounts, if null then write amount suspended
- W ?53,"$",$S(FBADJLA]"":FBADJLA,1:TAMT)
- W ?69,FBRRMKL
- ; if adjustment reasons null and suspend code = other then write desc.
- I FBADJLR="",T=4 D ^FBAAPIN1
- I FBCNTRN]"" W !!,?2,"Contract Number: ",FBCNTRN
- I FBIA'=""!(FBDODINV'="") W !!?5,"IPAC Number: ",FBIA,?30,"DoD Invoice Number: ",FBDODINV
- ;
- ; write attachment IDs FB*3.5*164
- I $D(^FBAAC(J,1,K,1,L,1,M,10)) D
- . N AI,AID,AITI,WRTPC
- . S AI=0 S WRTPC="Attachment ID:"
- . F S AI=$O(^FBAAC(J,1,K,1,L,1,M,10,AI)) Q:'AI D
- . . S AID=$P($G(^FBAAC(J,1,K,1,L,1,M,10,AI,0)),U)
- . . I AI>1 S WRTPC=WRTPC_","
- . . S WRTPC=WRTPC_" "_AID
- . . S AITI=$P($G(^FBAAC(J,1,K,1,L,1,M,10,AI,0)),U,2)
- . . I AITI D
- . . . S WRTPC=WRTPC_" ("_$P($G(^IBE(353.3,AITI,0)),U)
- . . . S WRTPC=WRTPC_" - "
- . . . S WRTPC=WRTPC_$P($G(^IBE(353.3,AITI,0)),U,2)_")"
- . . I $L(WRTPC)>IOM D WRTSTR^FBAACCB1(.WRTPC,IOM)
- . I $L(WRTPC)>0 D WRTSTR^FBAACCB1(.WRTPC,IOM)
- ;
- D PMNT^FBAACCB2
- ; Display LI Rendering Provider data
- N FBLIPRV S FBLIPRV=$G(^FBAAC(J,1,K,1,L,1,M,3)) ; FB*3.5*135
- I $L($P(FBLIPRV,U,3)) D
- . W !?3,"RENDERING PROV NAME (LI): "_$P(FBLIPRV,U,3)
- . I $L($P(FBLIPRV,U,4,5))>1 W !?7,"NPI: "_$P(FBLIPRV,U,4),?29,"TAXONOMY CODE: "_$P(FBLIPRV,U,5)
- Q
- HED W @IOF,!,"Invoice Number: ",FBAAIN,?30,"Vendor Name: ",V,!,?2,"Date Received: ",FBINDAT
- I +$G(FBY) W ?33,"Invoice Date: ",$$DATX^FBAAUTL(+FBY)
- W !?2,"FPPS Claim ID: ",$S(FBFPPSC]"":FBFPPSC,1:"N/A")
- W ?33,"Patient Account #: ",FBCSID
- W !?10,"('*' Reimb. to Patient '+' Cancel. Activity '#' Voided Payment)"
- ;W !,"SVC DATE"," CPT-MOD "," AMT CLAIMED",?35,"AMT PAID",?47,"CODE",?57,"BATCH NO.",?67,"VOUCHER DATE",!,?5,"Other Suspension Description",!,$$REPEAT^XLFSTR("=",79),!
- W !,"PATIENT",?33,"SVC DATE",?43,"CPT-MOD",?51,"/REV",?57,"BATCH NO.",?67,"VOUCHER DATE"
- W !,?3,"FPPS LINE",?14,"AMT CLAIMED",?26,"AMT PAID",?36,"UNITS",?43,"ADJ CODE",?53,"ADJ AMT",?69,"REMIT RMK"
- W !,$$REPEAT^XLFSTR("=",79)
- Q
- Q K D,N,V,D2,J,K,L,M,DIC,T,FBYY,Q,I,A1,A2,A3,C,DIYS,FBAACPT,FBAAIN,FBAAOUT,FBBN,FBINTOT,FBINDAT,FBSW,FBHDONE,HX,S,VP,Z,ZS,FBHED,FBFILE,DIRUT,FBY,FBMOD
- K FBMODLE
- K FBAARCE,FBADJLA,FBADJLR,FBCSID,FBFPPSC,FBFPPSL,FBRRMKL,FBUNITS,TAMT
- Q
- ERR W !,*7,"Please enter a whole number! Alpha characters and puctuation are invalid" G RD1
- SETHD S V=$S($D(^FBAAV(K,0)):$P(^(0),"^",1),1:"") D INDAT:FBSW S FBHDONE=1 Q
- MMORE S FBSW=1 F K=0:0 S K=$O(^FBAAC("C",FBAAIN,J,K)) Q:K=""!(FBAAOUT) D SETHD F L=0:0 S L=$O(^FBAAC("C",FBAAIN,J,K,L)) Q:L=""!(FBAAOUT) F M=0:0 S M=$O(^FBAAC("C",FBAAIN,J,K,L,M)) Q:M'>0 D SET Q:FBAAOUT
- Q
- INDAT S L=$O(^FBAAC("C",FBAAIN,J,K,"")),M=$O(^FBAAC("C",FBAAIN,J,K,L,""))
- S FBINDAT=$P($G(^FBAAC(J,1,K,1,L,1,M,0)),"^",15)
- S FBINDAT=$S(FBINDAT="":"Unknown",1:$E(FBINDAT,4,5)_"/"_$E(FBINDAT,6,7)_"/"_$E(FBINDAT,2,3))
- S FBFPPSC=$P($G(^FBAAC(J,1,K,1,L,1,M,3)),U,1)
- S FBCSID=$P($G(^FBAAC(J,1,K,1,L,1,M,2)),U,16)
- S FBSW=0 K L,M Q
- Q
- PROV ;Display Invoice Provider information before invoice details FB*3.5*122
- N FBPRI,FBSRVF S FBPRI=$G(^FBAAC(J,1,K,1,L,1,M,4)),FBSRVF=$G(^FBAAC(J,1,K,1,L,1,M,5)),$P(FBSRVF,U,3)=$$GET1^DIQ(5,$P(FBSRVF,U,3)_",",1)
- W @IOF,!?30,"INVOICE DISPLAY",!?30,"===============",!?28,"PROVIDER INFORMATION",!
- I $L($P(FBPRI,U,1,3))>3 W !?3,"ATTENDING PROV NAME: "_$P(FBPRI,U),!?3,"ATTENDING PROV NPI: "_$P(FBPRI,U,2),?35,"ATTENDING PROV TAXONOMY CODE: "_$P(FBPRI,U,3)
- I $L($P(FBPRI,U,4,5))>2 W !!?3,"OPERATING PROV NAME: "_$P(FBPRI,U,4),!?3,"OPERATING PROV NPI: "_$P(FBPRI,U,5)
- I $L($P(FBPRI,U,6,8))>3 W !!?3,"RENDERING PROV NAME: "_$P(FBPRI,U,6),!?3,"RENDERING PROV NPI: "_$P(FBPRI,U,7),?35,"RENDERING PROV TAXONOMY CODE: "_$P(FBPRI,U,8)
- I $L($P(FBPRI,U,9,10))>2 W !!?3,"SERVICING PROV NAME: "_$P(FBPRI,U,9),!?3,"SERVICING PROV NPI: "_$P(FBPRI,U,10)
- I $L($P(FBSRVF,U,1,4))>4 W !?3,"SERVICING FACILITY ADDRESS: ",!?5,$P(FBSRVF,U),!?5,$P(FBSRVF,U,2) I $P(FBSRVF,U,2)'="" W ", "
- W $P(FBSRVF,U,3)_" "_$P(FBSRVF,U,4)
- I $L($P(FBPRI,U,11,12))>2 W !!?3,"REFERRING PROV NAME: "_$P(FBPRI,U,11),!?3,"REFERRING PROV NPI: "_$P(FBPRI,U,12),!!
- I '$D(FBHED) S DIR(0)="E" D ^DIR
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAPIN 7442 printed Jan 18, 2025@02:57:20 Page 2
- FBAAPIN ;AISC/GRR - INVOICE DISPLAY ;7/17/2003
- +1 ;;3.5;FEE BASIS;**4,61,122,133,108,135,123,164**;JAN 30, 1995;Build 28
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 DO DT^DICRW
- RD1 WRITE !
- SET (FBHDONE,FBAAOUT,FBINTOT)=0
- SET FBSW=0
- KILL FBHED
- SET DIR(0)="NO"
- SET DIR("A")="Select Invoice Number"
- SET DIR("?")="^D HELP^FBAAPIN1"
- DO ^DIR
- KILL DIR
- if $DATA(DIRUT)!'Y
- GOTO Q
- +1 IF '$DATA(^FBAAC("C",X))
- WRITE !,*7,"Invalid selection.",!
- GOTO RD1
- +2 SET HX=X
- SET FBAAIN=X
- DO LIST
- SET X=HX
- GOTO RD1
- LIST SET Q=""
- SET $PIECE(Q,"=",80)="="
- +1 SET IOP=$SELECT($DATA(ION):ION,1:"HOME")
- DO ^%ZIS
- KILL IOP
- +2 FOR J=0:0
- SET J=$ORDER(^FBAAC("C",FBAAIN,J))
- if J'>0!(FBAAOUT)
- QUIT
- DO MMORE
- +3 QUIT
- SET SET FBFILE="^FBAAC("_J_",1,"_K_",1,"_L_",1,"_M_",1,"
- SET D=$PIECE($GET(^FBAAC(J,1,K,1,L,0)),"^",1)
- SET FBYY=$GET(^FBAAC(J,1,K,1,L,1,M,0))
- SET FBYY("REJ")=$SELECT($DATA(^FBAAC(J,1,K,1,L,1,M,"FBREJ")):^("FBREJ"),1:"")
- SET FBY=$GET(^FBAAC(J,1,K,1,L,1,M,2))
- +1 SET FBY3=$GET(^FBAAC(J,1,K,1,L,1,M,3))
- +2 SET FBAARCE=$$GET1^DIQ(162.03,M_","_L_","_K_","_J_",",48)
- +3 DO SET2
- +4 QUIT
- SET2 ;
- +1 NEW FBX,FBIA,FBDODINV
- +2 SET N=$SELECT($DATA(^DPT(J,0)):$PIECE(^(0),"^",1),1:"")
- SET S=$SELECT(N]"":$PIECE(^DPT(J,0),"^",9),1:"")
- SET V=$SELECT($DATA(^FBAAV(K,0)):$PIECE(^FBAAV(K,0),"^",1),1:"")
- +3 SET T=$PIECE(FBYY,"^",5)
- SET D2=$PIECE(FBYY,"^",6)
- SET ZS=$PIECE(FBYY,"^",20)
- SET VP=$PIECE(FBYY,"^",21)
- +4 SET T=$PIECE($GET(^FBAA(161.27,+T,0)),U)
- +5 SET TAMT=$FNUMBER($PIECE(FBYY,U,4),"",2)
- +6 SET FBAACPT=$PIECE(FBYY,"^",1)
- IF FBAACPT]""
- SET FBAACPT=$$CPT^FBAAUTL4(FBAACPT)
- +7 SET FBMODLE=$$MODL^FBAAUTL4("^FBAAC("_J_",1,"_K_",1,"_L_",1,"_M_",""M"")","E")
- +8 SET FBUNITS=$PIECE(FBY,U,14)
- +9 SET FBFPPSL=$PIECE(FBY3,U,2)
- +10 SET FBX=$$ADJLRA^FBAAFA(M_","_L_","_K_","_J_",")
- +11 SET FBADJLR=$PIECE(FBX,U)
- +12 SET FBADJLA=$PIECE(FBX,U,2)
- +13 SET FBRRMKL=$$RRL^FBAAFR(M_","_L_","_K_","_J_",")
- +14 SET FBCNTRN=$SELECT($PIECE(FBY3,U,8):$PIECE($GET(^FBAA(161.43,$PIECE(FBY3,U,8),0)),U),1:"")
- +15 ; IPAC agreement pointer (*123)
- SET FBIA=+$PIECE($GET(^FBAAC(J,1,K,1,L,1,M,3)),U,6)
- +16 ; IPAC vendor agreement ID (*123)
- SET FBIA=$SELECT(FBIA:$PIECE($GET(^FBAA(161.95,FBIA,0)),U,1),1:"")
- +17 ; DoD invoice number (*123)
- SET FBDODINV=$PIECE($GET(^FBAAC(J,1,K,1,L,1,M,3)),U,7)
- +18 SET A1=$PIECE(FBYY,"^",2)+.0001
- SET A2=$PIECE(FBYY,"^",3)+.0001
- SET A3=$PIECE(FBYY,"^",12)+.0001
- SET A1=$PIECE(A1,".",1)_"."_$EXTRACT($PIECE(A1,".",2),1,2)
- SET A2=$PIECE(A2,".",1)_"."_$EXTRACT($PIECE(A2,".",2),1,2)
- SET A3=$PIECE(A3,".",1)_"."_$EXTRACT($PIECE(A3,".",2),1,2)
- SET FBINTOT=FBINTOT+A2+.0001
- +19 SET FBINTOT=$PIECE(FBINTOT,".")_"."_$EXTRACT($PIECE(FBINTOT,".",2),1,2)
- +20 SET FBBN=$SELECT($PIECE(FBYY,"^",8)]"":$SELECT($DATA(^FBAA(161.7,$PIECE(FBYY,"^",8),0)):$PIECE(^(0),"^",1),1:""),$PIECE(FBYY("REJ"),"^",3)]"":$SELECT($DATA(^FBAA(161.7,$PIECE(FBYY("REJ"),"^",3),0)):$PIECE(^(0),"^",1),1:""),1:"")
- +21 DO FBCKO^FBAACCB2(J,K,L,M)
- +22 IF $DATA(^FBAAC(J,1,K,1,L,1,M,4))!($DATA(^FBAAC(J,1,K,1,L,1,M,5)))
- DO PROV
- +23 IF '$DATA(FBHED)
- DO HED
- +24 DO WRT
- SET FBHED=1
- +25 QUIT
- WRT IF ($Y+5)>IOSL
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- if 'Y
- SET FBAAOUT=1
- if FBAAOUT
- QUIT
- DO HED
- +1 WRITE !!,N,?33,$$DATX^FBAAUTL(D),?43,FBAACPT_$SELECT($GET(FBMODLE)]"":"-"_$PIECE(FBMODLE,","),1:"")
- +2 IF FBAARCE]""
- WRITE ?51,"/",FBAARCE
- +3 WRITE ?57,FBBN,?67,$SELECT(FBYY("REJ")]"":"Rejected",1:$$DATX^FBAAUTL(D2))
- +4 IF $PIECE($GET(FBMODLE),",",2)]""
- Begin DoDot:1
- +5 NEW FBI
- +6 FOR FBI=2:1
- SET FBMOD=$PIECE(FBMODLE,",",FBI)
- if FBMOD=""
- QUIT
- Begin DoDot:2
- +7 IF $Y+5>IOSL
- Begin DoDot:3
- +8 SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- if 'Y
- SET FBAAOUT=1
- if FBAAOUT
- QUIT
- DO HED
- End DoDot:3
- if FBAAOUT
- QUIT
- WRITE !,"(continued)"
- +9 WRITE !,?48,"-",FBMOD
- End DoDot:2
- if FBAAOUT
- QUIT
- End DoDot:1
- if FBAAOUT
- QUIT
- +10 WRITE !,$SELECT(ZS="R":"*",1:""),$SELECT(VP="VP":"#",1:""),$SELECT($GET(FBCAN)]"":"+",1:"")
- +11 WRITE ?3,FBFPPSL,?14,"$",$JUSTIFY(A1,8),?26,"$",$JUSTIFY(A2,8),?37,FBUNITS
- +12 ; write adjustment reasons, if null then write suspend code
- +13 WRITE ?43,$SELECT(FBADJLR]"":FBADJLR,1:T)
- +14 ; write adjustment amounts, if null then write amount suspended
- +15 WRITE ?53,"$",$SELECT(FBADJLA]"":FBADJLA,1:TAMT)
- +16 WRITE ?69,FBRRMKL
- +17 ; if adjustment reasons null and suspend code = other then write desc.
- +18 IF FBADJLR=""
- IF T=4
- DO ^FBAAPIN1
- +19 IF FBCNTRN]""
- WRITE !!,?2,"Contract Number: ",FBCNTRN
- +20 IF FBIA'=""!(FBDODINV'="")
- WRITE !!?5,"IPAC Number: ",FBIA,?30,"DoD Invoice Number: ",FBDODINV
- +21 ;
- +22 ; write attachment IDs FB*3.5*164
- +23 IF $DATA(^FBAAC(J,1,K,1,L,1,M,10))
- Begin DoDot:1
- +24 NEW AI,AID,AITI,WRTPC
- +25 SET AI=0
- SET WRTPC="Attachment ID:"
- +26 FOR
- SET AI=$ORDER(^FBAAC(J,1,K,1,L,1,M,10,AI))
- if 'AI
- QUIT
- Begin DoDot:2
- +27 SET AID=$PIECE($GET(^FBAAC(J,1,K,1,L,1,M,10,AI,0)),U)
- +28 IF AI>1
- SET WRTPC=WRTPC_","
- +29 SET WRTPC=WRTPC_" "_AID
- +30 SET AITI=$PIECE($GET(^FBAAC(J,1,K,1,L,1,M,10,AI,0)),U,2)
- +31 IF AITI
- Begin DoDot:3
- +32 SET WRTPC=WRTPC_" ("_$PIECE($GET(^IBE(353.3,AITI,0)),U)
- +33 SET WRTPC=WRTPC_" - "
- +34 SET WRTPC=WRTPC_$PIECE($GET(^IBE(353.3,AITI,0)),U,2)_")"
- End DoDot:3
- +35 IF $LENGTH(WRTPC)>IOM
- DO WRTSTR^FBAACCB1(.WRTPC,IOM)
- End DoDot:2
- +36 IF $LENGTH(WRTPC)>0
- DO WRTSTR^FBAACCB1(.WRTPC,IOM)
- End DoDot:1
- +37 ;
- +38 DO PMNT^FBAACCB2
- +39 ; Display LI Rendering Provider data
- +40 ; FB*3.5*135
- NEW FBLIPRV
- SET FBLIPRV=$GET(^FBAAC(J,1,K,1,L,1,M,3))
- +41 IF $LENGTH($PIECE(FBLIPRV,U,3))
- Begin DoDot:1
- +42 WRITE !?3,"RENDERING PROV NAME (LI): "_$PIECE(FBLIPRV,U,3)
- +43 IF $LENGTH($PIECE(FBLIPRV,U,4,5))>1
- WRITE !?7,"NPI: "_$PIECE(FBLIPRV,U,4),?29,"TAXONOMY CODE: "_$PIECE(FBLIPRV,U,5)
- End DoDot:1
- +44 QUIT
- HED WRITE @IOF,!,"Invoice Number: ",FBAAIN,?30,"Vendor Name: ",V,!,?2,"Date Received: ",FBINDAT
- +1 IF +$GET(FBY)
- WRITE ?33,"Invoice Date: ",$$DATX^FBAAUTL(+FBY)
- +2 WRITE !?2,"FPPS Claim ID: ",$SELECT(FBFPPSC]"":FBFPPSC,1:"N/A")
- +3 WRITE ?33,"Patient Account #: ",FBCSID
- +4 WRITE !?10,"('*' Reimb. to Patient '+' Cancel. Activity '#' Voided Payment)"
- +5 ;W !,"SVC DATE"," CPT-MOD "," AMT CLAIMED",?35,"AMT PAID",?47,"CODE",?57,"BATCH NO.",?67,"VOUCHER DATE",!,?5,"Other Suspension Description",!,$$REPEAT^XLFSTR("=",79),!
- +6 WRITE !,"PATIENT",?33,"SVC DATE",?43,"CPT-MOD",?51,"/REV",?57,"BATCH NO.",?67,"VOUCHER DATE"
- +7 WRITE !,?3,"FPPS LINE",?14,"AMT CLAIMED",?26,"AMT PAID",?36,"UNITS",?43,"ADJ CODE",?53,"ADJ AMT",?69,"REMIT RMK"
- +8 WRITE !,$$REPEAT^XLFSTR("=",79)
- +9 QUIT
- Q KILL D,N,V,D2,J,K,L,M,DIC,T,FBYY,Q,I,A1,A2,A3,C,DIYS,FBAACPT,FBAAIN,FBAAOUT,FBBN,FBINTOT,FBINDAT,FBSW,FBHDONE,HX,S,VP,Z,ZS,FBHED,FBFILE,DIRUT,FBY,FBMOD
- +1 KILL FBMODLE
- +2 KILL FBAARCE,FBADJLA,FBADJLR,FBCSID,FBFPPSC,FBFPPSL,FBRRMKL,FBUNITS,TAMT
- +3 QUIT
- ERR WRITE !,*7,"Please enter a whole number! Alpha characters and puctuation are invalid"
- GOTO RD1
- SETHD SET V=$SELECT($DATA(^FBAAV(K,0)):$PIECE(^(0),"^",1),1:"")
- if FBSW
- DO INDAT
- SET FBHDONE=1
- QUIT
- MMORE SET FBSW=1
- FOR K=0:0
- SET K=$ORDER(^FBAAC("C",FBAAIN,J,K))
- if K=""!(FBAAOUT)
- QUIT
- DO SETHD
- FOR L=0:0
- SET L=$ORDER(^FBAAC("C",FBAAIN,J,K,L))
- if L=""!(FBAAOUT)
- QUIT
- FOR M=0:0
- SET M=$ORDER(^FBAAC("C",FBAAIN,J,K,L,M))
- if M'>0
- QUIT
- DO SET
- if FBAAOUT
- QUIT
- +1 QUIT
- INDAT SET L=$ORDER(^FBAAC("C",FBAAIN,J,K,""))
- SET M=$ORDER(^FBAAC("C",FBAAIN,J,K,L,""))
- +1 SET FBINDAT=$PIECE($GET(^FBAAC(J,1,K,1,L,1,M,0)),"^",15)
- +2 SET FBINDAT=$SELECT(FBINDAT="":"Unknown",1:$EXTRACT(FBINDAT,4,5)_"/"_$EXTRACT(FBINDAT,6,7)_"/"_$EXTRACT(FBINDAT,2,3))
- +3 SET FBFPPSC=$PIECE($GET(^FBAAC(J,1,K,1,L,1,M,3)),U,1)
- +4 SET FBCSID=$PIECE($GET(^FBAAC(J,1,K,1,L,1,M,2)),U,16)
- +5 SET FBSW=0
- KILL L,M
- QUIT
- +6 QUIT
- PROV ;Display Invoice Provider information before invoice details FB*3.5*122
- +1 NEW FBPRI,FBSRVF
- SET FBPRI=$GET(^FBAAC(J,1,K,1,L,1,M,4))
- SET FBSRVF=$GET(^FBAAC(J,1,K,1,L,1,M,5))
- SET $PIECE(FBSRVF,U,3)=$$GET1^DIQ(5,$PIECE(FBSRVF,U,3)_",",1)
- +2 WRITE @IOF,!?30,"INVOICE DISPLAY",!?30,"===============",!?28,"PROVIDER INFORMATION",!
- +3 IF $LENGTH($PIECE(FBPRI,U,1,3))>3
- WRITE !?3,"ATTENDING PROV NAME: "_$PIECE(FBPRI,U),!?3,"ATTENDING PROV NPI: "_$PIECE(FBPRI,U,2),?35,"ATTENDING PROV TAXONOMY CODE: "_$PIECE(FBPRI,U,3)
- +4 IF $LENGTH($PIECE(FBPRI,U,4,5))>2
- WRITE !!?3,"OPERATING PROV NAME: "_$PIECE(FBPRI,U,4),!?3,"OPERATING PROV NPI: "_$PIECE(FBPRI,U,5)
- +5 IF $LENGTH($PIECE(FBPRI,U,6,8))>3
- WRITE !!?3,"RENDERING PROV NAME: "_$PIECE(FBPRI,U,6),!?3,"RENDERING PROV NPI: "_$PIECE(FBPRI,U,7),?35,"RENDERING PROV TAXONOMY CODE: "_$PIECE(FBPRI,U,8)
- +6 IF $LENGTH($PIECE(FBPRI,U,9,10))>2
- WRITE !!?3,"SERVICING PROV NAME: "_$PIECE(FBPRI,U,9),!?3,"SERVICING PROV NPI: "_$PIECE(FBPRI,U,10)
- +7 IF $LENGTH($PIECE(FBSRVF,U,1,4))>4
- WRITE !?3,"SERVICING FACILITY ADDRESS: ",!?5,$PIECE(FBSRVF,U),!?5,$PIECE(FBSRVF,U,2)
- IF $PIECE(FBSRVF,U,2)'=""
- WRITE ", "
- +8 WRITE $PIECE(FBSRVF,U,3)_" "_$PIECE(FBSRVF,U,4)
- +9 IF $LENGTH($PIECE(FBPRI,U,11,12))>2
- WRITE !!?3,"REFERRING PROV NAME: "_$PIECE(FBPRI,U,11),!?3,"REFERRING PROV NPI: "_$PIECE(FBPRI,U,12),!!
- +10 IF '$DATA(FBHED)
- SET DIR(0)="E"
- DO ^DIR
- +11 QUIT