- ORPRPM1 ;DAN/SLC Performance Measure Print; ;10/4/01 10:45
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**114,119**;Dec 17, 1997
- ;
- ;This routine will print a report indicating the percent of
- ;orders entered for a provider by a provider holding the ORES key.
- ;The data for the report will be stored in ^TMP as follows:
- ;^TMP($J,"SUM",Provider Name,Patient Status)=Total # of order (universe)^Denominator^Numerator^Verbal^Written^Telephone^Policy^Electronically entered^Student entered^Outpatient narcotic orders
- ;Where Patient Status is I for inpatient or O for outpatient.
- ;
- PRINT ;Print out report
- S REPDT=$$FMTE^XLFDT($$DT^XLFDT)
- ;Detailed Report Section
- I ORREP="B"!(ORREP="D") D Q:$G(ORSTOP) ;print detailed report if selected
- .D HDR("D") I '$D(^TMP($J,"DET")) W !,"There is no data for the criteria you selected." S ORSTOP=1 Q
- .S ORI="" F S ORI=$O(^TMP($J,"DET",ORI)) Q:ORI=""!($G(ORSTOP)) W !,"PROVIDER: ",ORI,!! S ORJ="" F S ORJ=$O(^TMP($J,"DET",ORI,ORJ)) Q:ORJ=""!($G(ORSTOP)) D
- ..W $$FMTE^XLFDT($P(^OR(100,ORJ,8,1,0),"^")\1,2),?9,$J(ORJ,9)
- ..S ORPAT=$P(^OR(100,ORJ,0),"^",2) W ?20,$S(ORPAT["DPT":$E($P(^DPT(+ORPAT,0),"^"),1)_$E($P(^(0),"^",9),6,9),1:"Refrl") ;Print 1st letter of last name/last 4 SSN if patient file entry else referral
- ..W ?27,$S($P($G(^OR(100,ORJ,.1,1,0)),"^"):$E($P(^ORD(101.43,$P(^(0),"^"),0),"^"),1,12),1:"")
- ..W ?41,$S($P($G(^OR(100,ORJ,8,1,0)),"^",12):$E($P(^ORD(100.02,$P(^(0),"^",12),0),"^"),1,3),1:"")
- ..W ?47,$S($P($G(^OR(100,ORJ,0)),"^",10):$E($P(^SC(+$P(^(0),"^",10),0),"^"),1,12),1:"")
- ..W ?61,$S($P($G(^OR(100,ORJ,0)),"^",14):$E($P(^DIC(9.4,$P(^(0),"^",14),0),"^"),1,11),1:"")
- ..W ?77,$S(^TMP($J,"DET",ORI,ORJ):"Y",1:"N"),! I $Y>(IOSL-4) D HDR("D")
- .Q:$G(ORSTOP)
- ;Summary report section
- I ORREP="B"!(ORREP="S") D Q:$G(ORSTOP) ;print summary report if selected
- .D HDR("S") Q:$G(ORSTOP) I '$D(^TMP($J,"SUM")) W !,"There is no data for the criteria you selected." S ORSTOP=1 Q
- .S ORI="" F S ORI=$O(^TMP($J,"SUM",ORI)) Q:ORI=""!($G(ORSTOP)) D Q:$G(ORSTOP) D SUBTOT:'ORFS
- ..S ORWROTE=0 K ORSTOT F ORP="I","O" Q:$G(ORSTOP) I $D(^TMP($J,"SUM",ORI,ORP)) D
- ...I 'ORFS D ;If not summary total only then write provider specific information
- ....W:'ORWROTE $E(ORI,1,25),! S ORWROTE=1 W ?1,$S(ORP="I":" Inpt",1:"Outpt")," Tot"
- ....W ?12,$J(+$P(^TMP($J,"SUM",ORI,ORP),"^"),6) I $P(^(ORP),"^")'=$P(^(ORP),"^",2) W ?19,$J(+$P(^(ORP),"^",10)_"/"_+$P(^(ORP),"^",9)_"/"_+$P(^(ORP),"^",8),15) ;Universe DEA Wet Sig Reqd/Student/Policy
- ....W ?34,$J(+$P(^TMP($J,"SUM",ORI,ORP),"^",2),8),?44,$J(+$P(^(ORP),"^",3),8),?53,$S(+$P(^(ORP),"^",2)'=0:$J($P(^(ORP),"^",3)/$P(^(ORP),"^",2)*100,3,0)_"%",1:"NONE")
- ....I $P(^(ORP),"^",2)'=$P(^(ORP),"^",3) W ?58,+$P(^(ORP),"^",4),"/",+$P(^(ORP),"^",5),"/",+$P(^(ORP),"^",6),"/",+$P(^(ORP),"^",7)
- ....W !
- ...F ORJ=1:1:10 S ORTOT(ORJ)=$G(ORTOT(ORJ))+$P(^(ORP),"^",ORJ),ORTOT(ORJ,ORP)=$G(ORTOT(ORJ,ORP))+$P(^(ORP),"^",ORJ) ;Overall totals
- ...S ORSTOT(1)=$G(ORSTOT(1))+$P(^(ORP),"^"),ORSTOT(2)=$G(ORSTOT(2))+$P(^(ORP),"^",2),ORSTOT(3)=$G(ORSTOT(3))+$P(^(ORP),"^",3)
- ...I $Y>(IOSL-4) D HDR("S")
- .Q:$G(ORSTOP)
- .I 'ORFS W $$REPEAT^XLFSTR("-",78)
- .F ORP="I","O" I $D(ORTOT(1,ORP)) D
- ..W !,$S(ORP="I":"INPT",1:"OUTPT"),?10,$J($G(ORTOT(1,ORP)),8),?19,$J(+$G(ORTOT(10,ORP))_"/"_+$G(ORTOT(9,ORP))_"/"_+$G(ORTOT(8,ORP)),15)
- ..W ?34,$J($G(ORTOT(2,ORP)),8),?44,$J($G(ORTOT(3,ORP)),8),?53,$S(+$G(ORTOT(2,ORP))'=0:$J($G(ORTOT(3,ORP))/$G(ORTOT(2,ORP))*100,3,0)_"%",1:"NONE")
- ..W ?58,+$G(ORTOT(4,ORP)),"/",+$G(ORTOT(5,ORP)),"/",+$G(ORTOT(6,ORP)),"/",+$G(ORTOT(7,ORP))
- .W !,"TOTAL",?10,$J($G(ORTOT(1)),8),?19,$J(+$G(ORTOT(10))_"/"_+$G(ORTOT(9))_"/"_+$G(ORTOT(8)),15)
- .W ?34,$J(ORTOT(2),8),?44,$J(ORTOT(3),8),?53,$S(+ORTOT(2)'=0:$J(ORTOT(3)/ORTOT(2)*100,3,0)_"%",1:"NONE"),?58,+$G(ORTOT(4)),"/",+$G(ORTOT(5)),"/",+$G(ORTOT(6)),"/",+$G(ORTOT(7))
- Q
- ;
- SUBTOT ;Print individual sub totals
- W ?1," Sub-tot",?12,$J($G(ORSTOT(1)),6),?34,$J($G(ORSTOT(2)),8),?44,$J($G(ORSTOT(3)),8)
- W ?53,$S(+ORSTOT(2)'=0:$J($G(ORSTOT(3))/$G(ORSTOT(2))*100,3,0)_"%",1:"NONE"),!
- Q
- ;
- HDR(TYPE) ;Print appropriate header
- I $E(IOST,1,2)="C-"&($G(PG)) S DIR(0)="E" D ^DIR S ORSTOP='Y K DIR Q:ORSTOP
- I $G(PG)!('$G(PG)&($E(IOST,1,2)="C-")) W @IOF
- S PG=$G(PG)+1
- W !,"CPRS Performance Monitor ",$S(TYPE="D":"- Detailed",ORFS:"- Summary Totals",1:"- Summary")," Report",?52,REPDT,?72,"PAGE ",$G(PG),!,"Selected Date Range: ",$$FMTE^XLFDT(ORSD+.1,2)," to ",$$FMTE^XLFDT(ORED\1,2),!
- W "Sort criteria: ",$S(ORPT="I":"IN",ORPT="O":"OUT",1:"ALL "),"PATIENTS/",$S(ORTYPE="P":"PHARMACY",1:"ALL")," ORDERS"
- I TYPE="D" W ?72,"ENTERED",!,"ORDER",?41,"ORD",?47,"PATIENT",?73,"BY HAS",!,"DATE",?11,"ORDER #",?19,"PAT ID",?27,"1st ORD ITEM",?41,"TYPE",?47,"LOCATION",?61,"PACKAGE",?74,"ORES?",!
- I TYPE="S" W ?58,"BREAKDOWN OF ORDERS",!,?34,"PROVIDER",?44,"PROVIDER",?58,"NOT SELF ENTERED",! W:'ORFS "PROVIDER" W ?10,"UNIVERSE",?23,"DEA/STU/POL",?36,"ORDERS",?45,"ENTERED",?56,"%",?58,"WR/VE/TE/EL",!
- W $$REPEAT^XLFSTR("-",IOM),!
- Q
- ;
- ORPRPM1 ;DAN/SLC Performance Measure Print; ;10/4/01 10:45
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**114,119**;Dec 17, 1997
- +2 ;
- +3 ;This routine will print a report indicating the percent of
- +4 ;orders entered for a provider by a provider holding the ORES key.
- +5 ;The data for the report will be stored in ^TMP as follows:
- +6 ;^TMP($J,"SUM",Provider Name,Patient Status)=Total # of order (universe)^Denominator^Numerator^Verbal^Written^Telephone^Policy^Electronically entered^Student entered^Outpatient narcotic orders
- +7 ;Where Patient Status is I for inpatient or O for outpatient.
- +8 ;
- PRINT ;Print out report
- +1 SET REPDT=$$FMTE^XLFDT($$DT^XLFDT)
- +2 ;Detailed Report Section
- +3 ;print detailed report if selected
- IF ORREP="B"!(ORREP="D")
- Begin DoDot:1
- +4 DO HDR("D")
- IF '$DATA(^TMP($JOB,"DET"))
- WRITE !,"There is no data for the criteria you selected."
- SET ORSTOP=1
- QUIT
- +5 SET ORI=""
- FOR
- SET ORI=$ORDER(^TMP($JOB,"DET",ORI))
- IF ORI=""!($GET(ORSTOP))
- QUIT
- WRITE !,"PROVIDER: ",ORI,!!
- SET ORJ=""
- FOR
- SET ORJ=$ORDER(^TMP($JOB,"DET",ORI,ORJ))
- IF ORJ=""!($GET(ORSTOP))
- QUIT
- Begin DoDot:2
- +6 WRITE $$FMTE^XLFDT($PIECE(^OR(100,ORJ,8,1,0),"^")\1,2),?9,$JUSTIFY(ORJ,9)
- +7 ;Print 1st letter of last name/last 4 SSN if patient file entry else referral
- SET ORPAT=$PIECE(^OR(100,ORJ,0),"^",2)
- WRITE ?20,$SELECT(ORPAT["DPT":$EXTRACT($PIECE(^DPT(+ORPAT,0),"^"),1)_$EXTRACT($PIECE(^(0),"^",9),6,9),1:"Refrl")
- +8 WRITE ?27,$SELECT($PIECE($GET(^OR(100,ORJ,.1,1,0)),"^"):$EXTRACT($PIECE(^ORD(101.43,$PIECE(^(0),"^"),0),"^"),1,12),1:"")
- +9 WRITE ?41,$SELECT($PIECE($GET(^OR(100,ORJ,8,1,0)),"^",12):$EXTRACT($PIECE(^ORD(100.02,$PIECE(^(0),"^",12),0),"^"),1,3),1:"")
- +10 WRITE ?47,$SELECT($PIECE($GET(^OR(100,ORJ,0)),"^",10):$EXTRACT($PIECE(^SC(+$PIECE(^(0),"^",10),0),"^"),1,12),1:"")
- +11 WRITE ?61,$SELECT($PIECE($GET(^OR(100,ORJ,0)),"^",14):$EXTRACT($PIECE(^DIC(9.4,$PIECE(^(0),"^",14),0),"^"),1,11),1:"")
- +12 WRITE ?77,$SELECT(^TMP($JOB,"DET",ORI,ORJ):"Y",1:"N"),!
- IF $Y>(IOSL-4)
- DO HDR("D")
- End DoDot:2
- +13 IF $GET(ORSTOP)
- QUIT
- End DoDot:1
- IF $GET(ORSTOP)
- QUIT
- +14 ;Summary report section
- +15 ;print summary report if selected
- IF ORREP="B"!(ORREP="S")
- Begin DoDot:1
- +16 DO HDR("S")
- IF $GET(ORSTOP)
- QUIT
- IF '$DATA(^TMP($JOB,"SUM"))
- WRITE !,"There is no data for the criteria you selected."
- SET ORSTOP=1
- QUIT
- +17 SET ORI=""
- FOR
- SET ORI=$ORDER(^TMP($JOB,"SUM",ORI))
- IF ORI=""!($GET(ORSTOP))
- QUIT
- Begin DoDot:2
- +18 SET ORWROTE=0
- KILL ORSTOT
- FOR ORP="I","O"
- IF $GET(ORSTOP)
- QUIT
- IF $DATA(^TMP($JOB,"SUM",ORI,ORP))
- Begin DoDot:3
- +19 ;If not summary total only then write provider specific information
- IF 'ORFS
- Begin DoDot:4
- +20 IF 'ORWROTE
- WRITE $EXTRACT(ORI,1,25),!
- SET ORWROTE=1
- WRITE ?1,$SELECT(ORP="I":" Inpt",1:"Outpt")," Tot"
- +21 ;Universe DEA Wet Sig Reqd/Student/Policy
- WRITE ?12,$JUSTIFY(+$PIECE(^TMP($JOB,"SUM",ORI,ORP),"^"),6)
- IF $PIECE(^(ORP),"^")'=$PIECE(^(ORP),"^",2)
- WRITE ?19,$JUSTIFY(+$PIECE(^(ORP),"^",10)_"/"_+$PIECE(^(ORP),"^",9)_"/"_+$PIECE(^(ORP),"^",8),15)
- +22 WRITE ?34,$JUSTIFY(+$PIECE(^TMP($JOB,"SUM",ORI,ORP),"^",2),8),?44,$JUSTIFY(+$PIECE(^(ORP),"^",3),8),?53,$SELECT(+$PIECE(^(ORP),"^",2)'=0:$JUSTIFY($PIECE(^(ORP),"^",3)/$PIECE(^(ORP),"^",2)*100,3,0)_"%",1:"NONE
- ")
- +23 IF $PIECE(^(ORP),"^",2)'=$PIECE(^(ORP),"^",3)
- WRITE ?58,+$PIECE(^(ORP),"^",4),"/",+$PIECE(^(ORP),"^",5),"/",+$PIECE(^(ORP),"^",6),"/",+$PIECE(^(ORP),"^",7)
- +24 WRITE !
- End DoDot:4
- +25 ;Overall totals
- FOR ORJ=1:1:10
- SET ORTOT(ORJ)=$GET(ORTOT(ORJ))+$PIECE(^(ORP),"^",ORJ)
- SET ORTOT(ORJ,ORP)=$GET(ORTOT(ORJ,ORP))+$PIECE(^(ORP),"^",ORJ)
- +26 SET ORSTOT(1)=$GET(ORSTOT(1))+$PIECE(^(ORP),"^")
- SET ORSTOT(2)=$GET(ORSTOT(2))+$PIECE(^(ORP),"^",2)
- SET ORSTOT(3)=$GET(ORSTOT(3))+$PIECE(^(ORP),"^",3)
- +27 IF $Y>(IOSL-4)
- DO HDR("S")
- End DoDot:3
- End DoDot:2
- IF $GET(ORSTOP)
- QUIT
- IF 'ORFS
- DO SUBTOT
- +28 IF $GET(ORSTOP)
- QUIT
- +29 IF 'ORFS
- WRITE $$REPEAT^XLFSTR("-",78)
- +30 FOR ORP="I","O"
- IF $DATA(ORTOT(1,ORP))
- Begin DoDot:2
- +31 WRITE !,$SELECT(ORP="I":"INPT",1:"OUTPT"),?10,$JUSTIFY($GET(ORTOT(1,ORP)),8),?19,$JUSTIFY(+$GET(ORTOT(10,ORP))_"/"_+$GET(ORTOT(9,ORP))_"/"_+$GET(ORTOT(8,ORP)),15)
- +32 WRITE ?34,$JUSTIFY($GET(ORTOT(2,ORP)),8),?44,$JUSTIFY($GET(ORTOT(3,ORP)),8),?53,$SELECT(+$GET(ORTOT(2,ORP))'=0:$JUSTIFY($GET(ORTOT(3,ORP))/$GET(ORTOT(2,ORP))*100,3,0)_"%",1:"NONE")
- +33 WRITE ?58,+$GET(ORTOT(4,ORP)),"/",+$GET(ORTOT(5,ORP)),"/",+$GET(ORTOT(6,ORP)),"/",+$GET(ORTOT(7,ORP))
- End DoDot:2
- +34 WRITE !,"TOTAL",?10,$JUSTIFY($GET(ORTOT(1)),8),?19,$JUSTIFY(+$GET(ORTOT(10))_"/"_+$GET(ORTOT(9))_"/"_+$GET(ORTOT(8)),15)
- +35 WRITE ?34,$JUSTIFY(ORTOT(2),8),?44,$JUSTIFY(ORTOT(3),8),?53,$SELECT(+ORTOT(2)'=0:$JUSTIFY(ORTOT(3)/ORTOT(2)*100,3,0)_"%",1:"NONE"),?58,+$GET(ORTOT(4)),"/",+$GET(ORTOT(5)),"/",+$GET(ORTOT(6)),"/",+$GET(ORTOT(7))
- End DoDot:1
- IF $GET(ORSTOP)
- QUIT
- +36 QUIT
- +37 ;
- SUBTOT ;Print individual sub totals
- +1 WRITE ?1," Sub-tot",?12,$JUSTIFY($GET(ORSTOT(1)),6),?34,$JUSTIFY($GET(ORSTOT(2)),8),?44,$JUSTIFY($GET(ORSTOT(3)),8)
- +2 WRITE ?53,$SELECT(+ORSTOT(2)'=0:$JUSTIFY($GET(ORSTOT(3))/$GET(ORSTOT(2))*100,3,0)_"%",1:"NONE"),!
- +3 QUIT
- +4 ;
- HDR(TYPE) ;Print appropriate header
- +1 IF $EXTRACT(IOST,1,2)="C-"&($GET(PG))
- SET DIR(0)="E"
- DO ^DIR
- SET ORSTOP='Y
- KILL DIR
- IF ORSTOP
- QUIT
- +2 IF $GET(PG)!('$GET(PG)&($EXTRACT(IOST,1,2)="C-"))
- WRITE @IOF
- +3 SET PG=$GET(PG)+1
- +4 WRITE !,"CPRS Performance Monitor ",$SELECT(TYPE="D":"- Detailed",ORFS:"- Summary Totals",1:"- Summary")," Report",?52,REPDT,?72,"PAGE ",$GET(PG),!,"Selected Date Range: ",$$FMTE^XLFDT(ORSD+.1,2)," to ",$$FMTE^XLFDT(ORED\1,2),!
- +5 WRITE "Sort criteria: ",$SELECT(ORPT="I":"IN",ORPT="O":"OUT",1:"ALL "),"PATIENTS/",$SELECT(ORTYPE="P":"PHARMACY",1:"ALL")," ORDERS"
- +6 IF TYPE="D"
- WRITE ?72,"ENTERED",!,"ORDER",?41,"ORD",?47,"PATIENT",?73,"BY HAS",!,"DATE",?11,"ORDER #",?19,"PAT ID",?27,"1st ORD ITEM",?41,"TYPE",?47,"LOCATION",?61,"PACKAGE",?74,"ORES?",!
- +7 IF TYPE="S"
- WRITE ?58,"BREAKDOWN OF ORDERS",!,?34,"PROVIDER",?44,"PROVIDER",?58,"NOT SELF ENTERED",!
- IF 'ORFS
- WRITE "PROVIDER"
- WRITE ?10,"UNIVERSE",?23,"DEA/STU/POL",?36,"ORDERS",?45,"ENTERED",?56,"%",?58,"WR/VE/TE/EL",!
- +8 WRITE $$REPEAT^XLFSTR("-",IOM),!
- +9 QUIT
- +10 ;
