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
