| 1 | FBAAMP1 ;AISC/CMR-MULTIPLE PAYMENT ENTRY ;7/6/2003
|
|---|
| 2 | ;;3.5;FEE BASIS;**4,55,61,77**;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | SUSP ;enter suspense data
|
|---|
| 5 | N FBX
|
|---|
| 6 | ;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
|
|---|
| 7 | ;I $D(DIRUT) W !!,"Invalid entry, enter a number between .01 and 999999" G SUSP
|
|---|
| 8 | ;S FBAAAS=+Y
|
|---|
| 9 | ;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
|
|---|
| 10 | ;G SUSP:'Y
|
|---|
| 11 | ;W !! S DIC="^FBAA(161.27,",DIC(0)="AEQ" D ^DIC I X["^" S FBAAOUT=1 Q
|
|---|
| 12 | ;S FBAASC=+Y
|
|---|
| 13 | S FBX=$$ADJ^FBUTL2(FBJ-FBK,.FBADJ,2)
|
|---|
| 14 | I FBX=0 S FBAAOUT=1
|
|---|
| 15 | Q
|
|---|
| 16 | 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
|
|---|
| 17 | Q
|
|---|
| 18 | HCFA F FBSI=28,30,31,32 S FBHCFA(FBSI)=""
|
|---|
| 19 | W ! F FBSI=28,30,31 D Q:$G(FBAAOUT)
|
|---|
| 20 | . N ICDVDT S ICDVDT=$G(FBMPDT)
|
|---|
| 21 | . F S DIR(0)="P"_$S(FBSI=28&($$EXTPV^FBAAUTL5(FBPOV)="01"):"O^80",FBSI=28&($$EXTPV^FBAAUTL5(FBPOV)'="01"):"^80",FBSI=30:"^353.1",FBSI=31:"O^353.2")_":EMZ" D HCFA1 Q:$G(FBAAOUT) Q:FBSI'=28 Q:$$CHKICD9^FBCSV1(+Y,$G(FBMPDT))]""
|
|---|
| 22 | Q:$G(FBAAOUT)
|
|---|
| 23 | W !
|
|---|
| 24 | I $$EXTPV^FBAAUTL5(FBPOV)'="01" D
|
|---|
| 25 | . S FBSI=32,DIR(0)="Y",DIR("A")="Service connected condition"
|
|---|
| 26 | . S DIR("?")="^W !!,""Respond by answering 'Yes' or 'No'."",! I $G(DFN) W !?1,*7,""Patient: "",$$NAME^FBCHREQ2(DFN) D DIS^DGRPDB W !!"
|
|---|
| 27 | . D HCFA1 I $D(DIRUT) S FBAAOUT=1 Q
|
|---|
| 28 | Q
|
|---|
| 29 | HCFA1 D ^DIR I $D(DTOUT)!($D(DUOUT)) S FBAAOUT=1 Q
|
|---|
| 30 | I Y'=-1 D
|
|---|
| 31 | .I DIR(0)["P" S FBHCFA(FBSI)=$P(Y,"^")
|
|---|
| 32 | .I DIR(0)="Y" S FBHCFA(FBSI)=$S(Y=1:"Y",1:"N")
|
|---|
| 33 | K DIR Q
|
|---|
| 34 | DESC N FBJ
|
|---|
| 35 | 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)
|
|---|
| 36 | Q
|
|---|
