APCLAP81 ; IHS/CMI/LAB - APC Visit Counts All Svc Cat Process Routine ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;Report to tally average number of visits per day of week by clinic
;
START ;
S APCLBT=$H
K ^XTMP("APCLAP8",APCLJOB,APCLBTH)
D XTMP^APCLOSUT("APCLAP8","PCC - AVG VISITS BY 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 visits for ALL service categories
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) S APCLVREC=^(0) D PROC,EOJ
Q
PROC ;
K APCLSKIP
Q:$$DEMO^APCLUTL($P(APCLVREC,U,5),$G(APCLDEMO))
Q:$D(^APCLCNTL(4,11,"B",$P(APCLVREC,U,3)))
I $$CHKLOC^APCLOCCK(APCLLOC,$P(APCLVREC,U,6))=0 Q
S APCLVLOC=$P(APCLVREC,U,6)
Q:'$D(^AUPNVPOV("AD",APCLVDFN))
Q:'$D(^AUPNVPRV("AD",APCLVDFN))
S APCLCLIN=$P(APCLVREC,U,8)
Q:APCLCLIN=""
S APCLCNAM=$P(^DIC(40.7,APCLCLIN,0),U)
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("APCLAP8",APCLJOB,APCLBTH,"VISITS DOW",APCLCNAM,APCLSRT2)):^(APCLSRT2)+1,1:1)
I '$D(^XTMP("APCLAP8",APCLJOB,APCLBTH,"DOW DATE",APCLCNAM,APCLDATE)) D
.S ^XTMP("APCLAP8",APCLJOB,APCLBTH,"DOW DATE",APCLCNAM,APCLDATE)="",^(APCLSRT2)=$S($D(^XTMP("APCLAP8",APCLJOB,APCLBTH,"DOW #",APCLCNAM,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"
;S X=APCLDATE D H^%DTC S APCLSRT2=%Y+1
Q
APCLAP81 ; IHS/CMI/LAB - APC Visit Counts All Svc Cat Process Routine ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;Report to tally average number of visits per day of week by clinic
+3 ;
START ;
+1 SET APCLBT=$HOROLOG
+2 KILL ^XTMP("APCLAP8",APCLJOB,APCLBTH)
+3 DO XTMP^APCLOSUT("APCLAP8","PCC - AVG VISITS BY 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 visits for ALL service categories
+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)
SET APCLVREC=^(0)
DO PROC
DO EOJ
+3 QUIT
PROC ;
+1 KILL APCLSKIP
+2 IF $$DEMO^APCLUTL($PIECE(APCLVREC,U,5),$GET(APCLDEMO))
QUIT
+3 IF $DATA(^APCLCNTL(4,11,"B",$PIECE(APCLVREC,U,3)))
QUIT
+4 IF $$CHKLOC^APCLOCCK(APCLLOC,$PIECE(APCLVREC,U,6))=0
QUIT
+5 SET APCLVLOC=$PIECE(APCLVREC,U,6)
+6 IF '$DATA(^AUPNVPOV("AD",APCLVDFN))
QUIT
+7 IF '$DATA(^AUPNVPRV("AD",APCLVDFN))
QUIT
+8 SET APCLCLIN=$PIECE(APCLVREC,U,8)
+9 IF APCLCLIN=""
QUIT
+10 SET APCLCNAM=$PIECE(^DIC(40.7,APCLCLIN,0),U)
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 ;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("APCLAP8",APCLJOB,APCLBTH,"VISITS DOW",APCLCNAM,APCLSRT2)):^(APCLSRT2)+1,1:1)
+10 IF '$DATA(^XTMP("APCLAP8",APCLJOB,APCLBTH,"DOW DATE",APCLCNAM,APCLDATE))
Begin DoDot:1
+11 SET ^XTMP("APCLAP8",APCLJOB,APCLBTH,"DOW DATE",APCLCNAM,APCLDATE)=""
SET ^(APCLSRT2)=$SELECT($DATA(^XTMP("APCLAP8",APCLJOB,APCLBTH,"DOW #",APCLCNAM,APCLSRT2)):^(APCLSRT2)+1,1:1)
End DoDot:1
+12 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 ;S X=APCLDATE D H^%DTC S APCLSRT2=%Y+1
+4 QUIT
