APCPHPRV.m

APCPHPRV ; IHS/TUCSON/LAB - INPATIENT RECORD PROVIDER INFOR AUGUST 14, 1992 ; [ 04/03/98  08:39 AM ]

 ;;2.0;IHS PCC DATA EXTRACTION SYSTEM;;APR 03, 1998

PROV ;

 ;get all provider information

 S (APCPH("MID"),APCPH("APC"))="",O=0 F  S O=$O(^AUPNVPRV("AD",APCP("V DFN"),O)) Q:O=""!($D(APCPE("ERROR")))  D DISC

 I $D(APCPE("ERROR")) Q

 I $D(APCPT("A")) S APCPH("APC")=APCPT("A") G EOJ

 S:$D(APCPT("P")) APCPH("APC")=APCPT("P")

 ;

EOJ ;

 K APCPT,X,Y,I,O

 Q

DISC ; Provider Code. CP

 S X=$P(^AUPNVPRV(O,0),U)

 S I=$$VAL^XBDIQ1(APCPS("PROV FILE"),X,1)

 S I=$E("    ",1,4-$L(I))_I

 S:$P(^AUPNVPRV(O,0),U,5)="A" APCPT("A")=I S:$P(^(0),U,4)="P" APCPT("P")=I

 I $$VAL^XBDIQ1(APCPS("PROV FILE"),X,9999999.03)=17 S APCPH("MID")=1

 Q

APCPHPRV  ; IHS/TUCSON/LAB - INPATIENT RECORD PROVIDER INFOR AUGUST 14, 1992 ; [ 04/03/98  08:39 AM ]

 +1       ;;2.0;IHS PCC DATA EXTRACTION SYSTEM;;APR 03, 1998

PROV      ;

 +1       ;get all provider information

 +2        SET (APCPH("MID"),APCPH("APC"))=""

           SET O=0

           FOR 

               SET O=$ORDER(^AUPNVPRV("AD",APCP("V DFN"),O))

               IF O=""!($DATA(APCPE("ERROR")))

                   QUIT 

               DO DISC

 +3        IF $DATA(APCPE("ERROR"))

               QUIT 

 +4        IF $DATA(APCPT("A"))

               SET APCPH("APC")=APCPT("A")

               GOTO EOJ

 +5        IF $DATA(APCPT("P"))

               SET APCPH("APC")=APCPT("P")

 +6       ;

EOJ       ;

 +1        KILL APCPT,X,Y,I,O

 +2        QUIT 

DISC      ; Provider Code. CP

 +1        SET X=$PIECE(^AUPNVPRV(O,0),U)

 +2        SET I=$$VAL^XBDIQ1(APCPS("PROV FILE"),X,1)

 +3        SET I=$EXTRACT("    ",1,4-$LENGTH(I))_I

 +4        IF $PIECE(^AUPNVPRV(O,0),U,5)="A"

               SET APCPT("A")=I

           IF $PIECE(^(0),U,4)="P"

               SET APCPT("P")=I

 +5        IF $$VAL^XBDIQ1(APCPS("PROV FILE"),X,9999999.03)=17

               SET APCPH("MID")=1

 +6        QUIT