APCDFQC1.m

APCDFQC1 ; IHS/CMI/LAB - DE FQA ;

 ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58

M ; Run by posting date

 S APCDVCNT=0,APCDODAT=APCDSD_".9999"

 F  S APCDODAT=$O(^AUPNVSIT(APCDXREF,APCDODAT)) Q:APCDODAT=""!((APCDODAT\1)>APCDED)  D V1

 Q

V1 ;

 S APCDVDFN=0

 F  S APCDVDFN=$O(^AUPNVSIT(APCDXREF,APCDODAT,APCDVDFN)) Q:APCDVDFN'=+APCDVDFN  D PROC

 Q

PROC ;

 S APCDVREC=^AUPNVSIT(APCDVDFN,0)

 Q:'$P(APCDVREC,U,9)

 Q:$P(APCDVREC,U,11)

 Q:'$D(^AUPNVPOV("AD",APCDVDFN))  ;NO VPOVS

 I $D(APCDSCT),'$D(APCDSCT($P(^AUPNVSIT(APCDVDFN,0),U,7))) Q  ;SERVICE CATEGORY CHECK

 I APCDCLN]"",APCDCLN'=$P(APCDVREC,U,8) Q  ;CLINIC CHECK

 I APCDPROV,'$$PROVCHK(APCDVDFN,APCDPROV) Q

 I APCDRVC="R" Q:'$$RC(APCDVDFN)

 D CHKPOV

 Q

RC(V) ;

 I $$VALI^XBDIQ1(9000010,V,1111)="R" Q 1

 ; NEW H

 ;S H=$O(^AUPNVINP("AD",V,0))

 ;I 'H Q ""

 ;I '$$VALI^XBDIQ1(9000010.02,H,.15) Q 1

 Q ""

PROVCHK(V,P) ;

 I $$LASTRC(V,P) Q 1  ;was this person the one last marked it rev/compl

 I $$POVLM(V,P) Q 1

 Q ""

POVLM(V,P) ;WAS ANY POV LAST MODIFIED BY THIS CODER

 NEW X,G

 S (X,G)=0

 F  S X=$O(^AUPNVPOV("AD",V,X)) Q:X'=+X!(G)  D

 .Q:$$VALI^XBDIQ1(9000010.07,X,1219)'=P

 .S G=1

 Q G

 ;

LASTRC(V,P) ;EP

 I '$D(^AUPNVSIT(V,0)) Q ""

 I '$D(^AUPNVCA("AD",V)) Q ""

 NEW X,G

 S G=""

 S X=0 F  S X=$O(^AUPNVCA("AD",V,X)) Q:X'=+X  D

 .Q:'$D(^AUPNVCA(X,0))

 .Q:$P(^AUPNVCA(X,0),U,4)'="R"

 .S G=$P(^AUPNVCA(X,0),U,5)  ;USER

 I G=P Q 1

 Q ""

CHKPOV ;

 I $D(^XTMP("APCDFQA",APCDJOB,APCDBT,"DEPOV","ALL")) D CNT Q

 S (APCD1,APCD2)=0 F  S APCD1=$O(^AUPNVPOV("AD",APCDVDFN,APCD1)) Q:APCD1'=+APCD1  S APCDICDP=$P(^AUPNVPOV(APCD1,0),U) I $D(^XTMP("APCDFQA",APCDJOB,APCDBT,"DEPOV","ICDDFN",APCDICDP)) S APCD2=APCD2+1

 I APCD2>0 D CNT

 Q

CNT ;

 S APCDVCNT=APCDVCNT+1,^XTMP("APCDFQA",APCDJOB,APCDBT,"DEQAV",APCDVCNT,APCDVDFN)=""

 Q

 ;

 ;

APCDFQC1  ; IHS/CMI/LAB - DE FQA ;

 +1       ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58

M         ; Run by posting date

 +1        SET APCDVCNT=0

           SET APCDODAT=APCDSD_".9999"

 +2        FOR 

               SET APCDODAT=$ORDER(^AUPNVSIT(APCDXREF,APCDODAT))

               IF APCDODAT=""!((APCDODAT\1)>APCDED)

                   QUIT 

               DO V1

 +3        QUIT 

