- APCLAP61 ; IHS/CMI/LAB - PRIM CARE PROVIDERREPORT PROCESS ;
- ;;2.0;IHS PCC SUITE;**15**;MAY 14, 2009;Build 11
- ;
- START ;
- S APCLBT=$H
- K ^XTMP("APCLAP6",APCLJOB,APCLBTH)
- D XTMP^APCLOSUT("APCLAP6","PCC - PCP VISITS BY DAY/YEAR")
- ;
- V ; Run by visit date
- S APCLODAT=APCLSD_".9999" F S APCLODAT=$O(^AUPNVSIT("B",APCLODAT)) Q:APCLODAT=""!((APCLODAT\1)>APCLED) D V1
- ;
- END ;
- S APCLET=$H
- K APCLSKIP,APCLVREC,APCLVDFN,APCLAP,APCLVD,APCLDISC
- Q
- V1 ;
- ;count only visits with service category of A, O, R, S
- S APCLVDFN="" F S APCLVDFN=$O(^AUPNVSIT("B",APCLODAT,APCLVDFN)) Q:APCLVDFN'=+APCLVDFN I $D(^AUPNVSIT(APCLVDFN,0)),$P(^(0),U,9),'$P(^(0),U,11),"AORS"[$P(^(0),U,7) S APCLVREC=^(0) D PROC
- Q
- PROC ;
- K APCLSKIP
- Q:$$DEMO^APCLUTL($P(APCLVREC,U,5),$G(APCLDEMO))
- Q:'$D(^AUPNVPRV("AD",APCLVDFN)) ;quit if no provider entry
- Q:'$D(^AUPNVPOV("AD",APCLVDFN)) ;quit if no pov entry
- I $D(APCLLOC),$$CHKLOC^APCLOCCK(APCLLOC,$P(APCLVREC,U,6))=0 Q
- I $D(APCLCLNT),'$P(APCLVREC,U,8) Q
- I $D(APCLCLNT),'$D(APCLCLNT($P(APCLVREC,U,8))) Q
- I $D(APCLLOCT),$P(APCLVREC,U,6)="" Q
- I $D(APCLLOCT),'$D(APCLLOCT($P(APCLVREC,U,6))) Q
- ;
- PROC1 ;
- S (APCL1,APCL2)=0 F S APCL2=$O(^AUPNVPRV("AD",APCLVDFN,APCL2)) Q:APCL2="" I $P(^AUPNVPRV(APCL2,0),U,4)="P" S APCL1=APCL1+1,APCLAP=$P(^(0),U)
- Q:APCL1'=1
- S APCLDISC="" D CHKDISC
- Q:'$D(APCLPRIM)
- S APCLSORT=$S($D(APCLCLNT):$P(APCLVREC,U,8),1:$P(APCLVREC,U,6))
- S ^(APCLSORT)=$S($D(^XTMP("APCLAP6",APCLJOB,APCLBTH,APCLAP,APCLSORT)):^(APCLSORT)+1,1:1)
- Q
- ;
- CHKDISC ;
- K APCLPRIM
- ;I $P(^DD(9000010.06,.01,0),U,2)[6 G CHKDISC6
- Q:'$D(^VA(200,APCLAP))
- ;S APCLDISC=$$PROVCLSC^XBFUNC1(APCLAP) I APCLDISC="UNKNOWN"!(APCLDISC="") Q
- NEW X
- S X=$$VALI^XBDIQ1(200,APCLAP,53.5) I X,$P($G(^DIC(7,X,9999999)),U,3)="Y" S APCLPRIM=1
- ;I $D(^APCLCNTL(1,11,"B",APCLDISC)) S APCLPRIM=1
- Q
- CHKDISC6 ;
- I '$D(^DIC(6,APCLAP)) Q
- S APCLY=$P(^DIC(6,APCLAP,0),U,4)
- I APCLY="" S APCLDISC="??" Q
- I '$D(^DIC(7,APCLY,9999999)) S APCLDISC="??" Q
- S APCLDISC=$P(^DIC(7,APCLY,9999999),U) I APCLDISC="" S APCLDISC="??" Q
- I $D(^APCLCNTL(1,11,"B",APCLDISC)) S APCLPRIM=1
- Q
- APCLAP61 ; IHS/CMI/LAB - PRIM CARE PROVIDERREPORT PROCESS ;
- +1 ;;2.0;IHS PCC SUITE;**15**;MAY 14, 2009;Build 11
- +2 ;
- START ;
- +1 SET APCLBT=$HOROLOG
- +2 KILL ^XTMP("APCLAP6",APCLJOB,APCLBTH)
- +3 DO XTMP^APCLOSUT("APCLAP6","PCC - PCP VISITS BY DAY/YEAR")
- +4 ;
- V ; Run by visit date
- +1 SET APCLODAT=APCLSD_".9999"
- FOR
- SET APCLODAT=$ORDER(^AUPNVSIT("B",APCLODAT))
- IF APCLODAT=""!((APCLODAT\1)>APCLED)
- QUIT
- DO V1
- +2 ;
- END ;
- +1 SET APCLET=$HOROLOG
- +2 KILL APCLSKIP,APCLVREC,APCLVDFN,APCLAP,APCLVD,APCLDISC
- +3 QUIT
- V1 ;
- +1 ;count only visits with service category of A, O, R, S
- +2 SET APCLVDFN=""
- FOR
- SET APCLVDFN=$ORDER(^AUPNVSIT("B",APCLODAT,APCLVDFN))
- IF APCLVDFN'=+APCLVDFN
- QUIT
- IF $DATA(^AUPNVSIT(APCLVDFN,0))
- IF $PIECE(^(0),U,9)
- IF '$PIECE(^(0),U,11)
- IF "AORS"[$PIECE(^(0),U,7)
- SET APCLVREC=^(0)
- DO PROC
- +3 QUIT
- PROC ;
- +1 KILL APCLSKIP
- +2 IF $$DEMO^APCLUTL($PIECE(APCLVREC,U,5),$GET(APCLDEMO))
- QUIT
- +3 ;quit if no provider entry
- IF '$DATA(^AUPNVPRV("AD",APCLVDFN))
- QUIT
- +4 ;quit if no pov entry
- IF '$DATA(^AUPNVPOV("AD",APCLVDFN))
- QUIT
- +5 IF $DATA(APCLLOC)
- IF $$CHKLOC^APCLOCCK(APCLLOC,$PIECE(APCLVREC,U,6))=0
- QUIT
- +6 IF $DATA(APCLCLNT)
- IF '$PIECE(APCLVREC,U,8)
- QUIT
- +7 IF $DATA(APCLCLNT)
- IF '$DATA(APCLCLNT($PIECE(APCLVREC,U,8)))
- QUIT
- +8 IF $DATA(APCLLOCT)
- IF $PIECE(APCLVREC,U,6)=""
- QUIT
- +9 IF $DATA(APCLLOCT)
- IF '$DATA(APCLLOCT($PIECE(APCLVREC,U,6)))
- QUIT
- +10 ;
- PROC1 ;
- +1 SET (APCL1,APCL2)=0
- FOR
- SET APCL2=$ORDER(^AUPNVPRV("AD",APCLVDFN,APCL2))
- IF APCL2=""
- QUIT
- IF $PIECE(^AUPNVPRV(APCL2,0),U,4)="P"
- SET APCL1=APCL1+1
- SET APCLAP=$PIECE(^(0),U)
- +2 IF APCL1'=1
- QUIT
- +3 SET APCLDISC=""
- DO CHKDISC
- +4 IF '$DATA(APCLPRIM)
- QUIT
- +5 SET APCLSORT=$SELECT($DATA(APCLCLNT):$PIECE(APCLVREC,U,8),1:$PIECE(APCLVREC,U,6))
- +6 SET ^(APCLSORT)=$SELECT($DATA(^XTMP("APCLAP6",APCLJOB,APCLBTH,APCLAP,APCLSORT)):^(APCLSORT)+1,1:1)
- +7 QUIT
- +8 ;
- CHKDISC ;
- +1 KILL APCLPRIM
- +2 ;I $P(^DD(9000010.06,.01,0),U,2)[6 G CHKDISC6
- +3 IF '$DATA(^VA(200,APCLAP))
- QUIT
- +4 ;S APCLDISC=$$PROVCLSC^XBFUNC1(APCLAP) I APCLDISC="UNKNOWN"!(APCLDISC="") Q
- +5 NEW X
- +6 SET X=$$VALI^XBDIQ1(200,APCLAP,53.5)
- IF X
- IF $PIECE($GET(^DIC(7,X,9999999)),U,3)="Y"
- SET APCLPRIM=1
- +7 ;I $D(^APCLCNTL(1,11,"B",APCLDISC)) S APCLPRIM=1
- +8 QUIT
- CHKDISC6 ;
- +1 IF '$DATA(^DIC(6,APCLAP))
- QUIT
- +2 SET APCLY=$PIECE(^DIC(6,APCLAP,0),U,4)
- +3 IF APCLY=""
- SET APCLDISC="??"
- QUIT
- +4 IF '$DATA(^DIC(7,APCLY,9999999))
- SET APCLDISC="??"
- QUIT
- +5 SET APCLDISC=$PIECE(^DIC(7,APCLY,9999999),U)
- IF APCLDISC=""
- SET APCLDISC="??"
- QUIT
- +6 IF $DATA(^APCLCNTL(1,11,"B",APCLDISC))
- SET APCLPRIM=1
- +7 QUIT
