| 1 | FBAADEM ;AISC/DMK-DISPLAY PATIENT DEMOGRAPHICS ;2/12/2003 | 
|---|
| 2 | ;;3.5;FEE BASIS;**52**;JAN 30, 1995 | 
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified. | 
|---|
| 4 | I '$D(IOSL) D HOME^%ZIS | 
|---|
| 5 | I $S('$D(DFN):1,'DFN:1,1:0) Q | 
|---|
| 6 | S VAPA("P")="" D 6^VADPT G END:VAERR | 
|---|
| 7 | S:'$D(IOF) IOF="#" S FBAAOUT="" | 
|---|
| 8 | I $E(IOST,1,2)="C-" W @IOF | 
|---|
| 9 | W ! | 
|---|
| 10 | W:+VADM(6) !,*7,"*** Patient Died on ",$P(VADM(6),"^",2) | 
|---|
| 11 | W !,VADM(1),?39,"Pt.ID: ",$P(VADM(2),"^",2) | 
|---|
| 12 | W !,VAPA(1),?41,"DOB: ",$P(VADM(3),"^",2) | 
|---|
| 13 | I VAPA(2)]"" W !,VAPA(2) | 
|---|
| 14 | I VAPA(3)]"" W !,VAPA(3) | 
|---|
| 15 | W !,VAPA(4),?41,"TEL: ",$S(VAPA(8)]"":VAPA(8),1:"Not on File") | 
|---|
| 16 | W !,$P(VAPA(5),"^",2)_" "_$S('+$G(VAPA(11)):VAPA(6),$P(VAPA(11),U,2)]"":$P(VAPA(11),U,2),1:VAPA(6)),?37,"CLAIM #: ",$S(VAEL(7)]"":VAEL(7),1:"Not on File") | 
|---|
| 17 | S FBCOUNTY=$S($P(VAPA(7),"^",2)]"":$P(VAPA(7),"^",2),1:"Not on File") | 
|---|
| 18 | W !?38,"COUNTY: ",FBCOUNTY | 
|---|
| 19 | N FBCCADR S FBCCADR=$$CCADR^FBAACO0(0) | 
|---|
| 20 | D ELIG,DIS^DGRPDB | 
|---|
| 21 | I FBCCADR>0,$E(IOST,1,2)="C-" W ! S DIR(0)="E" D ^DIR K DIR I $D(DIRUT) S FBAAOUT=1 D END Q | 
|---|
| 22 | D INS^DGRPDB | 
|---|
| 23 | I '$G(FBPHOUT) D ^FBUINS ;I $D(DIRUT) S FBAAOUT=1 D END Q | 
|---|
| 24 | I $G(FBPHOUT),$E(IOST,1,2)="C-" W ! S DIR(0)="E" D ^DIR K DIR I $D(DIRUT) S FBAAOUT=1 D END Q | 
|---|
| 25 | I $E(IOST,1,2)="C-" W @IOF | 
|---|
| 26 | I $D(^FBAAA(DFN,0)) D ^FBAADEM1 | 
|---|
| 27 | ; | 
|---|
| 28 | END D KVA^VADPT K FBCOUNTY,FBDEL Q | 
|---|
| 29 | ; | 
|---|
| 30 | ELIG N I,I1 W !!,"Primary Elig. Code: ",$P(VAEL(1),"^",2),"  --  ",$S(VAEL(8)']"":"NOT VERIFIED",1:$P(VAEL(8),"^",2)) | 
|---|
| 31 | I VAEL(8)]"" S Y=$P($G(^DPT(DFN,.361)),"^",2) W "  " D DT^DIQ | 
|---|
| 32 | W !,"Other Elig. Code(s): " I $D(VAEL(1))>9 S (I,I1)=0 F  S I=$O(VAEL(1,I)) Q:'I  S I1=I1+1 W:I1>1 !?21 W $P(VAEL(1,I),"^",2) | 
|---|
| 33 | E  W "NO ADDITIONAL ELIGIBILITIES IDENTIFIED" | 
|---|
| 34 | Q | 
|---|