| 1 | ECXLPRO1 ;ALB/JAP - PRO Extract YTD Lab Report (cont) ; 5/9/05 3:25pm
|
|---|
| 2 | ;;3.0;DSS EXTRACTS;**21,84**;Dec 22, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | PRINT ;print report
|
|---|
| 5 | N PG,LN,QFLG,NODE1,NODE2,DESC,AVE,JJ,SS,X1,X2
|
|---|
| 6 | U IO
|
|---|
| 7 | S QFLG=0,$P(LN,"-",132)=""
|
|---|
| 8 | S Y=ECXARRAY("START") D DD^%DT S ECXSTART=Y
|
|---|
| 9 | S Y=$S(LASTDAY:LASTDAY,ECXARRAY("END")>DT:DT,1:ECXARRAY("END")) D DD^%DT S ECXEND=Y
|
|---|
| 10 | D NOW^%DTC S Y=$E(%,1,12) D DD^%DT S ECXRUN=Y
|
|---|
| 11 | F ECXTYPE="N","X" D Q:QFLG
|
|---|
| 12 | .S PG=0 D HEADER
|
|---|
| 13 | .S ECXHCPC=""
|
|---|
| 14 | .;it's possible that no extract data was found
|
|---|
| 15 | .I '$D(^TMP($J,"ECXP",ECXTYPE)) D Q
|
|---|
| 16 | ..W !!,?37,"No extract data available."
|
|---|
| 17 | ..I $E(IOST)="C" D Q:QFLG
|
|---|
| 18 | ...S SS=22-$Y F JJ=1:1:SS W !
|
|---|
| 19 | ...S DIR(0)="E" D ^DIR K DIR S:'Y QFLG=1
|
|---|
| 20 | .F S ECXHCPC=$O(^TMP($J,"ECXP",ECXTYPE,ECXHCPC)) Q:ECXHCPC="" D Q:QFLG
|
|---|
| 21 | ..S DESC=$G(^TMP($J,"HCPCS",ECXHCPC)) S:DESC="" DESC="(Unknown)" S DESC=ECXHCPC_" "_DESC
|
|---|
| 22 | ..S NODE1=^TMP($J,"ECXP",ECXTYPE,ECXHCPC,"SAME"),NODE2=^TMP($J,"ECXP",ECXTYPE,ECXHCPC,"OTHER")
|
|---|
| 23 | ..;node holds - lab qty^lab labor cost^lab matrl cost
|
|---|
| 24 | ..F I=1:1:3 S X1(I)=+$P(NODE1,U,I),X2(I)=+$P(NODE2,U,I)
|
|---|
| 25 | ..S AVE("O")=0,AVE("S")=0,TOT("O")=0,TOT("S")=0
|
|---|
| 26 | ..S TOT("S")=X1(2)+X1(3),TOT("O")=X2(2)+X2(3)
|
|---|
| 27 | ..S:X1(1)>0 AVE("S")=TOT("S")/X1(1) S:X2(1)>0 AVE("O")=TOT("O")/X2(1)
|
|---|
| 28 | ..D:($Y+3>IOSL) HEADER Q:QFLG
|
|---|
| 29 | ..W !,DESC,?33,$J(X1(1),8,0),?43,$J(X1(2),8,0),?54,$J(X1(3),8,0),?65,$J(AVE("S"),8,2),?82,$J(X2(1),8,0),?93,$J(X2(2),8,0),?104,$J(X2(3),8,0),?115,$J(AVE("O"),8,2)
|
|---|
| 30 | .I 'QFLG,$E(IOST)="C" D
|
|---|
| 31 | ..S SS=22-$Y F JJ=1:1:SS W !
|
|---|
| 32 | ..S DIR(0)="E" D ^DIR K DIR S:'Y QFLG=1
|
|---|
| 33 | W @IOF
|
|---|
| 34 | Q
|
|---|
| 35 | ;
|
|---|
| 36 | HEADER ;header & page control
|
|---|
| 37 | I $E(IOST)="C" D
|
|---|
| 38 | .S SS=22-$Y F JJ=1:1:SS W !
|
|---|
| 39 | .I PG>0 S DIR(0)="E" D ^DIR K DIR S:'Y QFLG=1
|
|---|
| 40 | Q:QFLG
|
|---|
| 41 | W:$Y!($E(IOST)="C") @IOF S PG=PG+1
|
|---|
| 42 | W "Prosthetics (PRO) Extract YTD Laboratory Report",?122,"Page "_PG
|
|---|
| 43 | W !,"FY Date Range: "_ECXSTART_" to "_ECXEND
|
|---|
| 44 | W !,"Facility: "_$P(ECXPRIME,U,3)_" ("_$P(ECXPRIME,U,2)_")"
|
|---|
| 45 | W !,"Run Date/Time: "_ECXRUN
|
|---|
| 46 | W:ECXTYPE="N" !!,"REPORT OF NEW PROSTHETICS ACTIVITIES (Initial, Replacement, or Spare)",!
|
|---|
| 47 | W:ECXTYPE="X" !!,"REPORT OF REPAIR PROSTHETICS ACTIVITIES",!
|
|---|
| 48 | W !,?37,"Produced for Station #"_$P(ECXPRIME,U,2),?86,"Produced for all other stations"
|
|---|
| 49 | W !,"PSAS HCPCS",?37,"Qty.",?44,"Labor $",?55,"Mat'l $",?67,"Ave. $",?86,"Qty.",?94,"Labor $",?105,"Mat'l $",?117,"Ave. $"
|
|---|
| 50 | W !,LN,!
|
|---|
| 51 | Q
|
|---|
