- 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 ;
