| 1 | FBAAVD1 ;AISC/DMK/GRR-COMMUNITY NURSING HOME VENDOR DISPLAY ;9/8/97
 | 
|---|
| 2 |  ;;3.5;FEE BASIS;**9**;JAN 30, 1995
 | 
|---|
| 3 |  ;;Per VHA Directive 10-93-142, this routine should not be modified.
 | 
|---|
| 4 |  I $Y+11>IOSL D  Q:'Y
 | 
|---|
| 5 |  . I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR I 'Y Q
 | 
|---|
| 6 |  . W @IOF,!,$J("Name:",13),?15,$E(Z(1),1,30),?48,"ID Number: ",Z(2)
 | 
|---|
| 7 |  . S Y=1 ; continue
 | 
|---|
| 8 |  W !?23,">>> CNH INFORMATION <<<",!
 | 
|---|
| 9 |  W !,$J("Total Beds:",13),?15,$P(V,"^",8),?37,"Inspected/Accredited:",?59,$S($P(V,"^",4)="I":"Inspected by VA",$P(V,"^",4)="A":"Accredited by JCAH",$P(V,"^",4)="B":"Inspect. & Accred.",1:"")
 | 
|---|
| 10 |  Q:'$D(^FBAA(161.21,"C",DA))
 | 
|---|
| 11 |  S FBX=$$CNH(DA,1)
 | 
|---|
| 12 |  W !,$J("Contract #:",13),?15,$P(FBX,U)
 | 
|---|
| 13 |  W ?40,$J("Medicare/Medicaid:",13),?59,$S($P(V,"^",5)=1:"Not Cert. for either",$P(V,"^",5)=2:"Cert. for Medicare",$P(V,"^",5)=3:"Cert. for Medicaid",$P(V,"^",5)=4:"Cert. for both",1:"")
 | 
|---|
| 14 |  W !,$J("Effect. DT:",13),?15,$$DATX^FBAAUTL($P(FBX,U,2))
 | 
|---|
| 15 |  W ?42,"Last Assessment:",?59,$$DATX^FBAAUTL($P(V,"^",6))
 | 
|---|
| 16 |  W !,$J("End Date:",13),?15,$$DATX^FBAAUTL($P(FBX,U,3))
 | 
|---|
| 17 |  S FBCNUM=$P(FBX,U) K FBX
 | 
|---|
| 18 |  W !
 | 
|---|
| 19 |  S FBVIEN=DA D DISPLAY K FBVIEN
 | 
|---|
| 20 |  Q
 | 
|---|
| 21 |  ;
 | 
|---|
| 22 | CNH(X,Z) ;retrieve latest vendor contract
 | 
|---|
| 23 |  ;X=IEN for vendor
 | 
|---|
| 24 |  ;returns contract number
 | 
|---|
| 25 |  ;if Z=1 returns array C#^effect dt^expire dt
 | 
|---|
| 26 |  N Y
 | 
|---|
| 27 |  I $S('$G(X):1,'$D(^FBAAV(+X,0)):1,1:0) Q ""
 | 
|---|
| 28 |  S Y=$P($G(^FBAA(161.21,+$O(^(+$O(^FBAA(161.21,"ACR",X,-DT-.9)),0)),0)),U,1,3)
 | 
|---|
| 29 |  I Y="" S Y=$P($G(^FBAA(161.21,+$O(^(+$O(^FBAA(161.21,"AC",X,DT)),0)),0)),U,1,3)
 | 
|---|
| 30 |  Q $S($G(Z):Y,1:$P(Y,U))
 | 
|---|
| 31 |  ;
 | 
|---|
| 32 | RATE(X) ;retrieve rates 
 | 
|---|
| 33 |  ;X=contract number
 | 
|---|
| 34 |  ;returns rates delimited by '^'
 | 
|---|
| 35 |  N I,CNT,Y
 | 
|---|
| 36 |  I $S('$D(X):1,X']"":1,'$D(^FBAA(161.21,"B",X)):1,1:0) Q ""
 | 
|---|
| 37 |  S X=$O(^FBAA(161.21,"B",X,0))
 | 
|---|
| 38 |  S (I,CNT)=0,Y="" F  S I=$O(^FBAA(161.22,"AC",X,I)) Q:'I  I $D(^FBAA(161.22,I,0)) S CNT=CNT+1 D
 | 
|---|
| 39 |  .S $P(Y,"^",CNT)=$P(^FBAA(161.22,I,0),"^",2)
 | 
|---|
| 40 |  Q Y
 | 
|---|
| 41 |  ;
 | 
|---|
| 42 | DISPLAY ;
 | 
|---|
| 43 |  ;will display rates on screen for selection
 | 
|---|
| 44 |  ;if FBRATE is passed in the display will allow user
 | 
|---|
| 45 |  ;selection and return 'FBRATE' equal to the dollar amount
 | 
|---|
| 46 |  ;FBCNUM=contract number
 | 
|---|
| 47 |  ;must pass in IEN of vendor in 161.2 as FBVIEN
 | 
|---|
| 48 |  I $S('$G(FBVIEN):1,'$D(^FBAAV(FBVIEN,0)):1,1:0) S FBX="" Q
 | 
|---|
| 49 |  I $S($G(FBCNUM)']"":1,'$D(^FBAA(161.21,"B",FBCNUM)):1,1:0) S FBX="" Q
 | 
|---|
| 50 |  N I,J
 | 
|---|
| 51 |  S:'$D(FBX) FBX=$$RATE(FBCNUM) I FBX']"" S FBRATE="" Q
 | 
|---|
| 52 |  S J="" F I=1:1 S J=$P(FBX,U,I) Q:'J  S X=J,X2="2$" D COMMA^%DTC S J=X D
 | 
|---|
| 53 |  .W:I#2 !?10,$S($D(FBRATE):I_")"_J,1:"RATE "_I_":"_J)
 | 
|---|
| 54 |  .W:I#2=0 ?40,$S($D(FBRATE):I_")"_J,1:"RATE "_I_":"_J)
 | 
|---|
| 55 |  Q:'$D(FBRATE)
 | 
|---|
| 56 |  W ! S DIR(0)="N^1:"_(I-1) D ^DIR K DIR I $D(DIRUT) S FBRATE="" Q
 | 
|---|
| 57 |  S FBRATE=$P(FBX,U,Y)
 | 
|---|
| 58 |  Q
 | 
|---|