- ECXCPRO1 ;ALB/JAP - PRO Extract YTD Report (cont) ;12/4/19 10:02
- ;;3.0;DSS EXTRACTS;**21,84,132,144,174,177,190**;Dec 22, 1997;Build 36
- ;
- PRINT ;print report
- N PG,LN,QFLG,NODE,DESC,AVE,JJ,SS,TOTAL,TOT,TQTY
- 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
- ;if ecxall=0, then only one subdivision of multidivision facility
- ;if ecxall=1, then either entire facility (i.e., non-divisional), or all subdivisions combined under primary station#
- ;but it's possible that no extract data was found
- S ECXSTAT="",ECXSTAT=$O(^TMP($J,"ECXP",ECXSTAT)) I ECXSTAT="" D Q
- .I $G(ECXPORT) Q ;144 Don't display anything if exporting
- .I ECXALL=0 S ECXSTAT=$O(DIVISION(""))
- .F ECXTYPE="N","X","R" D Q:QFLG
- ..S PG=0 D HEADER
- ..W !!,?36,"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 ECXTYPE="N","X","R" D Q:QFLG
- .S PG=0 I '$G(ECXPORT) D HEADER ;144 Don't print header if exporting
- .S ECXHCPC=""
- .I '$D(^TMP($J,"ECXP",ECXSTAT,ECXTYPE)) D Q
- ..I $G(ECXPORT) Q ;144 Don't display anything if exporting
- ..W !!,?36,"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",ECXSTAT,ECXTYPE,ECXHCPC)) Q:ECXHCPC="" D Q:QFLG
- ..S DESC=$G(^TMP($J,"HCPCS",ECXHCPC)) S:DESC="" DESC="(Unknown)" S DESC=ECXHCPC_" "_DESC
- ..S NODE=^TMP($J,"ECXP",ECXSTAT,ECXTYPE,ECXHCPC)
- ..;node holds - com qty^com cost^va nonlab qty^va nonlab cost^lab qty^lab labor cost^lab matrl cost^nppd code
- ..F I=1:1:7 S X(I)=+$P(NODE,U,I)
- ..S X(8)=$P(NODE,U,8) ;190 - Alnum field, can't be forced to number
- ..S AVE("C")=0,AVE("V")=0,AVE("L")=0,AVE("ALL")=0,TOT("L")=0,TOTAL=0,TQTY=0
- ..S:X(1)>0 AVE("C")=X(2)/X(1) S:X(3)>0 AVE("V")=X(4)/X(3) S TOT("L")=X(6)+X(7) S:X(5)>0 AVE("L")=TOT("L")/X(5)
- ..S TQTY=X(1)+X(3)+X(5),TOTAL=X(2)+X(4)+TOT("L")
- ..S:TQTY>0 AVE("ALL")=TOTAL/TQTY
- ..I '$G(ECXPORT) D:($Y+3>IOSL) HEADER Q:QFLG ;144 Don't display anything if exporting
- ..I $G(ECXPORT) S ^TMP($J,"ECXPORT",CNT)=$S(ECXTYPE="N":"NEW",ECXTYPE="R":"RENTAL",1:"REPAIR") D Q ;144
- ...S ^TMP($J,"ECXPORT",CNT)=^TMP($J,"ECXPORT",CNT)_U_DESC_U_X(1)_U_X(2)_U_$FN(AVE("C"),"",2)_U_X(3)_U_X(4)_U_$FN(AVE("V"),"",2)_U_X(5)_U_TOT("L")_U_$FN(AVE("L"),"",2)_U_$FN(AVE("ALL"),"",2)_U_X(8) ;144,190
- ...S CNT=CNT+1 ;144
- ..W !,DESC,?33,$J(X(1),8,0),?43,$J(X(2),8,0),?53,$J(AVE("C"),8,2),?63,$J(X(3),8,0),?73,$J(X(4),8,0),?83,$J(AVE("V"),8,2),?93,$J(X(5),8,0),?103,$J(TOT("L"),8,0),?113,$J(AVE("L"),8,2),?123,$J(AVE("ALL"),8,2)
- .Q:$G(ECXPORT)!(QFLG) ;144,177 Don't continue if exporting or user entered '^'
- .I ECXTYPE="R" D ;174 Section added for note to display after rental information
- ..I $Y+3>IOSL D HEADER ;Print header if not enough room for the note
- ..W:'QFLG !!,"NOTE: For Vista records with Unit of Issue=MO, the extract Unit of Issue and Quantity have been converted from months to days." ;177
- .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 write anything 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 HCPCS Report",?122,"Page "_PG
- W !,"FY Date Range: "_ECXSTART_" to "_ECXEND
- I ECXALL=0 W !,"Division: "_$P(DIVISION(ECXSTAT),U,3)_" ("_$P(DIVISION(ECXSTAT),U,2)_")"
- I ECXALL=1 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="R" !!,"REPORT OF RENTAL PROSTHETICS ACTIVITIES"
- W:ECXTYPE="X" !!,"REPORT OF REPAIR PROSTHETICS ACTIVITIES"
- W !,?36,"Qty.",?44,"Total $",?55,"Ave. $",?67,"Qty.",?74,"Total $",?85,"Ave. $",?97,"Qty.",?104,"Total $",?114,"Ave. $",?125,"Ave. $"
- W !,"PSAS HCPCS",?35,"-Comm-",?44,"-Comm-",?55,"-Comm-",?67,"-VA-",?75,"-VA-",?85,"-VA-",?96,"-Lab-",?105,"-Lab-",?114,"-Lab-",?125,"-All-"
- W !,LN,!
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXCPRO1 4327 printed Mar 13, 2025@20:57 Page 2
- ECXCPRO1 ;ALB/JAP - PRO Extract YTD Report (cont) ;12/4/19 10:02
- +1 ;;3.0;DSS EXTRACTS;**21,84,132,144,174,177,190**;Dec 22, 1997;Build 36
- +2 ;
- PRINT ;print report
- +1 NEW PG,LN,QFLG,NODE,DESC,AVE,JJ,SS,TOTAL,TOT,TQTY
- +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 ;if ecxall=0, then only one subdivision of multidivision facility
- +8 ;if ecxall=1, then either entire facility (i.e., non-divisional), or all subdivisions combined under primary station#
- +9 ;but it's possible that no extract data was found
- +10 SET ECXSTAT=""
- SET ECXSTAT=$ORDER(^TMP($JOB,"ECXP",ECXSTAT))
- IF ECXSTAT=""
- Begin DoDot:1
- +11 ;144 Don't display anything if exporting
- IF $GET(ECXPORT)
- QUIT
- +12 IF ECXALL=0
- SET ECXSTAT=$ORDER(DIVISION(""))
- +13 FOR ECXTYPE="N","X","R"
- Begin DoDot:2
- +14 SET PG=0
- DO HEADER
- +15 WRITE !!,?36,"No extract data available."
- +16 IF $EXTRACT(IOST)="C"
- Begin DoDot:3
- +17 SET SS=22-$Y
- FOR JJ=1:1:SS
- WRITE !
- +18 SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- if 'Y
- SET QFLG=1
- End DoDot:3
- if QFLG
- QUIT
- End DoDot:2
- if QFLG
- QUIT
- End DoDot:1
- QUIT
- +19 FOR ECXTYPE="N","X","R"
- Begin DoDot:1
- +20 ;144 Don't print header if exporting
- SET PG=0
- IF '$GET(ECXPORT)
- DO HEADER
- +21 SET ECXHCPC=""
- +22 IF '$DATA(^TMP($JOB,"ECXP",ECXSTAT,ECXTYPE))
- Begin DoDot:2
- +23 ;144 Don't display anything if exporting
- IF $GET(ECXPORT)
- QUIT
- +24 WRITE !!,?36,"No extract data available."
- +25 IF $EXTRACT(IOST)="C"
- Begin DoDot:3
- +26 SET SS=22-$Y
- FOR JJ=1:1:SS
- WRITE !
- +27 SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- if 'Y
- SET QFLG=1
- End DoDot:3
- if QFLG
- QUIT
- End DoDot:2
- QUIT
- +28 FOR
- SET ECXHCPC=$ORDER(^TMP($JOB,"ECXP",ECXSTAT,ECXTYPE,ECXHCPC))
- if ECXHCPC=""
- QUIT
- Begin DoDot:2
- +29 SET DESC=$GET(^TMP($JOB,"HCPCS",ECXHCPC))
- if DESC=""
- SET DESC="(Unknown)"
- SET DESC=ECXHCPC_" "_DESC
- +30 SET NODE=^TMP($JOB,"ECXP",ECXSTAT,ECXTYPE,ECXHCPC)
- +31 ;node holds - com qty^com cost^va nonlab qty^va nonlab cost^lab qty^lab labor cost^lab matrl cost^nppd code
- +32 FOR I=1:1:7
- SET X(I)=+$PIECE(NODE,U,I)
- +33 ;190 - Alnum field, can't be forced to number
- SET X(8)=$PIECE(NODE,U,8)
- +34 SET AVE("C")=0
- SET AVE("V")=0
- SET AVE("L")=0
- SET AVE("ALL")=0
- SET TOT("L")=0
- SET TOTAL=0
- SET TQTY=0
- +35 if X(1)>0
- SET AVE("C")=X(2)/X(1)
- if X(3)>0
- SET AVE("V")=X(4)/X(3)
- SET TOT("L")=X(6)+X(7)
- if X(5)>0
- SET AVE("L")=TOT("L")/X(5)
- +36 SET TQTY=X(1)+X(3)+X(5)
- SET TOTAL=X(2)+X(4)+TOT("L")
- +37 if TQTY>0
- SET AVE("ALL")=TOTAL/TQTY
- +38 ;144 Don't display anything if exporting
- IF '$GET(ECXPORT)
- if ($Y+3>IOSL)
- DO HEADER
- if QFLG
- QUIT
- +39 ;144
- IF $GET(ECXPORT)
- SET ^TMP($JOB,"ECXPORT",CNT)=$SELECT(ECXTYPE="N":"NEW",ECXTYPE="R":"RENTAL",1:"REPAIR")
- Begin DoDot:3
- +40 ;144,190
- SET ^TMP($JOB,"ECXPORT",CNT)=^TMP($JOB,"ECXPORT",CNT)_U_DESC_U_X(1)_U_X(2)_U_$FNUMBER(AVE("C"),"",2)_U_X(3)_U_X(4)_U_$FNUMBER(AVE("V"),"",2)_U_X(5)_U_TOT("L")_U_$FNUMBER(AVE("L"),"",2)_U_$FNUMBER(AVE("ALL"),"",2)_U_X(8)
- +41 ;144
- SET CNT=CNT+1
- End DoDot:3
- QUIT
- +42 WRITE !,DESC,?33,$JUSTIFY(X(1),8,0),?43,$JUSTIFY(X(2),8,0),?53,$JUSTIFY(AVE("C"),8,2),?63,$JUSTIFY(X(3),8,0),?73,$JUSTIFY(X(4),8,0),?83,$JUSTIFY(AVE("V"),8,2),?93,$JUSTIFY(X(5),8,0),?103,$JUSTIFY(TOT("L"),8,0),?113,...
- ... $JUSTIFY(AVE("L"),8,2),?123,$JUSTIFY(AVE("ALL"),8,2)
- End DoDot:2
- if QFLG
- QUIT
- +43 ;144,177 Don't continue if exporting or user entered '^'
- if $GET(ECXPORT)!(QFLG)
- QUIT
- +44 ;174 Section added for note to display after rental information
- IF ECXTYPE="R"
- Begin DoDot:2
- +45 ;Print header if not enough room for the note
- IF $Y+3>IOSL
- DO HEADER
- +46 ;177
- if 'QFLG
- WRITE !!,"NOTE: For Vista records with Unit of Issue=MO, the extract Unit of Issue and Quantity have been converted from months to days."
- End DoDot:2
- +47 IF 'QFLG
- IF $EXTRACT(IOST)="C"
- Begin DoDot:2
- +48 SET SS=22-$Y
- FOR JJ=1:1:SS
- WRITE !
- +49 SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- if 'Y
- SET QFLG=1
- End DoDot:2
- End DoDot:1
- if QFLG
- QUIT
- +50 ;144 Don't write anything if exporting
- IF '$GET(ECXPORT)
- WRITE @IOF
- +51 QUIT
- +52 ;
- +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 HCPCS Report",?122,"Page "_PG
- +7 WRITE !,"FY Date Range: "_ECXSTART_" to "_ECXEND
- +8 IF ECXALL=0
- WRITE !,"Division: "_$PIECE(DIVISION(ECXSTAT),U,3)_" ("_$PIECE(DIVISION(ECXSTAT),U,2)_")"
- +9 IF ECXALL=1
- WRITE !,"Facility: "_$PIECE(ECXPRIME,U,3)_" ("_$PIECE(ECXPRIME,U,2)_")"
- +10 WRITE !,"Run Date/Time: "_ECXRUN
- +11 if ECXTYPE="N"
- WRITE !!,"REPORT OF NEW PROSTHETICS ACTIVITIES (Initial, Replacement, or Spare)"
- +12 if ECXTYPE="R"
- WRITE !!,"REPORT OF RENTAL PROSTHETICS ACTIVITIES"
- +13 if ECXTYPE="X"
- WRITE !!,"REPORT OF REPAIR PROSTHETICS ACTIVITIES"
- +14 WRITE !,?36,"Qty.",?44,"Total $",?55,"Ave. $",?67,"Qty.",?74,"Total $",?85,"Ave. $",?97,"Qty.",?104,"Total $",?114,"Ave. $",?125,"Ave. $"
- +15 WRITE !,"PSAS HCPCS",?35,"-Comm-",?44,"-Comm-",?55,"-Comm-",?67,"-VA-",?75,"-VA-",?85,"-VA-",?96,"-Lab-",?105,"-Lab-",?114,"-Lab-",?125,"-All-"
- +16 WRITE !,LN,!
- +17 QUIT
