FBAAMP1 ;AISC/CMR - MULTIPLE PAYMENT ENTRY ;7/6/2003
;;3.5;FEE BASIS;**4,55,61,77,139,158**;JAN 30, 1995;Build 94
;;Per VA Directive 6402, this routine should not be modified.
SUSP ;enter suspense data
N FBX
;S DIR(0)="162.5,9",DIR("A")="Amount Suspended: $",DIR("B")=FBJ-FBK,DIR("?")="Press Return if $ "_(FBJ-FBK)_" is Amount Suspended, otherwise enter correct suspension amount" D ^DIR K DIR
;I $D(DIRUT) W !!,"Invalid entry, enter a number between .01 and 999999" G SUSP
;S FBAAAS=+Y
;I +Y'=(FBJ-FBK) S FBAAAS=+Y W ! S DIR("A")="Is $"_FBAAAS_" correct for Amount Suspended",DIR("B")="Yes",DIR(0)="Y" D ^DIR K DIR I $D(DIRUT) S FBAAOUT=1 Q
;G SUSP:'Y
;W !! S DIC="^FBAA(161.27,",DIC(0)="AEQ" D ^DIC I X["^" S FBAAOUT=1 Q
;S FBAASC=+Y
S FBX=$$ADJ^FBUTL2(FBJ-FBK,.FBADJ,5,,,,.FBRRMK,1)
I FBX=0 S FBAAOUT=1
Q
SUSP1 I FBAASC=4 K ^TMP($J,"FBWP") W !!,"Suspension Description: " S DIC="^TMP($J,""FBWP"",",DWLW=80,DWPK=1 D EN^DIWE K DIC,DWLW,DWPK I '$O(^TMP($J,"FBWP",0)) W !!,*7,"Description of Suspense is required." G SUSP1
Q
HCFA N ICDMDE S ICDMDE=10
I FBMPDT<$$IMPDATE^LEXU("10D") S ICDMDE=9 N XX1 ;FB*3.5*139-JLG-ICD10 REMEDIATION
F FBSI=28,30,31,32 S FBHCFA(FBSI)=""
W ! F FBSI=28,30,31 D Q:$G(FBAAOUT)
. ;DEM/JLG/JAS FB*3.5*139-JLG-ICD10 REMEDIATION
. I (FBSI=28)&(ICDMDE=10) F D Q:($G(FBAAOUT))!(XX1>0)
. . S XX1=$$ASKICD10(FBMPDT) S:XX1=-3 FBAAOUT=1
. . Q:XX1<0
. . S FBHCFA(28)=XX1
. . Q
. Q:($G(FBAAOUT))!((ICDMDE=10)&(FBSI=28))
. I (FBSI=28)&(ICDMDE=9) F D Q:($G(FBAAOUT))!(XX1>0)
. . S XX1=$$ASKICD9(FBMPDT) S:XX1="^" FBAAOUT=1
. . Q:XX1<0
. . S FBHCFA(28)=XX1
. . Q
. Q:($G(FBAAOUT))!((ICDMDE=9)&(FBSI=28))
. ;END 139
. N ICDVDT S ICDVDT=$G(FBMPDT)
. ;JAS - 08/23/13 - FB*3.5*139 (ICD10 REMEDIATION) - Modified next line for ICD-10.
. F S DIR(0)="P"_$S(FBSI=30:"^353.1",FBSI=31:"O^353.2")_":EMZ" D HCFA1 Q:$G(FBAAOUT) Q
Q:$G(FBAAOUT)
W !
I $$EXTPV^FBAAUTL5(FBPOV)'="01" D
. S FBSI=32,DIR(0)="Y",DIR("A")="Service connected condition"
. S DIR("?")="^W !!,""Respond by answering 'Yes' or 'No'."",! I $G(DFN) W !?1,*7,""Patient: "",$$NAME^FBCHREQ2(DFN) D DIS^DGRPDB W !!"
. D HCFA1 I $D(DIRUT) S FBAAOUT=1 Q
Q
;
ASKICD9(FBINDT) ;JAS - 08/23/13 - FB*3.5*139 (ICD10 REMEDIATION)
N FBDX,EDATE,XSP
S EDATE=FBINDT ; edate is the date of interest for ICD9 diagnosis code lookup
S XSP="ICD DIAGNOSIS"
S FBDX=$$ENICD9^FBICD9(EDATE,XSP,"Y")
K EDATE,FBINDT
Q +FBDX
;
ASKICD10(FBINDT) ; FB*3.5*139-JLG-ICD10 REMEDIATION
N FBDX,EDATE,DA,DP
S EDATE=FBINDT ; edate is the date of interest for ICD10 diagnosis code lookup
S DA=DFN,DP=162.03 ; these must be defined prior to calling $$ASKICD10
S FBDX=-1 S FBDX=$$ASKICD10^FBASF("PRIMARY DIAGNOSIS","","Y") ; returns -1 or ien of icd10 diagnosis code
K EDATE,FBINDT
Q FBDX
;
HCFA1 D ^DIR I $D(DTOUT)!($D(DUOUT)) S FBAAOUT=1 Q
I Y'=-1 D
.I DIR(0)["P" S FBHCFA(FBSI)=$P(Y,"^")
.I DIR(0)="Y" S FBHCFA(FBSI)=$S(Y=1:"Y",1:"N")
K DIR Q
DESC N FBJ
I FBAASC=4,$D(^TMP($J,"FBWP",0)) S ^FBAAC(DFN,1,FBV,1,FBSDI,1,FBAACPI,1,0)=^(0) F FBJ=1:1 Q:'$D(^TMP($J,"FBWP",FBJ,0)) S ^FBAAC(DFN,1,FBV,1,FBSDI,1,FBAACPI,1,FBJ,0)=^(0)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAMP1 3196 printed Sep 23, 2025@19:31:52 Page 2
FBAAMP1 ;AISC/CMR - MULTIPLE PAYMENT ENTRY ;7/6/2003
+1 ;;3.5;FEE BASIS;**4,55,61,77,139,158**;JAN 30, 1995;Build 94
+2 ;;Per VA Directive 6402, this routine should not be modified.
SUSP ;enter suspense data
+1 NEW FBX
+2 ;S DIR(0)="162.5,9",DIR("A")="Amount Suspended: $",DIR("B")=FBJ-FBK,DIR("?")="Press Return if $ "_(FBJ-FBK)_" is Amount Suspended, otherwise enter correct suspension amount" D ^DIR K DIR
+3 ;I $D(DIRUT) W !!,"Invalid entry, enter a number between .01 and 999999" G SUSP
+4 ;S FBAAAS=+Y
+5 ;I +Y'=(FBJ-FBK) S FBAAAS=+Y W ! S DIR("A")="Is $"_FBAAAS_" correct for Amount Suspended",DIR("B")="Yes",DIR(0)="Y" D ^DIR K DIR I $D(DIRUT) S FBAAOUT=1 Q
+6 ;G SUSP:'Y
+7 ;W !! S DIC="^FBAA(161.27,",DIC(0)="AEQ" D ^DIC I X["^" S FBAAOUT=1 Q
+8 ;S FBAASC=+Y
+9 SET FBX=$$ADJ^FBUTL2(FBJ-FBK,.FBADJ,5,,,,.FBRRMK,1)
+10 IF FBX=0
SET FBAAOUT=1
+11 QUIT
SUSP1 IF FBAASC=4
KILL ^TMP($JOB,"FBWP")
WRITE !!,"Suspension Description: "
SET DIC="^TMP($J,""FBWP"","
SET DWLW=80
SET DWPK=1
DO EN^DIWE
KILL DIC,DWLW,DWPK
IF '$ORDER(^TMP($JOB,"FBWP",0))
WRITE !!,*7,"Description of Suspense is required."
GOTO SUSP1
+1 QUIT
HCFA NEW ICDMDE
SET ICDMDE=10
+1 ;FB*3.5*139-JLG-ICD10 REMEDIATION
IF FBMPDT<$$IMPDATE^LEXU("10D")
SET ICDMDE=9
NEW XX1
+2 FOR FBSI=28,30,31,32
SET FBHCFA(FBSI)=""
+3 WRITE !
FOR FBSI=28,30,31
Begin DoDot:1
+4 ;DEM/JLG/JAS FB*3.5*139-JLG-ICD10 REMEDIATION
+5 IF (FBSI=28)&(ICDMDE=10)
FOR
Begin DoDot:2
+6 SET XX1=$$ASKICD10(FBMPDT)
if XX1=-3
SET FBAAOUT=1
+7 if XX1<0
QUIT
+8 SET FBHCFA(28)=XX1
+9 QUIT
End DoDot:2
if ($GET(FBAAOUT))!(XX1>0)
QUIT
+10 if ($GET(FBAAOUT))!((ICDMDE=10)&(FBSI=28))
QUIT
+11 IF (FBSI=28)&(ICDMDE=9)
FOR
Begin DoDot:2
+12 SET XX1=$$ASKICD9(FBMPDT)
if XX1="^"
SET FBAAOUT=1
+13 if XX1<0
QUIT
+14 SET FBHCFA(28)=XX1
+15 QUIT
End DoDot:2
if ($GET(FBAAOUT))!(XX1>0)
QUIT
+16 if ($GET(FBAAOUT))!((ICDMDE=9)&(FBSI=28))
QUIT
+17 ;END 139
+18 NEW ICDVDT
SET ICDVDT=$GET(FBMPDT)
+19 ;JAS - 08/23/13 - FB*3.5*139 (ICD10 REMEDIATION) - Modified next line for ICD-10.
+20 FOR
SET DIR(0)="P"_$SELECT(FBSI=30:"^353.1",FBSI=31:"O^353.2")_":EMZ"
DO HCFA1
if $GET(FBAAOUT)
QUIT
QUIT
End DoDot:1
if $GET(FBAAOUT)
QUIT
+21 if $GET(FBAAOUT)
QUIT
+22 WRITE !
+23 IF $$EXTPV^FBAAUTL5(FBPOV)'="01"
Begin DoDot:1
+24 SET FBSI=32
SET DIR(0)="Y"
SET DIR("A")="Service connected condition"
+25 SET DIR("?")="^W !!,""Respond by answering 'Yes' or 'No'."",! I $G(DFN) W !?1,*7,""Patient: "",$$NAME^FBCHREQ2(DFN) D DIS^DGRPDB W !!"
+26 DO HCFA1
IF $DATA(DIRUT)
SET FBAAOUT=1
QUIT
End DoDot:1
+27 QUIT
+28 ;
ASKICD9(FBINDT) ;JAS - 08/23/13 - FB*3.5*139 (ICD10 REMEDIATION)
+1 NEW FBDX,EDATE,XSP
+2 ; edate is the date of interest for ICD9 diagnosis code lookup
SET EDATE=FBINDT
+3 SET XSP="ICD DIAGNOSIS"
+4 SET FBDX=$$ENICD9^FBICD9(EDATE,XSP,"Y")
+5 KILL EDATE,FBINDT
+6 QUIT +FBDX
+7 ;
ASKICD10(FBINDT) ; FB*3.5*139-JLG-ICD10 REMEDIATION
+1 NEW FBDX,EDATE,DA,DP
+2 ; edate is the date of interest for ICD10 diagnosis code lookup
SET EDATE=FBINDT
+3 ; these must be defined prior to calling $$ASKICD10
SET DA=DFN
SET DP=162.03
+4 ; returns -1 or ien of icd10 diagnosis code
SET FBDX=-1
SET FBDX=$$ASKICD10^FBASF("PRIMARY DIAGNOSIS","","Y")
+5 KILL EDATE,FBINDT
+6 QUIT FBDX
+7 ;
HCFA1 DO ^DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
SET FBAAOUT=1
QUIT
+1 IF Y'=-1
Begin DoDot:1
+2 IF DIR(0)["P"
SET FBHCFA(FBSI)=$PIECE(Y,"^")
+3 IF DIR(0)="Y"
SET FBHCFA(FBSI)=$SELECT(Y=1:"Y",1:"N")
End DoDot:1
+4 KILL DIR
QUIT
DESC NEW FBJ
+1 IF FBAASC=4
IF $DATA(^TMP($JOB,"FBWP",0))
SET ^FBAAC(DFN,1,FBV,1,FBSDI,1,FBAACPI,1,0)=^(0)
FOR FBJ=1:1
if '$DATA(^TMP($JOB,"FBWP",FBJ,0))
QUIT
SET ^FBAAC(DFN,1,FBV,1,FBSDI,1,FBAACPI,1,FBJ,0)=^(0)
+2 QUIT
