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
|
---|