ECXLPRO1 ;ALB/JAP - PRO Extract YTD Lab Report (cont) ;3/4/13 16:29
;;3.0;DSS EXTRACTS;**21,84,144**;Dec 22, 1997;Build 9
;
PRINT ;print report
N PG,LN,QFLG,NODE1,NODE2,DESC,AVE,JJ,SS,X1,X2
U IO
S QFLG=0,$P(LN,"-",132)=""
S Y=ECXARRAY("START") D DD^%DT S ECXSTART=Y
S Y=$S(LASTDAY:LASTDAY,ECXARRAY("END")>DT:DT,1:ECXARRAY("END")) D DD^%DT S ECXEND=Y
D NOW^%DTC S Y=$E(%,1,12) D DD^%DT S ECXRUN=Y
F ECXTYPE="N","X" D Q:QFLG
.I '$G(ECXPORT) S PG=0 D HEADER ;144 No header if exporting
.S ECXHCPC=""
.;it's possible that no extract data was found
.I '$D(^TMP($J,"ECXP",ECXTYPE)) D Q
..I $G(ECXPORT) Q ;144 Don't print if exporting
..W !!,?37,"No extract data available."
..I $E(IOST)="C" D Q:QFLG
...S SS=22-$Y F JJ=1:1:SS W !
...S DIR(0)="E" D ^DIR K DIR S:'Y QFLG=1
.F S ECXHCPC=$O(^TMP($J,"ECXP",ECXTYPE,ECXHCPC)) Q:ECXHCPC="" D Q:QFLG
..S DESC=$G(^TMP($J,"HCPCS",ECXHCPC)) S:DESC="" DESC="(Unknown)" S DESC=ECXHCPC_" "_DESC
..S NODE1=^TMP($J,"ECXP",ECXTYPE,ECXHCPC,"SAME"),NODE2=^TMP($J,"ECXP",ECXTYPE,ECXHCPC,"OTHER")
..;node holds - lab qty^lab labor cost^lab matrl cost
..F I=1:1:3 S X1(I)=+$P(NODE1,U,I),X2(I)=+$P(NODE2,U,I)
..S AVE("O")=0,AVE("S")=0,TOT("O")=0,TOT("S")=0
..S TOT("S")=X1(2)+X1(3),TOT("O")=X2(2)+X2(3)
..S:X1(1)>0 AVE("S")=TOT("S")/X1(1) S:X2(1)>0 AVE("O")=TOT("O")/X2(1)
..I '$G(ECXPORT) D:($Y+3>IOSL) HEADER Q:QFLG ;144 Don't print header if exporting
..I $G(ECXPORT) D Q ;144 get data if exporting
...S ^TMP($J,"ECXPORT",CNT)=$S(ECXTYPE="N":"NEW",1:"REPAIR") ;144
...S ^TMP($J,"ECXPORT",CNT)=^TMP($J,"ECXPORT",CNT)_U_DESC_U_X1(1)_U_X1(2)_U_X1(3)_U_$FN(AVE("S"),"",2)_U_X2(1)_U_X2(2)_U_X2(3)_U_$FN(AVE("O"),"",2) ;144
...S CNT=CNT+1 ;144
..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)
.I $G(ECXPORT) Q ;144 Stop if exporting
.I 'QFLG,$E(IOST)="C" D
..S SS=22-$Y F JJ=1:1:SS W !
..S DIR(0)="E" D ^DIR K DIR S:'Y QFLG=1
I '$G(ECXPORT) W @IOF ;144 Don't print if exporting
Q
;
I $E(IOST)="C" D
.S SS=22-$Y F JJ=1:1:SS W !
.I PG>0 S DIR(0)="E" D ^DIR K DIR S:'Y QFLG=1
Q:QFLG
W:$Y!($E(IOST)="C") @IOF S PG=PG+1
W "Prosthetics (PRO) Extract YTD Laboratory Report",?122,"Page "_PG
W !,"FY Date Range: "_ECXSTART_" to "_ECXEND
W !,"Facility: "_$P(ECXPRIME,U,3)_" ("_$P(ECXPRIME,U,2)_")"
W !,"Run Date/Time: "_ECXRUN
W:ECXTYPE="N" !!,"REPORT OF NEW PROSTHETICS ACTIVITIES (Initial, Replacement, or Spare)",!
W:ECXTYPE="X" !!,"REPORT OF REPAIR PROSTHETICS ACTIVITIES",!
W !,?37,"Produced for Station #"_$P(ECXPRIME,U,2),?86,"Produced for all other stations"
W !,"PSAS HCPCS",?37,"Qty.",?44,"Labor $",?55,"Mat'l $",?67,"Ave. $",?86,"Qty.",?94,"Labor $",?105,"Mat'l $",?117,"Ave. $"
W !,LN,!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXLPRO1 2881 printed Apr 09, 2024@20:58:45 Page 2
ECXLPRO1 ;ALB/JAP - PRO Extract YTD Lab Report (cont) ;3/4/13 16:29
+1 ;;3.0;DSS EXTRACTS;**21,84,144**;Dec 22, 1997;Build 9
+2 ;
PRINT ;print report
+1 NEW PG,LN,QFLG,NODE1,NODE2,DESC,AVE,JJ,SS,X1,X2
+2 USE IO
+3 SET QFLG=0
SET $PIECE(LN,"-",132)=""
+4 SET Y=ECXARRAY("START")
DO DD^%DT
SET ECXSTART=Y
+5 SET Y=$SELECT(LASTDAY:LASTDAY,ECXARRAY("END")>DT:DT,1:ECXARRAY("END"))
DO DD^%DT
SET ECXEND=Y
+6 DO NOW^%DTC
SET Y=$EXTRACT(%,1,12)
DO DD^%DT
SET ECXRUN=Y
+7 FOR ECXTYPE="N","X"
Begin DoDot:1
+8 ;144 No header if exporting
IF '$GET(ECXPORT)
SET PG=0
DO HEADER
+9 SET ECXHCPC=""
+10 ;it's possible that no extract data was found
+11 IF '$DATA(^TMP($JOB,"ECXP",ECXTYPE))
Begin DoDot:2
+12 ;144 Don't print if exporting
IF $GET(ECXPORT)
QUIT
+13 WRITE !!,?37,"No extract data available."
+14 IF $EXTRACT(IOST)="C"
Begin DoDot:3
+15 SET SS=22-$Y
FOR JJ=1:1:SS
WRITE !
+16 SET DIR(0)="E"
DO ^DIR
KILL DIR
if 'Y
SET QFLG=1
End DoDot:3
if QFLG
QUIT
End DoDot:2
QUIT
+17 FOR
SET ECXHCPC=$ORDER(^TMP($JOB,"ECXP",ECXTYPE,ECXHCPC))
if ECXHCPC=""
QUIT
Begin DoDot:2
+18 SET DESC=$GET(^TMP($JOB,"HCPCS",ECXHCPC))
if DESC=""
SET DESC="(Unknown)"
SET DESC=ECXHCPC_" "_DESC
+19 SET NODE1=^TMP($JOB,"ECXP",ECXTYPE,ECXHCPC,"SAME")
SET NODE2=^TMP($JOB,"ECXP",ECXTYPE,ECXHCPC,"OTHER")
+20 ;node holds - lab qty^lab labor cost^lab matrl cost
+21 FOR I=1:1:3
SET X1(I)=+$PIECE(NODE1,U,I)
SET X2(I)=+$PIECE(NODE2,U,I)
+22 SET AVE("O")=0
SET AVE("S")=0
SET TOT("O")=0
SET TOT("S")=0
+23 SET TOT("S")=X1(2)+X1(3)
SET TOT("O")=X2(2)+X2(3)
+24 if X1(1)>0
SET AVE("S")=TOT("S")/X1(1)
if X2(1)>0
SET AVE("O")=TOT("O")/X2(1)
+25 ;144 Don't print header if exporting
IF '$GET(ECXPORT)
if ($Y+3>IOSL)
DO HEADER
if QFLG
QUIT
+26 ;144 get data if exporting
IF $GET(ECXPORT)
Begin DoDot:3
+27 ;144
SET ^TMP($JOB,"ECXPORT",CNT)=$SELECT(ECXTYPE="N":"NEW",1:"REPAIR")
+28 ;144
SET ^TMP($JOB,"ECXPORT",CNT)=^TMP($JOB,"ECXPORT",CNT)_U_DESC_U_X1(1)_U_X1(2)_U_X1(3)_U_$FNUMBER(AVE("S"),"",2)_U_X2(1)_U_X2(2)_U_X2(3)_U_$FNUMBER(AVE("O"),"",2)
+29 ;144
SET CNT=CNT+1
End DoDot:3
QUIT
+30 WRITE !,DESC,?33,$JUSTIFY(X1(1),8,0),?43,$JUSTIFY(X1(2),8,0),?54,$JUSTIFY(X1(3),8,0),?65,$JUSTIFY(AVE("S"),8,2),?82,$JUSTIFY(X2(1),8,0),?93,$JUSTIFY(X2(2),8,0),?104,$JUSTIFY(X2(3),8,0),?115,$JUSTIFY(AVE("O"),8,2)
End DoDot:2
if QFLG
QUIT
+31 ;144 Stop if exporting
IF $GET(ECXPORT)
QUIT
+32 IF 'QFLG
IF $EXTRACT(IOST)="C"
Begin DoDot:2
+33 SET SS=22-$Y
FOR JJ=1:1:SS
WRITE !
+34 SET DIR(0)="E"
DO ^DIR
KILL DIR
if 'Y
SET QFLG=1
End DoDot:2
End DoDot:1
if QFLG
QUIT
+35 ;144 Don't print if exporting
IF '$GET(ECXPORT)
WRITE @IOF
+36 QUIT
+37 ;
+1 IF $EXTRACT(IOST)="C"
Begin DoDot:1
+2 SET SS=22-$Y
FOR JJ=1:1:SS
WRITE !
+3 IF PG>0
SET DIR(0)="E"
DO ^DIR
KILL DIR
if 'Y
SET QFLG=1
End DoDot:1
+4 if QFLG
QUIT
+5 if $Y!($EXTRACT(IOST)="C")
WRITE @IOF
SET PG=PG+1
+6 WRITE "Prosthetics (PRO) Extract YTD Laboratory Report",?122,"Page "_PG
+7 WRITE !,"FY Date Range: "_ECXSTART_" to "_ECXEND
+8 WRITE !,"Facility: "_$PIECE(ECXPRIME,U,3)_" ("_$PIECE(ECXPRIME,U,2)_")"
+9 WRITE !,"Run Date/Time: "_ECXRUN
+10 if ECXTYPE="N"
WRITE !!,"REPORT OF NEW PROSTHETICS ACTIVITIES (Initial, Replacement, or Spare)",!
+11 if ECXTYPE="X"
WRITE !!,"REPORT OF REPAIR PROSTHETICS ACTIVITIES",!
+12 WRITE !,?37,"Produced for Station #"_$PIECE(ECXPRIME,U,2),?86,"Produced for all other stations"
+13 WRITE !,"PSAS HCPCS",?37,"Qty.",?44,"Labor $",?55,"Mat'l $",?67,"Ave. $",?86,"Qty.",?94,"Labor $",?105,"Mat'l $",?117,"Ave. $"
+14 WRITE !,LN,!
+15 QUIT