V1        ;

 +1        SET APCDVDFN=0

 +2        FOR 

               SET APCDVDFN=$ORDER(^AUPNVSIT(APCDXREF,APCDODAT,APCDVDFN))

               IF APCDVDFN'=+APCDVDFN

                   QUIT 

               DO PROC

 +3        QUIT 

PROC      ;

 +1        SET APCDVREC=^AUPNVSIT(APCDVDFN,0)

 +2        IF '$PIECE(APCDVREC,U,9)

               QUIT 

 +3        IF $PIECE(APCDVREC,U,11)

               QUIT 

 +4       ;NO VPOVS

           IF '$DATA(^AUPNVPOV("AD",APCDVDFN))

               QUIT 

 +5       ;SERVICE CATEGORY CHECK

           IF $DATA(APCDSCT)

               IF '$DATA(APCDSCT($PIECE(^AUPNVSIT(APCDVDFN,0),U,7)))

                   QUIT 

 +6       ;CLINIC CHECK

           IF APCDCLN]""

               IF APCDCLN'=$PIECE(APCDVREC,U,8)

                   QUIT 

 +7        IF APCDPROV

               IF '$$PROVCHK(APCDVDFN,APCDPROV)

                   QUIT 

 +8        IF APCDRVC="R"

               IF '$$RC(APCDVDFN)

                   QUIT 

 +9        DO CHKPOV

 +10       QUIT 

RC(V)     ;

 +1        IF $$VALI^XBDIQ1(9000010,V,1111)="R"

               QUIT 1

 +2       ; NEW H

 +3       ;S H=$O(^AUPNVINP("AD",V,0))

 +4       ;I 'H Q ""

 +5       ;I '$$VALI^XBDIQ1(9000010.02,H,.15) Q 1

 +6        QUIT ""

PROVCHK(V,P) ;

 +1       ;was this person the one last marked it rev/compl

           IF $$LASTRC(V,P)

               QUIT 1

 +2        IF $$POVLM(V,P)

               QUIT 1

 +3        QUIT ""

POVLM(V,P) ;WAS ANY POV LAST MODIFIED BY THIS CODER

 +1        NEW X,G

 +2        SET (X,G)=0

 +3        FOR 

               SET X=$ORDER(^AUPNVPOV("AD",V,X))

               IF X'=+X!(G)

                   QUIT 

               Begin DoDot:1

 +4                IF $$VALI^XBDIQ1(9000010.07,X,1219)'=P

                       QUIT 

 +5                SET G=1

               End DoDot:1

 +6        QUIT G

 +7       ;

LASTRC(V,P) ;EP

 +1        IF '$DATA(^AUPNVSIT(V,0))

               QUIT ""

 +2        IF '$DATA(^AUPNVCA("AD",V))

               QUIT ""

 +3        NEW X,G

 +4        SET G=""

 +5        SET X=0

           FOR 

               SET X=$ORDER(^AUPNVCA("AD",V,X))

               IF X'=+X

                   QUIT 

               Begin DoDot:1

 +6                IF '$DATA(^AUPNVCA(X,0))

                       QUIT 

 +7                IF $PIECE(^AUPNVCA(X,0),U,4)'="R"

                       QUIT 

 +8       ;USER

                   SET G=$PIECE(^AUPNVCA(X,0),U,5)

               End DoDot:1

 +9        IF G=P

               QUIT 1

 +10       QUIT ""

CHKPOV    ;

 +1        IF $DATA(^XTMP("APCDFQA",APCDJOB,APCDBT,"DEPOV","ALL"))

               DO CNT

               QUIT 

 +2        SET (APCD1,APCD2)=0

           FOR 

               SET APCD1=$ORDER(^AUPNVPOV("AD",APCDVDFN,APCD1))

               IF APCD1'=+APCD1

                   QUIT 

               SET APCDICDP=$PIECE(^AUPNVPOV(APCD1,0),U)

               IF $DATA(^XTMP("APCDFQA",APCDJOB,APCDBT,"DEPOV","ICDDFN",APCDICDP))

                   SET APCD2=APCD2+1

 +3        IF APCD2>0

               DO CNT

 +4        QUIT 

CNT       ;

 +1        SET APCDVCNT=APCDVCNT+1

           SET ^XTMP("APCDFQA",APCDJOB,APCDBT,"DEQAV",APCDVCNT,APCDVDFN)=""

 +2        QUIT 

 +3       ;

 +4       ;