- APCLCP8P ; IHS/CMI/LAB - print apc report by prov disc ; 11 Apr 2013 10:34 AM
- ;;2.0;IHS PCC SUITE;**10**;MAY 14, 2009;Build 88
- ;IHS/CMI/LAB changed minutes to hours in print
- START ;
- S APCL80S="-------------------------------------------------------------------------------"
- S Y=APCLBD D DD^%DT S APCLBDD=Y S Y=APCLED D DD^%DT S APCLEDD=Y
- S (APCLPG,APCLSEX)=0
- K APCLQUIT
- F S APCLSEX=$O(^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX)) Q:APCLSEX=""!($D(APCLQUIT)) D LOC
- DONE ;
- D DONE^APCLOSUT
- K ^XTMP("APCLCP8",APCLJOB,APCLBT)
- Q
- LOC ;
- D HEAD,SUBHEAD Q:$D(APCLQUIT)
- S ^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"ACT")=0
- S ^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"TT")=0
- S ^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"PRIM")=0
- S ^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"SEC")=0
- S ^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"TOTAL")=0
- S APCLAGE="" F S APCLAGE=$O(^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,APCLAGE)) Q:APCLAGE=""!($D(APCLQUIT)) D P
- W !!?10,"TOTAL:"
- W ?28,$J($S($D(^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"TOTAL")):^("TOTAL"),1:"."),7)
- W ?38,$J($S($D(^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"PRIM")):^("PRIM"),1:"."),7)
- W ?48,$J($S($D(^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"SEC")):^("SEC"),1:"."),7)
- W ?58,$J($S($D(^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"ACT")):^("ACT")/60,1:"."),7,2) ;IHS/CMI/LAB minutes to hours
- W ?68,$J($S($D(^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"TT")):^("TT")/60,1:"."),7,2) ;IHS/CMI/LAB - minutes to hours
- I $D(^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,"NOACT")) W !!,"* -- ",^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,"NOACT")," of the visits did not have an activity time recorded."
- D NOTE
- Q
- P ;
- S:$D(^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,APCLAGE,"ACT")) ^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"ACT")=^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"ACT")+^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,APCLAGE,"ACT")
- S:$D(^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,APCLAGE,"TT")) ^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"TT")=^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"TT")+^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,APCLAGE,"TT")
- S:$D(^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,APCLAGE,"PRIM")) ^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"PRIM")=^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"PRIM")+^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,APCLAGE,"PRIM")
- S:$D(^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,APCLAGE,"SEC")) ^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"SEC")=^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"SEC")+^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,APCLAGE,"SEC")
- I $D(^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,APCLAGE,"TOTAL")) D
- .S ^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"TOTAL")=^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"TOTAL")+^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,APCLAGE,"TOTAL")
- I $Y>(IOSL-5) D HEAD,SUBHEAD Q:$D(APCLQUIT)
- W !,$P(APCLBIN,";",APCLAGE)," years",?28,$J($S($D(^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,APCLAGE,"TOTAL")):^("TOTAL"),1:"."),7)
- W ?38,$J($S($D(^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,APCLAGE,"PRIM")):^("PRIM"),1:"."),7)
- W ?48,$J($S($D(^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,APCLAGE,"SEC")):^("SEC"),1:"."),7)
- W ?58,$J($S($D(^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,APCLAGE,"ACT")):^("ACT")/60,1:"."),7,2) ;IHS/CMI/LAB - minutes to hours
- W ?68,$J($S($D(^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,APCLAGE,"TT")):^("TT")/60,1:"."),7,2) ;IHS/CMI/LAB - minutes to hours
- Q
- SUBHEAD ;
- Q:$D(APCLQUIT)
- S APCLLENG=$L($S(APCLSEX="F":"FEMALE",APCLSEX="U":"UNKNOWN",1:"MALE"))
- W ?(80-(6+APCLLENG)/2),"SEX: ",$S(APCLSEX="F":"FEMALE",APCLSEX="U":"UNKNOWN",1:"MALE")
- W !!?28,"TOTAL",?38,"# CONTS",?48,"# CONTS"
- W !?28,"PATIENT",?38,"AS PRIM.",?48,"AS SEC.",?58,"ACTIVITY",?69,"TRAVEL"
- W !,"AGE GROUP",?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,!
- W ?(80-(44+$L($P(^APCLACTG(APCLACTG,0),U)))/2),"TIME AND SERVICES REPORT BY AGE AND SEX 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 NOTE2^APCLCPUT
- Q
- APCLCP8P ; IHS/CMI/LAB - print apc report by prov disc ; 11 Apr 2013 10:34 AM
- +1 ;;2.0;IHS PCC SUITE;**10**;MAY 14, 2009;Build 88
- +2 ;IHS/CMI/LAB changed minutes to hours in print
- START ;
- +1 SET APCL80S="-------------------------------------------------------------------------------"
- +2 SET Y=APCLBD
- DO DD^%DT
- SET APCLBDD=Y
- SET Y=APCLED
- DO DD^%DT
- SET APCLEDD=Y
- +3 SET (APCLPG,APCLSEX)=0
- +4 KILL APCLQUIT
- +5 FOR
- SET APCLSEX=$ORDER(^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX))
- IF APCLSEX=""!($DATA(APCLQUIT))
- QUIT
- DO LOC
- DONE ;
- +1 DO DONE^APCLOSUT
- +2 KILL ^XTMP("APCLCP8",APCLJOB,APCLBT)
- +3 QUIT
- LOC ;
- +1 DO HEAD
- DO SUBHEAD
- IF $DATA(APCLQUIT)
- QUIT
- +2 SET ^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"ACT")=0
- +3 SET ^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"TT")=0
- +4 SET ^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"PRIM")=0
- +5 SET ^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"SEC")=0
- +6 SET ^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"TOTAL")=0
- +7 SET APCLAGE=""
- FOR
- SET APCLAGE=$ORDER(^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,APCLAGE))
- IF APCLAGE=""!($DATA(APCLQUIT))
- QUIT
- DO P
- +8 WRITE !!?10,"TOTAL:"
- +9 WRITE ?28,$JUSTIFY($SELECT($DATA(^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"TOTAL")):^("TOTAL"),1:"."),7)
- +10 WRITE ?38,$JUSTIFY($SELECT($DATA(^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"PRIM")):^("PRIM"),1:"."),7)
- +11 WRITE ?48,$JUSTIFY($SELECT($DATA(^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"SEC")):^("SEC"),1:"."),7)
- +12 ;IHS/CMI/LAB minutes to hours
- WRITE ?58,$JUSTIFY($SELECT($DATA(^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"ACT")):^("ACT")/60,1:"."),7,2)
- +13 ;IHS/CMI/LAB - minutes to hours
- WRITE ?68,$JUSTIFY($SELECT($DATA(^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"TT")):^("TT")/60,1:"."),7,2)
- +14 IF $DATA(^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,"NOACT"))
- WRITE !!,"* -- ",^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,"NOACT")," of the visits did not have an activity time recorded."
- +15 DO NOTE
- +16 QUIT
- P ;
- +1 IF $DATA(^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,APCLAGE,"ACT"))
- SET ^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"ACT")=^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"ACT")+^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,APCLAGE,"ACT")
- +2 IF $DATA(^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,APCLAGE,"TT"))
- SET ^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"TT")=^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"TT")+^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,APCLAGE,"TT")
- +3 IF $DATA(^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,APCLAGE,"PRIM"))
- SET ^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"PRIM")=^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"PRIM")+^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,APCLAGE,"PRIM")
- +4 IF $DATA(^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,APCLAGE,"SEC"))
- SET ^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"SEC")=^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"SEC")+^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,APCLAGE,"SEC")
- +5 IF $DATA(^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,APCLAGE,"TOTAL"))
- Begin DoDot:1
- +6 SET ^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"TOTAL")=^XTMP("APCLCP8",APCLJOB,APCLBT,"SUBTOTAL",APCLSEX,"TOTAL")+^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,APCLAGE,"TOTAL")
- End DoDot:1
- +7 IF $Y>(IOSL-5)
- DO HEAD
- DO SUBHEAD
- IF $DATA(APCLQUIT)
- QUIT
- +8 WRITE !,$PIECE(APCLBIN,";",APCLAGE)," years",?28,$JUSTIFY($SELECT($DATA(^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,APCLAGE,"TOTAL")):^("TOTAL"),1:"."),7)
- +9 WRITE ?38,$JUSTIFY($SELECT($DATA(^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,APCLAGE,"PRIM")):^("PRIM"),1:"."),7)
- +10 WRITE ?48,$JUSTIFY($SELECT($DATA(^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,APCLAGE,"SEC")):^("SEC"),1:"."),7)
- +11 ;IHS/CMI/LAB - minutes to hours
- WRITE ?58,$JUSTIFY($SELECT($DATA(^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,APCLAGE,"ACT")):^("ACT")/60,1:"."),7,2)
- +12 ;IHS/CMI/LAB - minutes to hours
- WRITE ?68,$JUSTIFY($SELECT($DATA(^XTMP("APCLCP8",APCLJOB,APCLBT,"SEX",APCLSEX,APCLAGE,"TT")):^("TT")/60,1:"."),7,2)
- +13 QUIT
- SUBHEAD ;
- +1 IF $DATA(APCLQUIT)
- QUIT
- +2 SET APCLLENG=$LENGTH($SELECT(APCLSEX="F":"FEMALE",APCLSEX="U":"UNKNOWN",1:"MALE"))
- +3 WRITE ?(80-(6+APCLLENG)/2),"SEX: ",$SELECT(APCLSEX="F":"FEMALE",APCLSEX="U":"UNKNOWN",1:"MALE")
- +4 WRITE !!?28,"TOTAL",?38,"# CONTS",?48,"# CONTS"
- +5 WRITE !?28,"PATIENT",?38,"AS PRIM.",?48,"AS SEC.",?58,"ACTIVITY",?69,"TRAVEL"
- +6 WRITE !,"AGE GROUP",?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 WRITE ?(80-(44+$LENGTH($PIECE(^APCLACTG(APCLACTG,0),U)))/2),"TIME AND SERVICES REPORT BY AGE AND SEX FOR ",$PIECE(^APCLACTG(APCLACTG,0),U)," STAFF",!
- +5 WRITE ?18,"VISIT DATES: ",APCLBDD," TO ",APCLEDD,!
- +6 SET X=""
- IF '$DATA(APCLLOC)
- SET X="All Locations"
- +7 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)_"; "
- +8 WRITE $$CTR^APCLCP1P(X),!
- +9 SET X=""
- IF '$DATA(APCLCLN)
- SET X="All Clinics"
- +10 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)_"; "
- +11 WRITE $$CTR^APCLCP1P(X),!
- +12 QUIT
- NOTE ;
- +1 IF $Y>(IOSL-6)
- DO HEAD
- IF $DATA(APCLQUIT)
- QUIT
- +2 DO NOTE2^APCLCPUT
- +3 QUIT
