Routine: APCPSR3

APCPSR3 ; IHS/TUCSON/LAB - ; [ 08/17/03  8:19 PM ]

 ;;2.0;IHS PCC DATA EXTRACTION SYSTEM;**2,6**;APR 03, 1998

 Q:'$P(^APCPLOG(APCPSR("LOG"),21,APCPSR("V"),0),U,7)

 S APCPSR("PROC")=""""_APCPSR_""",APCPJOB,APCPBTH,"_""""_"GEN"_""""

 S APCPVAR="TYPE STATDB" D TYPE^APCPSR2 S APCPVAR="SC STATDB" D SC^APCPSR2 S APCPVAR="CLINIC STATDB" D CLINIC^APCPSR2 S APCPVAR="LOC STATDB" D LOC^APCPSR2 S APCPVAR="PROV STATDB" D PROV^APCPSR2 S APCPVAR="V DATE STATDB" D VD^APCPSR2

STATDBER ;

 S X=0 F  S X=$O(^APCPLOG(APCPSR("LOG"),51,X)) Q:X'=+X  I $E($P(^APCPLOG(APCPSR("LOG"),51,X,0),U,3),1,4)="E054" D

 .S ^("STATDBACTERR")=$S($D(^XTMP("APCPSR",APCPJOB,APCPBTH,"SKIPPED","STATDBACTERR")):(+^("STATDBACTERR")+1),1:1)

.Q

STATDBAP ;

 K APCPSR("SKIP STATDB")

 I $P(^APCPLOG(APCPSR("LOG"),21,APCPSR("V"),0),U,6) S ^("STATDBNOAPC")=$S($D(^XTMP("APCPSR",APCPJOB,APCPBTH,"SKIPPED","STATDBNOAPC")):(+^("STATDBNOAPC")+1),1:1),APCPSR("SKIP STATDB")="" Q

 S (APCPSR("1"),APCPSR("2"))=0 F  S APCPSR("2")=$O(^AUPNVPRV("AD",APCPSR("V"),APCPSR("2"))) Q:APCPSR("2")=""  I $P(^AUPNVPRV(APCPSR("2"),0),U,4)="P" S APCPSR("1")=APCPSR("1")+1,APCPSR("AP")=$P(^(0),U)

CHKDISC ;

 S APCPSR("DISC")=$$VAL^XBDIQ1(APCPS("PROV FILE"),APCPSR("AP"),9999999.03)

 S APCPSR("LOCC")=$E($P(^AUTTLOC($P(^AUPNVSIT(APCPSR("V"),0),U,6),0),U,10),5,6)

 I (APCPSR("DISC")=13!(APCPSR("DISC")=32))&((APCPSR("LOCC")>49)!(APCPSR("LOCC")'=+APCPSR("LOCC"))) S ^("STATDBNOAPC")=$S($D(^XTMP("APCPSR",APCPJOB,APCPBTH,"SKIPPED","STATDBNOAPC")):(+^("STATDBNOAPC")+1),1:1),APCPSR("SKIP STATDB")=""

APCPSR3   ; IHS/TUCSON/LAB - ; [ 08/17/03  8:19 PM ]

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

 +2       ;

 +3        IF '$PIECE(^APCPLOG(APCPSR("LOG"),21,APCPSR("V"),0),U,7)

               QUIT

 +4        SET APCPSR("PROC")=""""_APCPSR_""",APCPJOB,APCPBTH,"_""""_"GEN"_""""

 +5        SET APCPVAR="TYPE STATDB"

           DO TYPE^APCPSR2

           SET APCPVAR="SC STATDB"

           DO SC^APCPSR2

           SET APCPVAR="CLINIC STATDB"

           DO CLINIC^APCPSR2

           SET APCPVAR="LOC STATDB"

           DO LOC^APCPSR2

           SET APCPVAR="PROV STATDB"

           DO PROV^APCPSR2

           SET APCPVAR="V DATE STATDB"

           DO VD^APCPSR2

 +6        QUIT

STATDBER  ;

 +1        SET X=0

FOR

               SET X=$ORDER(^APCPLOG(APCPSR("LOG"),51,X))

               IF X'=+X

                   QUIT

               IF $EXTRACT($PIECE(^APCPLOG(APCPSR("LOG"),51,X,0),U,3),1,4)="E054"

                   Begin DoDot:1

 +2                    SET ^("STATDBACTERR")=$SELECT($DATA(^XTMP("APCPSR",APCPJOB,APCPBTH,"SKIPPED","STATDBACTERR")):(+^("STATDBACTERR")+1),1:1)

 +3                    QUIT

                   End DoDot:1

 +4        QUIT

STATDBAP  ;

 +1        KILL APCPSR("SKIP STATDB")

 +2        IF $PIECE(^APCPLOG(APCPSR("LOG"),21,APCPSR("V"),0),U,6)

               SET ^("STATDBNOAPC")=$SELECT($DATA(^XTMP("APCPSR",APCPJOB,APCPBTH,"SKIPPED","STATDBNOAPC")):(+^("STATDBNOAPC")+1),1:1)

               SET APCPSR("SKIP STATDB")=""

               QUIT

 +3        SET (APCPSR("1"),APCPSR("2"))=0

FOR

               SET APCPSR("2")=$ORDER(^AUPNVPRV("AD",APCPSR("V"),APCPSR("2")))

               IF APCPSR("2")=""

                   QUIT

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

                   SET APCPSR("1")=APCPSR("1")+1

                   SET APCPSR("AP")=$PIECE(^(0),U)

CHKDISC   ;

 +1        SET APCPSR("DISC")=$$VAL^XBDIQ1(APCPS("PROV FILE"),APCPSR("AP"),9999999.03)

 +2        SET APCPSR("LOCC")=$EXTRACT($PIECE(^AUTTLOC($PIECE(^AUPNVSIT(APCPSR("V"),0),U,6),0),U,10),5,6)

 +3        IF (APCPSR("DISC")=13!(APCPSR("DISC")=32))&((APCPSR("LOCC")>49)!(APCPSR("LOCC")'=+APCPSR("LOCC")))

               SET ^("STATDBNOAPC")=$SELECT($DATA(^XTMP("APCPSR",APCPJOB,APCPBTH,"SKIPPED","STATDBNOAPC")):(+^("STATDBNOAPC")+1),1:1)

               SET APCPSR("SKIP STATDB")=""

 +4       ;

 +5        QUIT

APCPSR3.m