FBAAVD1.m

FBAAVD1 ;AISC/DMK/GRR-COMMUNITY NURSING HOME VENDOR DISPLAY ; 1/15/10 2:06pm

 ;;3.5;FEE BASIS;**9,111**;JAN 30, 1995;Build 17

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

 I $Y+11>IOSL D  Q:'Y

 . I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR I 'Y Q

 . W @IOF,!,$J("Name:",13),?15,$E(Z(1),1,30),?48,"ID Number: ",Z(2)

 . S Y=1 ; continue

 W !?23,">>> CNH INFORMATION <<<",!

 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:"")

 Q:'$D(^FBAA(161.21,"C",DA))

 S FBX=$$CNH(DA,1)

 W !,$J("Contract #:",13),?15,$P(FBX,U)

 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:"")

 W !,$J("Effect. DT:",13),?15,$$DATX^FBAAUTL($P(FBX,U,2))

 W ?42,"Last Assessment:",?59,$$DATX^FBAAUTL($P(V,"^",6))

 W !,$J("End Date:",13),?15,$$DATX^FBAAUTL($P(FBX,U,3))

 S FBCNUM=$P(FBX,U) K FBX

 W !

 S FBVIEN=DA D DISPLAY K FBVIEN

 Q

 ;

CNH(X,Z) ;retrieve latest vendor contract

 ;X=IEN for vendor

 ;returns contract number

 ;if Z=1 returns array C#^effect dt^expire dt

 N Y

 I $S('$G(X):1,'$D(^FBAAV(+X,0)):1,1:0) Q ""

 S Y=$P($G(^FBAA(161.21,+$O(^(+$O(^FBAA(161.21,"ACR",X,-DT-.9)),0)),0)),U,1,3)

 I Y="" S Y=$P($G(^FBAA(161.21,+$O(^(+$O(^FBAA(161.21,"AC",X,DT)),0)),0)),U,1,3)

 Q $S($G(Z):Y,1:$P(Y,U))

 ;

RATE(X,FBCNRTS) ;retrieve rates

 ;X=contract number

 ;FBCNRTS = optional array, contains the associated rates.

 ;returns the number of rates associated with a contract.  

 N I,CNT

 I $S('$D(X):1,X']"":1,'$D(^FBAA(161.21,"B",X)):1,1:0) Q ""

 S X=$O(^FBAA(161.21,"B",X,0))

 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

 .S FBCNRTS(CNT)=$P(^FBAA(161.22,I,0),"^",2)

 Q CNT

 ;

DISPLAY ;

 ;will display rates on screen for selection

 ;if FBRATE is passed in the display will allow user

 ;selection and return 'FBRATE' equal to the dollar amount

 ;FBCNUM=contract number

 ;must pass in IEN of vendor in 161.2 as FBVIEN

 I $S('$G(FBVIEN):1,'$D(^FBAAV(FBVIEN,0)):1,1:0) S FBX="" Q

 I $S($G(FBCNUM)']"":1,'$D(^FBAA(161.21,"B",FBCNUM)):1,1:0) S FBX="" Q

 N I,J

 N FBCONRTS,FBX S FBX=$$RATE(FBCNUM,.FBCONRTS) I $G(FBX)<0 S FBRATE="" Q

 S J="" F I=1:1 S J=$G(FBCONRTS(I)) Q:'J  S X=J,X2="2$" D COMMA^%DTC S J=X D

 .W:I#2 !?10,$S($D(FBRATE):I_")"_J,1:"RATE "_I_":"_J)

 .W:I#2=0 ?40,$S($D(FBRATE):I_")"_J,1:"RATE "_I_":"_J)

 Q:'$D(FBRATE)

 W ! S DIR(0)="N^1:"_(I-1) D ^DIR K DIR I $D(DIRUT) S FBRATE="" Q

 ;S FBRATE=$P(FBX,U,Y)

 S FBRATE=$G(FBCONRTS(Y))

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FBAAVD1   2726     printed  Feb 18, 2025@23:23:29                                                                                                                                                                                                     Page 2

