APCLAP41 ; IHS/CMI/LAB - APC REPORT PROCESS ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
START ;
S APCLBT=$H
K ^XTMP("APCLAP4",APCLJOB,APCLBTH)
D XTMP^APCLOSUT("APCLAP4","AVG # VISITS PER DAY")
;
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
D EOJ
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,EOJ
Q
PROC ;
;K APCLSKIP
;Q:$D(^APCLCNTL(4,11,"B",$P(APCLVREC,U,3))) ;LAB/TUCSON CHANGED CV TO C FOR VA USE
Q:$$DEMO^APCLUTL($P(APCLVREC,U,5),$G(APCLDEMO))
I $$CHKLOC^APCLOCCK(APCLLOC,$P(APCLVREC,U,6))=0 Q
;Q:'$D(^AUPNVPOV("AD",APCLVDFN))
;Q:'$D(^AUPNVPRV("AD",APCLVDFN))
S APCLVLOC=$P(APCLVREC,U,6) Q:APCLVLOC=""
S APCLCLIN=$P(APCLVREC,U,8)
I APCLCLIN]"",$D(APCLCLNT),'$D(APCLCLNT(APCLCLIN)) Q
Q:'$$APCWL^APCLV(APCLVDFN)
I APCLCLIN="" S APCLCLIN=9999
CHKCL ;
;convert dental with med to pharmacy clinic
;G:$G(DUZ("AG"))["V" PROC1
;S X=$S(APCLCLIN="":"",$D(^DIC(40.7,APCLCLIN,0)):$P(^DIC(40.7,APCLCLIN,0),U,2),1:"")
;I X=56,'$D(^AUPNVMED("AD",APCLVDFN)) Q
;I X=56 S APCLCLIN=APCLRXCL
;Q:$D(^APCLCNTL(2,11,"B",X))
;
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(APCLSKIP)
;S APCLPPOV=$O(^AUPNVPOV("AD",APCLVDFN,"")) Q:'$D(^AUPNVPOV(APCLPPOV))
;S (APCLX,APCLICD)=$P(^ICD9($P(^AUPNVPOV(APCLPPOV,0),U),0),U)
;Q:APCLX=".9999"
D DATE
S ^(APCLSRT2)=$S($D(^XTMP("APCLAP4",APCLJOB,APCLBTH,"VISITS DOW",APCLSRT2)):^(APCLSRT2)+1,1:1)
I '$D(^XTMP("APCLAP4",APCLJOB,APCLBTH,"DOW DATE",APCLDATE)) S ^XTMP("APCLAP4",APCLJOB,APCLBTH,"DOW DATE",APCLDATE)="",^(APCLSRT2)=$S($D(^XTMP("APCLAP4",APCLJOB,APCLBTH,"DOW #",APCLSRT2)):^(APCLSRT2)+1,1:1)
Q
EOJ K APCLVLOC,APCLVREC,APCLCLIN,APCLSKIP,APCL1,APCL2,APCLAP,APCLDISC,APCLPPOV,APCLX,APCLHIGH,APCLDX,APCLLOW,APCLICD,APCLDA1,APCLDA2,APCLY,APCLSRT2,APCLDATE,APCLPROV,APCLSEC,APCLZ,APCLLOCC
Q
;
CHKDISC ;
I $P(^DD(9000010.06,.01,0),U,2)[6 G CHKDISC6
S APCLDISC=$$PROVCLSC^XBFUNC1(APCLAP) I APCLDISC="UNKNOWN" S APCLDISC="??" Q
S APCLLOCC=$E($P(^AUTTLOC(APCLVLOC,0),U,10),5,6)
I (APCLDISC=13!(APCLDISC=32))&((APCLLOCC>49)!(APCLLOCC'=+APCLLOCC)) S APCLSKIP=1
Q
;
CHKDISC6 ;
I '$D(^DIC(6,APCLAP)) S APCLSKIP=1 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
S APCLLOCC=$E($P(^AUTTLOC(APCLVLOC,0),U,10),5,6)
I (APCLDISC=13!(APCLDISC=32))&((APCLLOCC>49)!(APCLLOCC'=+APCLLOCC)) S APCLSKIP=1
Q
;
DATE ;
S APCLDATE=$P(APCLODAT,".")
S X=APCLDATE D H^%DTC S APCLSRT2=$P("SUNDAY;MONDAY;TUESDAY;WEDNESDAY;THURSDAY;FRIDAY;SATURDAY",";",%Y+1) I APCLSRT2="" S APCLSRT2="UNKNOWN"
Q
APCLAP41 ; IHS/CMI/LAB - APC REPORT PROCESS ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
START ;
+1 SET APCLBT=$HOROLOG
+2 KILL ^XTMP("APCLAP4",APCLJOB,APCLBTH)
+3 DO XTMP^APCLOSUT("APCLAP4","AVG # VISITS PER DAY")
+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 DO EOJ
+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
DO EOJ
+3 QUIT
PROC ;
+1 ;K APCLSKIP
+2 ;Q:$D(^APCLCNTL(4,11,"B",$P(APCLVREC,U,3))) ;LAB/TUCSON CHANGED CV TO C FOR VA USE
+3 IF $$DEMO^APCLUTL($PIECE(APCLVREC,U,5),$GET(APCLDEMO))
QUIT
+4 IF $$CHKLOC^APCLOCCK(APCLLOC,$PIECE(APCLVREC,U,6))=0
QUIT
+5 ;Q:'$D(^AUPNVPOV("AD",APCLVDFN))
+6 ;Q:'$D(^AUPNVPRV("AD",APCLVDFN))
+7 SET APCLVLOC=$PIECE(APCLVREC,U,6)
IF APCLVLOC=""
QUIT
+8 SET APCLCLIN=$PIECE(APCLVREC,U,8)
+9 IF APCLCLIN]""
IF $DATA(APCLCLNT)
IF '$DATA(APCLCLNT(APCLCLIN))
QUIT
+10 IF '$$APCWL^APCLV(APCLVDFN)
QUIT
+11 IF APCLCLIN=""
SET APCLCLIN=9999
CHKCL ;
+1 ;convert dental with med to pharmacy clinic
+2 ;G:$G(DUZ("AG"))["V" PROC1
+3 ;S X=$S(APCLCLIN="":"",$D(^DIC(40.7,APCLCLIN,0)):$P(^DIC(40.7,APCLCLIN,0),U,2),1:"")
+4 ;I X=56,'$D(^AUPNVMED("AD",APCLVDFN)) Q
+5 ;I X=56 S APCLCLIN=APCLRXCL
+6 ;Q:$D(^APCLCNTL(2,11,"B",X))
+7 ;
PROC1 ;
+1 ;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)
+2 ;Q:APCL1'=1
+3 ;S APCLDISC="" D CHKDISC
+4 ;Q:$D(APCLSKIP)
+5 ;S APCLPPOV=$O(^AUPNVPOV("AD",APCLVDFN,"")) Q:'$D(^AUPNVPOV(APCLPPOV))
+6 ;S (APCLX,APCLICD)=$P(^ICD9($P(^AUPNVPOV(APCLPPOV,0),U),0),U)
+7 ;Q:APCLX=".9999"
+8 DO DATE
+9 SET ^(APCLSRT2)=$SELECT($DATA(^XTMP("APCLAP4",APCLJOB,APCLBTH,"VISITS DOW",APCLSRT2)):^(APCLSRT2)+1,1:1)
+10 IF '$DATA(^XTMP("APCLAP4",APCLJOB,APCLBTH,"DOW DATE",APCLDATE))
SET ^XTMP("APCLAP4",APCLJOB,APCLBTH,"DOW DATE",APCLDATE)=""
SET ^(APCLSRT2)=$SELECT($DATA(^XTMP("APCLAP4",APCLJOB,APCLBTH,"DOW #",APCLSRT2)):^(APCLSRT2)+1,1:1)
+11 QUIT
EOJ KILL APCLVLOC,APCLVREC,APCLCLIN,APCLSKIP,APCL1,APCL2,APCLAP,APCLDISC,APCLPPOV,APCLX,APCLHIGH,APCLDX,APCLLOW,APCLICD,APCLDA1,APCLDA2,APCLY,APCLSRT2,APCLDATE,APCLPROV,APCLSEC,APCLZ,APCLLOCC
+1 QUIT
+2 ;
CHKDISC ;
+1 IF $PIECE(^DD(9000010.06,.01,0),U,2)[6
GOTO CHKDISC6
+2 SET APCLDISC=$$PROVCLSC^XBFUNC1(APCLAP)
IF APCLDISC="UNKNOWN"
SET APCLDISC="??"
QUIT
+3 SET APCLLOCC=$EXTRACT($PIECE(^AUTTLOC(APCLVLOC,0),U,10),5,6)
+4 IF (APCLDISC=13!(APCLDISC=32))&((APCLLOCC>49)!(APCLLOCC'=+APCLLOCC))
SET APCLSKIP=1
+5 QUIT
+6 ;
CHKDISC6 ;
+1 IF '$DATA(^DIC(6,APCLAP))
SET APCLSKIP=1
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 SET APCLLOCC=$EXTRACT($PIECE(^AUTTLOC(APCLVLOC,0),U,10),5,6)
+7 IF (APCLDISC=13!(APCLDISC=32))&((APCLLOCC>49)!(APCLLOCC'=+APCLLOCC))
SET APCLSKIP=1
+8 QUIT
+9 ;
DATE ;
+1 SET APCLDATE=$PIECE(APCLODAT,".")
+2 SET X=APCLDATE
DO H^%DTC
SET APCLSRT2=$PIECE("SUNDAY;MONDAY;TUESDAY;WEDNESDAY;THURSDAY;FRIDAY;SATURDAY",";",%Y+1)
IF APCLSRT2=""
SET APCLSRT2="UNKNOWN"
+3 QUIT
