- APCLCP5P ; IHS/CMI/LAB - tally activity ;
- ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- ;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=$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,"# CR'S",?48,"# CR'S"
- W !?28,"CHART",?38,"AS PRIM.",?48,"AS SEC.",?58,"ACTIVITY",?69,"TRAVEL"
- W !,APCLSORT,?28,"REVIEWS",?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),"CHART REVIEW REPORT FOR ",$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^APCLCP1P(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^APCLCP1P(X),!
- Q
- NOTE ;
- I $Y>(IOSL-6) D HEAD Q:$D(APCLQUIT)
- D NOTE^APCLCPUT
- Q
- APCLCP5P ; IHS/CMI/LAB - tally activity ;
- +1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- +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=$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,"# CR'S",?48,"# CR'S"
- +5 WRITE !?28,"CHART",?38,"AS PRIM.",?48,"AS SEC.",?58,"ACTIVITY",?69,"TRAVEL"
- +6 WRITE !,APCLSORT,?28,"REVIEWS",?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),"CHART REVIEW REPORT FOR ",$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^APCLCP1P(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^APCLCP1P(X),!
- +13 QUIT
- NOTE ;
- +1 IF $Y>(IOSL-6)
- DO HEAD
- IF $DATA(APCLQUIT)
- QUIT
- +2 DO NOTE^APCLCPUT
- +3 QUIT
