APCDFOA1.m

APCDFOA1 ; IHS/CMI/LAB - DE FQA PROCEDURES ;

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

P ; Run by posting date

 S APCDVCNT=0,APCDODAT=APCDSD_".9999" F  S APCDODAT=$O(^APCDFORM("B",APCDODAT)) Q:APCDODAT=""!((APCDODAT\1)>APCDED)  S APCDDFN=$O(^APCDFORM("B",APCDODAT,"")) D V1

 Q

V1 ;

 S APCDC=0 F  S APCDC=$O(^APCDFORM(APCDDFN,11,APCDC)) Q:APCDC'=+APCDC  S APCDVDFN=$P(^APCDFORM(APCDDFN,11,APCDC,0),U) I APCDVDFN]"",$D(^AUPNVSIT(APCDVDFN,0)) D PROC

 Q

PROC ;

 I APCDPROV'=$P(^APCDFORM(APCDDFN,11,APCDC,0),U,2) Q

 S APCDVREC=^AUPNVSIT(APCDVDFN,0)

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

 Q:$P(APCDVREC,U,11)

 Q:'$D(^AUPNVPRC("AD",APCDVDFN))

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

 D CHKPOV

 Q

CHKPOV ;

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

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

 I APCD2>0 D CNT

 Q

CNT ;

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

 Q

 ;

APCDFOA1  ; IHS/CMI/LAB - DE FQA PROCEDURES ;

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

P         ; Run by posting date

 +1        SET APCDVCNT=0

           SET APCDODAT=APCDSD_".9999"

           FOR 

               SET APCDODAT=$ORDER(^APCDFORM("B",APCDODAT))

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

                   QUIT 

               SET APCDDFN=$ORDER(^APCDFORM("B",APCDODAT,""))

               DO V1

 +2        QUIT 

V1        ;

 +1        SET APCDC=0

           FOR 

               SET APCDC=$ORDER(^APCDFORM(APCDDFN,11,APCDC))

               IF APCDC'=+APCDC

                   QUIT 

               SET APCDVDFN=$PIECE(^APCDFORM(APCDDFN,11,APCDC,0),U)

               IF APCDVDFN]""

                   IF $DATA(^AUPNVSIT(APCDVDFN,0))

                       DO PROC

 +2        QUIT 

PROC      ;

 +1        IF APCDPROV'=$PIECE(^APCDFORM(APCDDFN,11,APCDC,0),U,2)

               QUIT 

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

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

               QUIT 

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

               QUIT 

 +5        IF '$DATA(^AUPNVPRC("AD",APCDVDFN))

               QUIT 

 +6        IF APCDCLN]""

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

                   QUIT 

 +7        DO CHKPOV

 +8        QUIT 

CHKPOV    ;

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

               DO CNT

               QUIT 

 +2        SET (APCD1,APCD2)=0

           FOR 

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

               IF APCD1'=+APCD1

                   QUIT 

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

               IF $DATA(^XTMP("APCDFOA",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("APCDFOA",APCDJOB,APCDBT,"DEQAV",APCDVCNT,APCDVDFN)=""

 +2        QUIT 

 +3       ;