APCLCP1P ; IHS/CMI/LAB - tally activity ;
;;2.0;IHS PCC SUITE;**11,20**;MAY 14, 2009;Build 25
;IHS/CMI/LAB - patch 4 file 200 fix
START ;
S APCL80S="-------------------------------------------------------------------------------"
D NOW^%DTC S Y=X D DD^%DT S APCLDT=Y
S APCLSUB="TOTAL^PRIM^SEC^ACT^TT"
S Y=APCLBD D DD^%DT S APCLBDD=Y S Y=APCLED D DD^%DT S APCLEDD=Y
S (APCLPG,APCLAP)=0
K APCLQUIT
I '$D(^XTMP(APCLNSP,APCLJOB,APCLBT)) D HEAD W !!,"No visits to report",! G DONE
F S APCLAP=$O(^XTMP(APCLNSP,APCLJOB,APCLBT,APCLAP)) Q:APCLAP'=+APCLAP!($D(APCLQUIT)) D LOC
DONE ;
D DONE^APCLOSUT
K ^XTMP(APCLNSP,APCLJOB,APCLBT)
Q
LOC ;
D HEAD,SUBHEAD Q:$D(APCLQUIT)
F Y=1:1 S X=$P(APCLSUB,U,Y) Q:X="" S ^XTMP(APCLNSP,APCLJOB,APCLBT,"SUBTOTAL",APCLAP,X)=0
S APCLVAL="" F S APCLVAL=$O(^XTMP(APCLNSP,APCLJOB,APCLBT,APCLAP,APCLVAL)) Q:APCLVAL'=+APCLVAL!($D(APCLQUIT)) D P
W !!?10,"TOTAL:"
S Z=28 F Y=1,2,3 S X=$P(APCLSUB,U,Y) Q:X="" W ?Z,$J(^XTMP(APCLNSP,APCLJOB,APCLBT,"SUBTOTAL",APCLAP,X),7) S Z=Z+10 ;IHS/CMI/LAB - minutes to hours
F Y=4,5 S X=$P(APCLSUB,U,Y) Q:X="" W ?Z,$J(^XTMP(APCLNSP,APCLJOB,APCLBT,"SUBTOTAL",APCLAP,X)/60,7,2) S Z=Z+10 ;IHS/CMI/LAB - minutes to hours
I $D(^XTMP(APCLNSP,APCLJOB,APCLBT,APCLAP,"NOACT")) W !!!,"* -- ",^XTMP(APCLNSP,APCLJOB,APCLBT,APCLAP,"NOACT")," of the visits did not have an activity time recorded."
D NOTE
Q
P ;
F Y=1:1 S X=$P(APCLSUB,U,Y) Q:X="" S:$D(^XTMP(APCLNSP,APCLJOB,APCLBT,APCLAP,APCLVAL,X)) ^XTMP(APCLNSP,APCLJOB,APCLBT,"SUBTOTAL",APCLAP,X)=^XTMP(APCLNSP,APCLJOB,APCLBT,"SUBTOTAL",APCLAP,X)+^XTMP(APCLNSP,APCLJOB,APCLBT,APCLAP,APCLVAL,X)
I $Y>(IOSL-5) D HEAD,SUBHEAD Q:$D(APCLQUIT)
I APCLSORV="APCLVLOC" S APCLZ=$E($P(^DIC(4,APCLVAL,0),U),1,26)
I APCLSORV="APCLCODE" S G=APCLGLOB_APCLVAL_")",APCLZ=$S(APCLGLOB["ICD9":$E($P($$ICDDX^ICDEX(APCLVAL),U,4),1,26),1:$E($P(@G@(0),U,APCLPIEC),1,26))
W !,APCLZ
S Z=28 F Y=1,2,3 S X=$P(APCLSUB,U,Y) Q:X="" W ?Z,$J($S($D(^XTMP(APCLNSP,APCLJOB,APCLBT,APCLAP,APCLVAL,X)):^(X),1:0),7) S Z=Z+10 ;IHS/CMI/LAB - minutes to hours
F Y=4,5 S X=$P(APCLSUB,U,Y) Q:X="" W ?Z,$J($S($D(^XTMP(APCLNSP,APCLJOB,APCLBT,APCLAP,APCLVAL,X)):^(X),1:0)/60,7,2) S Z=Z+10 ;IHS/CMI/LAB - minutes to hours
Q
SUBHEAD ;
Q:$D(APCLQUIT)
S APCLLENG=$L($S($P(^DD(9000010.06,.01,0),U,2)[200:$P(^VA(200,APCLAP,0),U),1:$P(^DIC(16,APCLAP,0),U))) ;IHS/CMI/LAB - file 200 fix
W ?(80-(11+APCLLENG)/2),"PROVIDER: ",$S($P(^DD(9000010.06,.01,0),U,2)[200:$P(^VA(200,APCLAP,0),U),1:$P(^DIC(16,APCLAP,0),U))
W !!?28,"TOTAL",?38,"# CONTS",?48,"# CONTS"
W !?28,"PATIENT",?38,"AS PRIM.",?48,"AS SEC.",?58,"ACTIVITY",?69,"TRAVEL"
W !,APCLSORT,?28,"CONTACTS",?38,"PROVIDER",?48,"PROVIDER",?58,"TIME*",?69,"TIME"
W !,APCL80S,!
Q
HEAD I 'APCLPG G HEAD1
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCLQUIT="" Q
HEAD1 ;
W:$D(IOF) @IOF S APCLPG=APCLPG+1
W !
W APCLDT,?72,"Page ",APCLPG,!
S APCLLENG=$L($P(^APCLACTG(APCLACTG,0),U))
W ?(80-(33+APCLLENG)/2),"PRIMARY DX REPORT BY PROVIDER ",$P(^APCLACTG(APCLACTG,0),U)," STAFF",!
W ?18,"VISIT DATES: ",APCLBDD," TO ",APCLEDD,!
S X="" I '$D(APCLLOC) S X="All Locations"
I $D(APCLLOC) S X="Locations: " S Y=0 F S Y=$O(APCLLOC(Y)) Q:Y'=+Y S X=X_$E($P(^DIC(4,Y,0),U),1,10)_"; "
W $$CTR(X),!
S X="" I '$D(APCLCLN) S X="All Clinics"
I $D(APCLCLN) S X="Clinics: " S Y=0 F S Y=$O(APCLCLN(Y)) Q:Y'=+Y S X=X_$E($P(^DIC(40.7,Y,0),U),1,10)_"; "
W $$CTR(X),!
Q
NOTE ;
I $Y>(IOSL-6) D HEAD Q:$D(APCLQUIT)
D NOTE^APCLCPUT
Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
APCLCP1P ; IHS/CMI/LAB - tally activity ;
+1 ;;2.0;IHS PCC SUITE;**11,20**;MAY 14, 2009;Build 25
+2 ;IHS/CMI/LAB - patch 4 file 200 fix
START ;
+1 SET APCL80S="-------------------------------------------------------------------------------"
+2 DO NOW^%DTC
SET Y=X
DO DD^%DT
SET APCLDT=Y
+3 SET APCLSUB="TOTAL^PRIM^SEC^ACT^TT"
+4 SET Y=APCLBD
DO DD^%DT
SET APCLBDD=Y
SET Y=APCLED
DO DD^%DT
SET APCLEDD=Y
+5 SET (APCLPG,APCLAP)=0
+6 KILL APCLQUIT
+7 IF '$DATA(^XTMP(APCLNSP,APCLJOB,APCLBT))
DO HEAD
WRITE !!,"No visits to report",!
GOTO DONE
+8 FOR
SET APCLAP=$ORDER(^XTMP(APCLNSP,APCLJOB,APCLBT,APCLAP))
IF APCLAP'=+APCLAP!($DATA(APCLQUIT))
QUIT
DO LOC
DONE ;
+1 DO DONE^APCLOSUT
+2 KILL ^XTMP(APCLNSP,APCLJOB,APCLBT)
+3 QUIT
LOC ;
+1 DO HEAD
DO SUBHEAD
IF $DATA(APCLQUIT)
QUIT
+2 FOR Y=1:1
SET X=$PIECE(APCLSUB,U,Y)
IF X=""
QUIT
SET ^XTMP(APCLNSP,APCLJOB,APCLBT,"SUBTOTAL",APCLAP,X)=0
+3 SET APCLVAL=""
FOR
SET APCLVAL=$ORDER(^XTMP(APCLNSP,APCLJOB,APCLBT,APCLAP,APCLVAL))
IF APCLVAL'=+APCLVAL!($DATA(APCLQUIT))
QUIT
DO P
+4 WRITE !!?10,"TOTAL:"
+5 ;IHS/CMI/LAB - minutes to hours
SET Z=28
FOR Y=1,2,3
SET X=$PIECE(APCLSUB,U,Y)
IF X=""
QUIT
WRITE ?Z,$JUSTIFY(^XTMP(APCLNSP,APCLJOB,APCLBT,"SUBTOTAL",APCLAP,X),7)
SET Z=Z+10
+6 ;IHS/CMI/LAB - minutes to hours
FOR Y=4,5
SET X=$PIECE(APCLSUB,U,Y)
IF X=""
QUIT
WRITE ?Z,$JUSTIFY(^XTMP(APCLNSP,APCLJOB,APCLBT,"SUBTOTAL",APCLAP,X)/60,7,2)
SET Z=Z+10
+7 IF $DATA(^XTMP(APCLNSP,APCLJOB,APCLBT,APCLAP,"NOACT"))
WRITE !!!,"* -- ",^XTMP(APCLNSP,APCLJOB,APCLBT,APCLAP,"NOACT")," of the visits did not have an activity time recorded."
+8 DO NOTE
+9 QUIT
P ;
+1 FOR Y=1:1
SET X=$PIECE(APCLSUB,U,Y)
IF X=""
QUIT
IF $DATA(^XTMP(APCLNSP,APCLJOB,APCLBT,APCLAP,APCLVAL,X))
SET ^XTMP(APCLNSP,APCLJOB,APCLBT,"SUBTOTAL",APCLAP,X)=^XTMP(APCLNSP,APCLJOB,APCLBT,"SUBTOTAL",APCLAP,X)+^XTMP(APCLNSP,APCLJOB,APCLBT,APCLAP,APCLVAL,X)
+2 IF $Y>(IOSL-5)
DO HEAD
DO SUBHEAD
IF $DATA(APCLQUIT)
QUIT
+3 IF APCLSORV="APCLVLOC"
SET APCLZ=$EXTRACT($PIECE(^DIC(4,APCLVAL,0),U),1,26)
+4 IF APCLSORV="APCLCODE"
SET G=APCLGLOB_APCLVAL_")"
SET APCLZ=$SELECT(APCLGLOB["ICD9":$EXTRACT($PIECE($$ICDDX^ICDEX(APCLVAL),U,4),1,26),1:$EXTRACT($PIECE(@G@(0),U,APCLPIEC),1,26))
+5 WRITE !,APCLZ
+6 ;IHS/CMI/LAB - minutes to hours
SET Z=28
FOR Y=1,2,3
SET X=$PIECE(APCLSUB,U,Y)
IF X=""
QUIT
WRITE ?Z,$JUSTIFY($SELECT($DATA(^XTMP(APCLNSP,APCLJOB,APCLBT,APCLAP,APCLVAL,X)):^(X),1:0),7)
SET Z=Z+10
+7 ;IHS/CMI/LAB - minutes to hours
FOR Y=4,5
SET X=$PIECE(APCLSUB,U,Y)
IF X=""
QUIT
WRITE ?Z,$JUSTIFY($SELECT($DATA(^XTMP(APCLNSP,APCLJOB,APCLBT,APCLAP,APCLVAL,X)):^(X),1:0)/60,7,2)
SET Z=Z+10
+8 QUIT
SUBHEAD ;
+1 IF $DATA(APCLQUIT)
QUIT
+2 ;IHS/CMI/LAB - file 200 fix
SET APCLLENG=$LENGTH($SELECT($PIECE(^DD(9000010.06,.01,0),U,2)[200:$PIECE(^VA(200,APCLAP,0),U),1:$PIECE(^DIC(16,APCLAP,0),U)))
+3 WRITE ?(80-(11+APCLLENG)/2),"PROVIDER: ",$SELECT($PIECE(^DD(9000010.06,.01,0),U,2)[200:$PIECE(^VA(200,APCLAP,0),U),1:$PIECE(^DIC(16,APCLAP,0),U))
+4 WRITE !!?28,"TOTAL",?38,"# CONTS",?48,"# CONTS"
+5 WRITE !?28,"PATIENT",?38,"AS PRIM.",?48,"AS SEC.",?58,"ACTIVITY",?69,"TRAVEL"
+6 WRITE !,APCLSORT,?28,"CONTACTS",?38,"PROVIDER",?48,"PROVIDER",?58,"TIME*",?69,"TIME"
+7 WRITE !,APCL80S,!
+8 QUIT
HEAD IF 'APCLPG
GOTO HEAD1
+1 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET APCLQUIT=""
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET APCLPG=APCLPG+1
+2 WRITE !
+3 WRITE APCLDT,?72,"Page ",APCLPG,!
+4 SET APCLLENG=$LENGTH($PIECE(^APCLACTG(APCLACTG,0),U))
+5 WRITE ?(80-(33+APCLLENG)/2),"PRIMARY DX REPORT BY PROVIDER ",$PIECE(^APCLACTG(APCLACTG,0),U)," STAFF",!
+6 WRITE ?18,"VISIT DATES: ",APCLBDD," TO ",APCLEDD,!
+7 SET X=""
IF '$DATA(APCLLOC)
SET X="All Locations"
+8 IF $DATA(APCLLOC)
SET X="Locations: "
SET Y=0
FOR
SET Y=$ORDER(APCLLOC(Y))
IF Y'=+Y
QUIT
SET X=X_$EXTRACT($PIECE(^DIC(4,Y,0),U),1,10)_"; "
+9 WRITE $$CTR(X),!
+10 SET X=""
IF '$DATA(APCLCLN)
SET X="All Clinics"
+11 IF $DATA(APCLCLN)
SET X="Clinics: "
SET Y=0
FOR
SET Y=$ORDER(APCLCLN(Y))
IF Y'=+Y
QUIT
SET X=X_$EXTRACT($PIECE(^DIC(40.7,Y,0),U),1,10)_"; "
+12 WRITE $$CTR(X),!
+13 QUIT
NOTE ;
+1 IF $Y>(IOSL-6)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+2 DO NOTE^APCLCPUT
+3 QUIT
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
