- 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