FBAAVD1   ;AISC/DMK/GRR-COMMUNITY NURSING HOME VENDOR DISPLAY ; 1/15/10 2:06pm

 +1       ;;3.5;FEE BASIS;**9,111**;JAN 30, 1995;Build 17

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3        IF $Y+11>IOSL

               Begin DoDot:1

 +4                IF $EXTRACT(IOST,1,2)="C-"

                       SET DIR(0)="E"

                       DO ^DIR

                       KILL DIR

                       IF 'Y

                           QUIT 

 +5                WRITE @IOF,!,$JUSTIFY("Name:",13),?15,$EXTRACT(Z(1),1,30),?48,"ID Number: ",Z(2)

 +6       ; continue

                   SET Y=1

               End DoDot:1

               if 'Y

                   QUIT 

 +7        WRITE !?23,">>> CNH INFORMATION <<<",!

 +8        WRITE !,$JUSTIFY("Total Beds:",13),?15,$PIECE(V,"^",8),?37,"Inspected/Accredited:",?59,$SELECT($PIECE(V,"^",4)="I":"Inspected by VA",$PIECE(V,"^",4)="A":"Accredited by JCAH",$PIECE(V,"^",4)="B":"Inspect. & Accred.",1:"")

 +9        if '$DATA(^FBAA(161.21,"C",DA))

               QUIT 

 +10       SET FBX=$$CNH(DA,1)

 +11       WRITE !,$JUSTIFY("Contract #:",13),?15,$PIECE(FBX,U)

 +12       WRITE ?40,$JUSTIFY("Medicare/Medicaid:",13),?59,$SELECT($PIECE(V,"^",5)=1:"Not Cert. for either",$PIECE(V,"^",5)=2:"Cert. for Medicare",$PIECE(V,"^",5)=3:"Cert. for Medicaid",$PIECE(V,"^",5)=4:"Cert. for both",1:"")

 +13       WRITE !,$JUSTIFY("Effect. DT:",13),?15,$$DATX^FBAAUTL($PIECE(FBX,U,2))

 +14       WRITE ?42,"Last Assessment:",?59,$$DATX^FBAAUTL($PIECE(V,"^",6))

 +15       WRITE !,$JUSTIFY("End Date:",13),?15,$$DATX^FBAAUTL($PIECE(FBX,U,3))

 +16       SET FBCNUM=$PIECE(FBX,U)

           KILL FBX

 +17       WRITE !

 +18       SET FBVIEN=DA

           DO DISPLAY

           KILL FBVIEN

 +19       QUIT 

 +20      ;

CNH(X,Z)  ;retrieve latest vendor contract

 +1       ;X=IEN for vendor

 +2       ;returns contract number

 +3       ;if Z=1 returns array C#^effect dt^expire dt

 +4        NEW Y

 +5        IF $SELECT('$GET(X):1,'$DATA(^FBAAV(+X,0)):1,1:0)

               QUIT ""

 +6        SET Y=$PIECE($GET(^FBAA(161.21,+$ORDER(^(+$ORDER(^FBAA(161.21,"ACR",X,-DT-.9)),0)),0)),U,1,3)

 +7        IF Y=""

               SET Y=$PIECE($GET(^FBAA(161.21,+$ORDER(^(+$ORDER(^FBAA(161.21,"AC",X,DT)),0)),0)),U,1,3)

 +8        QUIT $SELECT($GET(Z):Y,1:$PIECE(Y,U))

 +9       ;

RATE(X,FBCNRTS) ;retrieve rates

 +1       ;X=contract number

 +2       ;FBCNRTS = optional array, contains the associated rates.

 +3       ;returns the number of rates associated with a contract.  

 +4        NEW I,CNT

 +5        IF $SELECT('$DATA(X):1,X']"":1,'$DATA(^FBAA(161.21,"B",X)):1,1:0)

               QUIT ""

 +6        SET X=$ORDER(^FBAA(161.21,"B",X,0))

 +7        SET (I,CNT)=0

           SET Y=""

           FOR 

               SET I=$ORDER(^FBAA(161.22,"AC",X,I))

               if 'I

                   QUIT 

               IF $DATA(^FBAA(161.22,I,0))

                   SET CNT=CNT+1

                   Begin DoDot:1

 +8                    SET FBCNRTS(CNT)=$PIECE(^FBAA(161.22,I,0),"^",2)

                   End DoDot:1

 +9        QUIT CNT

 +10      ;

DISPLAY   ;

 +1       ;will display rates on screen for selection

 +2       ;if FBRATE is passed in the display will allow user

 +3       ;selection and return 'FBRATE' equal to the dollar amount

 +4       ;FBCNUM=contract number

 +5       ;must pass in IEN of vendor in 161.2 as FBVIEN

 +6        IF $SELECT('$GET(FBVIEN):1,'$DATA(^FBAAV(FBVIEN,0)):1,1:0)

               SET FBX=""

               QUIT 

 +7        IF $SELECT($GET(FBCNUM)']"":1,'$DATA(^FBAA(161.21,"B",FBCNUM)):1,1:0)

               SET FBX=""

               QUIT 

 +8        NEW I,J

 +9        NEW FBCONRTS,FBX

           SET FBX=$$RATE(FBCNUM,.FBCONRTS)

           IF $GET(FBX)<0

               SET FBRATE=""

               QUIT 

 +10       SET J=""

           FOR I=1:1

               SET J=$GET(FBCONRTS(I))

               if 'J

                   QUIT 

               SET X=J

               SET X2="2$"

               DO COMMA^%DTC

               SET J=X

               Begin DoDot:1

 +11               if I#2

                       WRITE !?10,$SELECT($DATA(FBRATE):I_")"_J,1:"RATE "_I_":"_J)

 +12               if I#2=0

                       WRITE ?40,$SELECT($DATA(FBRATE):I_")"_J,1:"RATE "_I_":"_J)

               End DoDot:1

 +13       if '$DATA(FBRATE)

               QUIT 

 +14       WRITE !

           SET DIR(0)="N^1:"_(I-1)

           DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)

               SET FBRATE=""

               QUIT 

 +15      ;S FBRATE=$P(FBX,U,Y)

 +16       SET FBRATE=$GET(FBCONRTS(Y))

 +17       QUIT