APCLCP5 ; IHS/CMI/LAB - DISC tally activity time ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
START ;
I '$G(DUZ(2)) W $C(7),$C(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!! Q
S APCLSITE=DUZ(2)
I APCLSORV="APCLVLOC" S APCLNSP="APCLCP5",APCLSORT="LOCATION OF ENCOUNTER"
I APCLSORV="APCLCODE" S APCLNSP="APCLCP5",APCLSORT="PRIMARY DX"
D INFORM
;
GETGROUP ;
W ! S DIC="^APCLACTG(",DIC("A")="Enter the Provider Discipline Group you wish to report on: ",DIC(0)="AEMQ" D ^DIC
I Y=-1 W !,"Bye ... " G XIT
S APCLACTG=+Y
W !!,"You have selected the ",$P(Y,U,2)," discipline group.",!
S DIC="^APCLACTG(",DA=+Y D EN^DIQ K DIC,DA
GETDATES ;
BD ;get beginning date
W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning Visit Date for Search" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G GETGROUP
S APCLBD=Y
ED ;get ending date
W ! S DIR(0)="DA^"_APCLBD_":DT:EP",DIR("A")="Enter ending Visit Date for Search: " S Y=APCLBD D DD^%DT S Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G BD
S APCLED=Y
S X1=APCLBD,X2=-1 D C^%DTC S APCLSD=X
;
LOC ;get location
K APCLLOC
S DIR(0)="S^O:One Location;T:Taxonomy of or Selected Set of Locations;A:All Locations"
S DIR("A")="Include visits from which set of locations",DIR("B")="A" KILL DA D ^DIR KILL DIR
G:$D(DIRUT) BD
I Y="A" K APCLLOC G CLINIC
I Y="O" D O^APCLCP1 G:$D(APCLQ) LOC
I Y="T" D T^APCLCP1 G:$D(APCLQ) LOC
CLINIC ;
K APCLCLN
S DIR(0)="S^O:One Clinic;T:Taxonomy of or Selected Set of Clinics;A:All Clinics"
S DIR("A")="Include visits from which set of clinics",DIR("B")="A" KILL DA D ^DIR KILL DIR
G:$D(DIRUT) LOC
I Y="A" K APCLCLN G ZIS
I Y="O" D OC^APCLCP1 G:$D(APCLQ) CLINIC
I Y="T" D TC^APCLCP1 G:$D(APCLQ) CLINIC
;
ZIS ;
DEMO ;
D DEMOCHK^APCLUTL(.APCLDEMO)
I APCLDEMO=-1 G CLINIC
S XBRP="^APCLCP5P",XBRC="PROCESS^APCLCP5",XBRX="XIT^APCLCP5",XBNS="APCL"
D ^XBDBQUE
D XIT
Q
;
ERR W $C(7),$C(7),!,"Must be a valid date and be Today or earlier. Time not allowed!" Q
XIT ;
K APCL80S,APCLBDD,APCLBT,APCLDT,APCLED,APCLEDD,APCLLENG,APCLLOC,APCLPG,APCLQUIT,APCL1,APCL2,APCLAP,APCLDISC,APCLODAT,APCLSD,APCLSKIP,APCLVACT,APCLVDFN,APCLVLOC,APCLVREC,APCLVTM,APCLVTT,APCLX,APCLY,APCLPRIM,APCLSITE,APCLBD
K APCLACTG,APCLPIEC,APCLGLOB,APCLRRTN,APCLJOB
K X,Z,X1,X2,%,Y,DIRUT,POP,ZTSK,T,S,M,TS,H,DIR,DUOUT,DTOUT,DUOUT,DLOUT,APCLNSP,APCLSORT,APCLZ,APCLSORV,APCLVAL,APCLSUB
Q
;
INFORM ;
W:$D(IOF) @IOF
W !,"Time and Services Report by Provider a Group of Provider Disciplines",!,"that you select.",!
W !,"This report displays by ",APCLSORT,", the number of patient",!,"CHART REVIEWS and the total activity and travel time for each provider",!,"with a discipline in the provider discipline group that you select."
W !
Q
;
PROCESS ;EP - called from xbdbque
S APCLJOB=$J,APCLBT=$H
I $P(^APCLACTG(APCLACTG,0),U,2)]"",$P(^(0),U,3)]"",$P(^(0),U,4)]"" D I 1
.S APCLRRTN=$S($P($P(^APCLACTG(APCLACTG,0),U,2),"~",2)]"":$P($P(^APCLACTG(APCLACTG,0),U,2),"~")_"^"_$P($P(^APCLACTG(APCLACTG,0),U,2),"~",2),1:$P(^APCLACTG(APCLACTG,0),U,2)),APCLPIEC=$P(^(0),U,4),APCLGLOB="^"_$P(^(0),U,3)_"("
.S X=APCLRRTN X ^%ZOSF("TEST") I '$T S APCLRRTN="",APCLGLOB="^ICD9(",APCLPIEC=3 Q
E S APCLGLOB="^ICD9(",APCLRRTN="",APCLPIEC=3
I APCLRRTN]"" S APCLRRTN="^"_APCLRRTN
V ; Run by visit date
K ^XTMP(APCLNSP,APCLJOB,APCLBT)
D XTMP^APCLOSUT(APCLNSP,"PCC ACTIVITY REPORT")
S APCLODAT=$O(^AUPNVSIT("B",APCLSD)) G:APCLODAT="" END
S APCLODAT=APCLSD_".9999" F S APCLODAT=$O(^AUPNVSIT("B",APCLODAT)) Q:APCLODAT=""!((APCLODAT\1)>APCLED) D V1
END ;
D EOJ
S APCLET=$H
Q
V1 ;
S APCLVDFN=0 F S APCLVDFN=$O(^AUPNVSIT("B",APCLODAT,APCLVDFN)) Q:APCLVDFN'=+APCLVDFN I $D(^AUPNVSIT(APCLVDFN,0)) S APCLVREC=^(0) I $P(APCLVREC,U,9),'$P(APCLVREC,U,11),$D(^AUPNVPRV("AD",APCLVDFN)),$D(^AUPNVPOV("AD",APCLVDFN)) D PROC,EOJ
Q
PROC ;
K APCLSKIP
Q:$$DEMO^APCLUTL($P(APCLVREC,U,5),$G(APCLDEMO))
Q:$P(APCLVREC,U,7)'="C"
I $D(APCLLOC) Q:$P(APCLVREC,U,6)="" I '$D(APCLLOC($P(APCLVREC,U,6))) Q
I $D(APCLCLN) Q:$P(APCLVREC,U,8)="" I '$D(APCLCLN($P(APCLVREC,U,8))) Q
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=0
Q:APCL1>1
S APCLVLOC=$P(APCLVREC,U,6)
D PROC2
Q
EOJ K APCLVLOC,APCLVREC,APCLSKIP,APCL1,APCL2,APCLX,APCLY,APCLPRIM,@APCLSORV,APCLDISC,APCLVLOC,APCLVTM,APCLVTT,APCLCODE,APCLIPTR
Q
;
;
PROC2 ;
S APCLZ=0 F S APCLZ=$O(^AUPNVPRV("AD",APCLVDFN,APCLZ)) Q:APCLZ'=+APCLZ D
. S APCLAP=$P(^AUPNVPRV(APCLZ,0),U)
. I $P(^DD(9000010.06,.01,0),U,2)[200 S APCLDISC=$$PROVCLSC^XBFUNC1(APCLAP) G PROC21
. S APCLY=$P(^VA(200,APCLAP,0),U,4)
. Q:APCLY=""
. Q:'$D(^DIC(7,APCLY,9999999))
. S APCLDISC=$P(^DIC(7,APCLY,9999999),U)
PROC21 . I '$D(^APCLACTG(APCLACTG,11,"AC",APCLDISC)) Q
. I APCLSORV="APCLCODE" D GETCODE Q:'APCLCODE
. S ^("TOTAL")=$S($D(^XTMP(APCLNSP,APCLJOB,APCLBT,APCLAP,@APCLSORV,"TOTAL")):^("TOTAL")+1,1:1)
. I $P(^AUPNVPRV(APCLZ,0),U,4)="P" S ^("PRIM")=$S($D(^XTMP(APCLNSP,APCLJOB,APCLBT,APCLAP,@APCLSORV,"PRIM")):^("PRIM")+1,1:1)
. I $P(^AUPNVPRV(APCLZ,0),U,4)'="P" S ^("SEC")=$S($D(^XTMP(APCLNSP,APCLJOB,APCLBT,APCLAP,@APCLSORV,"SEC")):^("SEC")+1,1:1)
. I '$D(^AUPNVTM("AD",APCLVDFN)) S ^("NOACT")=$S($D(^XTMP(APCLNSP,APCLJOB,APCLBT,APCLAP,"NOACT")):^("NOACT")+1,1:1) Q
. S APCLVTM=$O(^AUPNVTM("AD",APCLVDFN,"")),APCLVACT=$P(^AUPNVTM(APCLVTM,0),U),APCLVTT=$P(^AUPNVTM(APCLVTM,0),U,4)
. S ^("ACT")=$S($D(^XTMP(APCLNSP,APCLJOB,APCLBT,APCLAP,@APCLSORV,"ACT")):^("ACT")+APCLVACT,1:APCLVACT)
. I APCLVTT S ^("TT")=$S($D(^XTMP(APCLNSP,APCLJOB,APCLBT,APCLAP,@APCLSORV,"TT")):^("TT")+APCLVTT,1:APCLVTT)
. Q
Q
GETCODE ;
D GETPPOV
S APCLIPTR=$P(^AUPNVPOV(APCL1,0),U)
I $G(APCLRRTN)]"" D @APCLRRTN Q
S APCLCODE=APCLIPTR
Q
GETPPOV ;
I $P(APCLVREC,U,7)'="H" S APCL1=$O(^AUPNVPOV("AD",APCLVDFN,"")) Q
S (APCL1,APCL2)=0 F S APCL2=$O(^AUPNVPOV("AD",APCLVDFN,APCL2)) Q:APCL2'=+APCL2!(APCL1) I $P(^AUPNVPOV(APCL2,0),U,12)="P" S APCL1=APCL2
Q
;
APCLCP5 ; IHS/CMI/LAB - DISC tally activity time ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
START ;
+1 IF '$GET(DUZ(2))
WRITE $CHAR(7),$CHAR(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!!
QUIT
+2 SET APCLSITE=DUZ(2)
+3 IF APCLSORV="APCLVLOC"
SET APCLNSP="APCLCP5"
SET APCLSORT="LOCATION OF ENCOUNTER"
+4 IF APCLSORV="APCLCODE"
SET APCLNSP="APCLCP5"
SET APCLSORT="PRIMARY DX"
+5 DO INFORM
+6 ;
GETGROUP ;
+1 WRITE !
SET DIC="^APCLACTG("
SET DIC("A")="Enter the Provider Discipline Group you wish to report on: "
SET DIC(0)="AEMQ"
DO ^DIC
+2 IF Y=-1
WRITE !,"Bye ... "
GOTO XIT
+3 SET APCLACTG=+Y
+4 WRITE !!,"You have selected the ",$PIECE(Y,U,2)," discipline group.",!
+5 SET DIC="^APCLACTG("
SET DA=+Y
DO EN^DIQ
KILL DIC,DA
GETDATES ;
BD ;get beginning date
+1 WRITE !
SET DIR(0)="D^:DT:EP"
SET DIR("A")="Enter beginning Visit Date for Search"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO GETGROUP
+3 SET APCLBD=Y
ED ;get ending date
+1 WRITE !
SET DIR(0)="DA^"_APCLBD_":DT:EP"
SET DIR("A")="Enter ending Visit Date for Search: "
SET Y=APCLBD
DO DD^%DT
SET Y=""
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO BD
+3 SET APCLED=Y
+4 SET X1=APCLBD
SET X2=-1
DO C^%DTC
SET APCLSD=X
+5 ;
LOC ;get location
+1 KILL APCLLOC
+2 SET DIR(0)="S^O:One Location;T:Taxonomy of or Selected Set of Locations;A:All Locations"
+3 SET DIR("A")="Include visits from which set of locations"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
GOTO BD
+5 IF Y="A"
KILL APCLLOC
GOTO CLINIC
+6 IF Y="O"
DO O^APCLCP1
IF $DATA(APCLQ)
GOTO LOC
+7 IF Y="T"
DO T^APCLCP1
IF $DATA(APCLQ)
GOTO LOC
CLINIC ;
+1 KILL APCLCLN
+2 SET DIR(0)="S^O:One Clinic;T:Taxonomy of or Selected Set of Clinics;A:All Clinics"
+3 SET DIR("A")="Include visits from which set of clinics"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
GOTO LOC
+5 IF Y="A"
KILL APCLCLN
GOTO ZIS
+6 IF Y="O"
DO OC^APCLCP1
IF $DATA(APCLQ)
GOTO CLINIC
+7 IF Y="T"
DO TC^APCLCP1
IF $DATA(APCLQ)
GOTO CLINIC
+8 ;
ZIS ;
DEMO ;
+1 DO DEMOCHK^APCLUTL(.APCLDEMO)
+2 IF APCLDEMO=-1
GOTO CLINIC
+3 SET XBRP="^APCLCP5P"
SET XBRC="PROCESS^APCLCP5"
SET XBRX="XIT^APCLCP5"
SET XBNS="APCL"
+4 DO ^XBDBQUE
+5 DO XIT
+6 QUIT
+7 ;
ERR WRITE $CHAR(7),$CHAR(7),!,"Must be a valid date and be Today or earlier. Time not allowed!"
QUIT
XIT ;
+1 KILL APCL80S,APCLBDD,APCLBT,APCLDT,APCLED,APCLEDD,APCLLENG,APCLLOC,APCLPG,APCLQUIT,APCL1,APCL2,APCLAP,APCLDISC,APCLODAT,APCLSD,APCLSKIP,APCLVACT,APCLVDFN,APCLVLOC,APCLVREC,APCLVTM,APCLVTT,APCLX,APCLY,APCLPRIM,APCLSITE,APCLBD
+2 KILL APCLACTG,APCLPIEC,APCLGLOB,APCLRRTN,APCLJOB
+3 KILL X,Z,X1,X2,%,Y,DIRUT,POP,ZTSK,T,S,M,TS,H,DIR,DUOUT,DTOUT,DUOUT,DLOUT,APCLNSP,APCLSORT,APCLZ,APCLSORV,APCLVAL,APCLSUB
+4 QUIT
+5 ;
INFORM ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,"Time and Services Report by Provider a Group of Provider Disciplines",!,"that you select.",!
+3 WRITE !,"This report displays by ",APCLSORT,", the number of patient",!,"CHART REVIEWS and the total activity and travel time for each provider",!,"with a discipline in the provider discipline group that you select."
+4 WRITE !
+5 QUIT
+6 ;
PROCESS ;EP - called from xbdbque
+1 SET APCLJOB=$JOB
SET APCLBT=$HOROLOG
+2 IF $PIECE(^APCLACTG(APCLACTG,0),U,2)]""
IF $PIECE(^(0),U,3)]""
IF $PIECE(^(0),U,4)]""
Begin DoDot:1
+3 SET APCLRRTN=$SELECT($PIECE($PIECE(^APCLACTG(APCLACTG,0),U,2),"~",2)]"":$PIECE($PIECE(^APCLACTG(APCLACTG,0),U,2),"~")_"^"_$PIECE($PIECE(^APCLACTG(APCLACTG,0),U,2),"~",2),1:$PIECE(^APCLACTG(APCLACTG,0),U,2))
SET APCLPIEC=$PIECE(^(0),U,4)
SET APCLGLOB="^"_$PIECE(^(0),U,3)_"("
+4 SET X=APCLRRTN
XECUTE ^%ZOSF("TEST")
IF '$TEST
SET APCLRRTN=""
SET APCLGLOB="^ICD9("
SET APCLPIEC=3
QUIT
End DoDot:1
IF 1
+5 IF '$TEST
SET APCLGLOB="^ICD9("
SET APCLRRTN=""
SET APCLPIEC=3
+6 IF APCLRRTN]""
SET APCLRRTN="^"_APCLRRTN
V ; Run by visit date
+1 KILL ^XTMP(APCLNSP,APCLJOB,APCLBT)
+2 DO XTMP^APCLOSUT(APCLNSP,"PCC ACTIVITY REPORT")
+3 SET APCLODAT=$ORDER(^AUPNVSIT("B",APCLSD))
IF APCLODAT=""
GOTO END
+4 SET APCLODAT=APCLSD_".9999"
FOR
SET APCLODAT=$ORDER(^AUPNVSIT("B",APCLODAT))
IF APCLODAT=""!((APCLODAT\1)>APCLED)
QUIT
DO V1
END ;
+1 DO EOJ
+2 SET APCLET=$HOROLOG
+3 QUIT
V1 ;
+1 SET APCLVDFN=0
FOR
SET APCLVDFN=$ORDER(^AUPNVSIT("B",APCLODAT,APCLVDFN))
IF APCLVDFN'=+APCLVDFN
QUIT
IF $DATA(^AUPNVSIT(APCLVDFN,0))
SET APCLVREC=^(0)
IF $PIECE(APCLVREC,U,9)
IF '$PIECE(APCLVREC,U,11)
IF $DATA(^AUPNVPRV("AD",APCLVDFN))
IF $DATA(^AUPNVPOV("AD",APCLVDFN))
DO PROC
DO EOJ
+2 QUIT
PROC ;
+1 KILL APCLSKIP
+2 IF $$DEMO^APCLUTL($PIECE(APCLVREC,U,5),$GET(APCLDEMO))
QUIT
+3 IF $PIECE(APCLVREC,U,7)'="C"
QUIT
+4 IF $DATA(APCLLOC)
IF $PIECE(APCLVREC,U,6)=""
QUIT
IF '$DATA(APCLLOC($PIECE(APCLVREC,U,6)))
QUIT
+5 IF $DATA(APCLCLN)
IF $PIECE(APCLVREC,U,8)=""
QUIT
IF '$DATA(APCLCLN($PIECE(APCLVREC,U,8)))
QUIT
+6 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)
+7 IF APCL1=0
QUIT
+8 IF APCL1>1
QUIT
+9 SET APCLVLOC=$PIECE(APCLVREC,U,6)
+10 DO PROC2
+11 QUIT
EOJ KILL APCLVLOC,APCLVREC,APCLSKIP,APCL1,APCL2,APCLX,APCLY,APCLPRIM,@APCLSORV,APCLDISC,APCLVLOC,APCLVTM,APCLVTT,APCLCODE,APCLIPTR
+1 QUIT
+2 ;
+3 ;
PROC2 ;
+1 SET APCLZ=0
FOR
SET APCLZ=$ORDER(^AUPNVPRV("AD",APCLVDFN,APCLZ))
IF APCLZ'=+APCLZ
QUIT
Begin DoDot:1
+2 SET APCLAP=$PIECE(^AUPNVPRV(APCLZ,0),U)
+3 IF $PIECE(^DD(9000010.06,.01,0),U,2)[200
SET APCLDISC=$$PROVCLSC^XBFUNC1(APCLAP)
GOTO PROC21
+4 SET APCLY=$PIECE(^VA(200,APCLAP,0),U,4)
+5 IF APCLY=""
QUIT
+6 IF '$DATA(^DIC(7,APCLY,9999999))
QUIT
+7 SET APCLDISC=$PIECE(^DIC(7,APCLY,9999999),U)
PROC21 IF '$DATA(^APCLACTG(APCLACTG,11,"AC",APCLDISC))
QUIT
+1 IF APCLSORV="APCLCODE"
DO GETCODE
IF 'APCLCODE
QUIT
+2 SET ^("TOTAL")=$SELECT($DATA(^XTMP(APCLNSP,APCLJOB,APCLBT,APCLAP,@APCLSORV,"TOTAL")):^("TOTAL")+1,1:1)
+3 IF $PIECE(^AUPNVPRV(APCLZ,0),U,4)="P"
SET ^("PRIM")=$SELECT($DATA(^XTMP(APCLNSP,APCLJOB,APCLBT,APCLAP,@APCLSORV,"PRIM")):^("PRIM")+1,1:1)
+4 IF $PIECE(^AUPNVPRV(APCLZ,0),U,4)'="P"
SET ^("SEC")=$SELECT($DATA(^XTMP(APCLNSP,APCLJOB,APCLBT,APCLAP,@APCLSORV,"SEC")):^("SEC")+1,1:1)
+5 IF '$DATA(^AUPNVTM("AD",APCLVDFN))
SET ^("NOACT")=$SELECT($DATA(^XTMP(APCLNSP,APCLJOB,APCLBT,APCLAP,"NOACT")):^("NOACT")+1,1:1)
QUIT
+6 SET APCLVTM=$ORDER(^AUPNVTM("AD",APCLVDFN,""))
SET APCLVACT=$PIECE(^AUPNVTM(APCLVTM,0),U)
SET APCLVTT=$PIECE(^AUPNVTM(APCLVTM,0),U,4)
+7 SET ^("ACT")=$SELECT($DATA(^XTMP(APCLNSP,APCLJOB,APCLBT,APCLAP,@APCLSORV,"ACT")):^("ACT")+APCLVACT,1:APCLVACT)
+8 IF APCLVTT
SET ^("TT")=$SELECT($DATA(^XTMP(APCLNSP,APCLJOB,APCLBT,APCLAP,@APCLSORV,"TT")):^("TT")+APCLVTT,1:APCLVTT)
+9 QUIT
End DoDot:1
+10 QUIT
GETCODE ;
+1 DO GETPPOV
+2 SET APCLIPTR=$PIECE(^AUPNVPOV(APCL1,0),U)
+3 IF $GET(APCLRRTN)]""
DO @APCLRRTN
QUIT
+4 SET APCLCODE=APCLIPTR
+5 QUIT
GETPPOV ;
+1 IF $PIECE(APCLVREC,U,7)'="H"
SET APCL1=$ORDER(^AUPNVPOV("AD",APCLVDFN,""))
QUIT
+2 SET (APCL1,APCL2)=0
FOR
SET APCL2=$ORDER(^AUPNVPOV("AD",APCLVDFN,APCL2))
IF APCL2'=+APCL2!(APCL1)
QUIT
IF $PIECE(^AUPNVPOV(APCL2,0),U,12)="P"
SET APCL1=APCL2
+3 QUIT
+4 ;
