APCLV01.m

APCLV01 ; IHS/CMI/LAB - provider functions ;

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

 ;

MEAS ;EP

 NEW Z,C,%,S

 S (C,Y)=0 F  S Y=$O(^AUPNVMSR("AD",V,Y)) Q:Y'=+Y   I '$P($G(^AUPNVMSR(Y,2)),U,1) S C=C+1 S APCLV(C)="" D

 .I F=99 D  Q

 ..F I=1:1 S S=$T(@I) Q:S=""  S %="" D @I S $P(APCLV(C),U,I)=%

 .I F[";" D  Q

 ..F J=1:1 S I=$P(F,";",J) Q:I=""  I I'=99 S %="" D @I S $P(APCLV(C),U,J)=%

 .S %="",I=F D @I S $P(APCLV(C),U)=%

 .Q

 Q

1 ;

 S %=$$VD^APCLV($P(^AUPNVMSR(Y,0),U,3),"I")

 Q

2 ;

 S %=$$VD^APCLV($P(^AUPNVMSR(Y,0),U,3),"S")

 Q

3 ;

 S %=$P(^AUPNVMSR(Y,0),U,2)

 Q

4 ;

 S %=$$PATIENT^APCLV($P(^AUPNVMSR(Y,0),U,3),"E")

 Q

5 ;

 S %=$P(^AUPNVMSR(Y,0),U)

 Q

 S %=$$PATIENT^APCLV($P(^AUPNVMSR(Y,0),U,3),"E")

 Q

6 ;

 S %=$P(^AUTTMSR($P(^AUPNVMSR(Y,0),U),0),U,2)

 Q

7 ;

 S %=$P(^AUTTMSR($P(^AUPNVMSR(Y,0),U),0),U)

 Q

8 ;

 S %=$P(^AUPNVMSR(Y,0),U,4)

 Q

9 ;

 S %=$P(^AUTTMSR($P(^AUPNVMSR(Y,0),U),0),U,11)

 Q

 ;

APCLV01   ; IHS/CMI/LAB - provider functions ;

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

 +2       ;

MEAS      ;EP

 +1        NEW Z,C,%,S

 +2        SET (C,Y)=0

           FOR 

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

               IF Y'=+Y

                   QUIT 

               IF '$PIECE($GET(^AUPNVMSR(Y,2)),U,1)

                   SET C=C+1

                   SET APCLV(C)=""

                   Begin DoDot:1

 +3                    IF F=99

                           Begin DoDot:2

 +4                            FOR I=1:1

                                   SET S=$TEXT(@I)

                                   IF S=""

                                       QUIT 

                                   SET %=""

                                   DO @I

                                   SET $PIECE(APCLV(C),U,I)=%

                           End DoDot:2

                           QUIT 

 +5                    IF F[";"

                           Begin DoDot:2

 +6                            FOR J=1:1

                                   SET I=$PIECE(F,";",J)

                                   IF I=""

                                       QUIT 

                                   IF I'=99

                                       SET %=""

                                       DO @I

                                       SET $PIECE(APCLV(C),U,J)=%

                           End DoDot:2

                           QUIT 

 +7                    SET %=""

                       SET I=F

                       DO @I

                       SET $PIECE(APCLV(C),U)=%

 +8                    QUIT 

                   End DoDot:1

 +9        QUIT 

1         ;

 +1        SET %=$$VD^APCLV($PIECE(^AUPNVMSR(Y,0),U,3),"I")

 +2        QUIT 

2         ;

 +1        SET %=$$VD^APCLV($PIECE(^AUPNVMSR(Y,0),U,3),"S")

 +2        QUIT 

3         ;

 +1        SET %=$PIECE(^AUPNVMSR(Y,0),U,2)

 +2        QUIT 

4         ;

 +1        SET %=$$PATIENT^APCLV($PIECE(^AUPNVMSR(Y,0),U,3),"E")

 +2        QUIT 

5         ;

 +1        SET %=$PIECE(^AUPNVMSR(Y,0),U)

 +2        QUIT 

 +3        SET %=$$PATIENT^APCLV($PIECE(^AUPNVMSR(Y,0),U,3),"E")

 +4        QUIT 

6         ;

 +1        SET %=$PIECE(^AUTTMSR($PIECE(^AUPNVMSR(Y,0),U),0),U,2)

 +2        QUIT 

7         ;

 +1        SET %=$PIECE(^AUTTMSR($PIECE(^AUPNVMSR(Y,0),U),0),U)

 +2        QUIT 

8         ;

 +1        SET %=$PIECE(^AUPNVMSR(Y,0),U,4)

 +2        QUIT 

9         ;

 +1        SET %=$PIECE(^AUTTMSR($PIECE(^AUPNVMSR(Y,0),U),0),U,11)

 +2        QUIT 

 +3       ;