APCLV05.m

APCLV05 ; IHS/CMI/LAB - provider functions ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;

DENT ;EP

 I 'V Q -1

 I '$D(^AUPNVSIT(V)) Q -1

 I '$G(N) Q -1

 NEW %,Y,P,C,Z

 S (Z,P)="",(Y,C)=0

 S Y=0 F  S Y=$O(^AUPNVDEN("AD",V,Y)) Q:Y'=+Y   S C=C+1 I C=N S P=$P(^AUPNVDEN(Y,0),U),Z=Y

 I 'P Q P

 I '$D(^AUTTADA(P)) Q -1

 I $G(F)="" S F="C"

 S %="" D @F

 Q %

 ;

I ;

 S %=P Q

E ;

 S %=$P(^AUTTADA(Z,0),U,2) Q

U ;

 S %=$P(^AUPNVDEN(Z,0),U,4) Q

C ;

 S %=$P(^AUTTADA(P,0),U) Q

R ;fee rounded to nearest $

 S %=$P(^AUPNVDEN(Z,0),U,7) Q

 I %="" Q

 S %=$P((%+.5),".")

 Q

F ;fee

 S %=$P(^AUPNVDEN(Z,0),U,5) Q

APCLV05   ; IHS/CMI/LAB - provider functions ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;

DENT      ;EP

 +1        IF 'V

               QUIT -1

 +2        IF '$DATA(^AUPNVSIT(V))

               QUIT -1

 +3        IF '$GET(N)

               QUIT -1

 +4        NEW %,Y,P,C,Z

 +5        SET (Z,P)=""

           SET (Y,C)=0

 +6        SET Y=0

           FOR 

               SET Y=$ORDER(^AUPNVDEN("AD",V,Y))

               IF Y'=+Y

                   QUIT 

               SET C=C+1

               IF C=N

                   SET P=$PIECE(^AUPNVDEN(Y,0),U)

                   SET Z=Y

 +7        IF 'P

               QUIT P

 +8        IF '$DATA(^AUTTADA(P))

               QUIT -1

 +9        IF $GET(F)=""

               SET F="C"

 +10       SET %=""

           DO @F

 +11       QUIT %

 +12      ;

I         ;

 +1        SET %=P

           QUIT 

E         ;

 +1        SET %=$PIECE(^AUTTADA(Z,0),U,2)

           QUIT 

U         ;

 +1        SET %=$PIECE(^AUPNVDEN(Z,0),U,4)

           QUIT 

C         ;

 +1        SET %=$PIECE(^AUTTADA(P,0),U)

           QUIT 

R         ;fee rounded to nearest $

 +1        SET %=$PIECE(^AUPNVDEN(Z,0),U,7)

           QUIT 

 +2        IF %=""

               QUIT 

 +3        SET %=$PIECE((%+.5),".")

 +4        QUIT 

F         ;fee

 +1        SET %=$PIECE(^AUPNVDEN(Z,0),U,5)

           QUIT