Changeset 623 for WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXATRT.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXATRT.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXATRT.m
r613 r623 1 ECXATRT 2 ;;3.0;DSS EXTRACTS;**1,6,8,107,105**;Dec 22, 1997;Build 70 3 4 EN 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 PROCESS 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 ..S ECXTS=$P(DATA,U,15) I ECXTS'="" S ECXTS=$O(^DIC(42.4,"C",$G(ECXTS),0)),$P(DATA,U,15)=ECXTS90 ..S ECXTS=$P(DATA,U,16) I ECXTS'="" S ECXTS=$O(^DIC(42.4,"C",$G(ECXTS),0)),$P(DATA,U,16)=ECXTS91 92 93 ..Q:(NUM(+TS)=1)&(NEWTS=TS)94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 PRINT 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 HEADER 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 1 ECXATRT ;ALB/JAP - TRT Extract Audit Report ;O4/12/2007 2 ;;3.0;DSS EXTRACTS;**1,6,8,107**;Dec 22, 1997;Build 9 3 ; 4 EN ;entry point for TRT extract audit report 5 N %X,%Y,X,Y,DIC,DA,DR,DIQ,DIR 6 S ECXERR=0 7 ;ecxaud=0 for 'extract' audit 8 S ECXHEAD="TRT",ECXAUD=0 9 W !!,"Setup for ",ECXHEAD," Extract Audit Report --",!! 10 ;select extract 11 D AUDIT^ECXUTLA(ECXHEAD,.ECXERR,.ECXARRAY,ECXAUD) 12 Q:ECXERR 13 ;currently, this extract does not capture divisional data 14 S ECXALL=1 15 D TRT^ECXDVSN(.ECXDIV,ECXALL,.ECXERR) 16 I ECXERR=1 D Q 17 .W !!,?5,"Try again later... exiting.",! 18 .D AUDIT^ECXKILL 19 ;determine output device and queue if requested 20 W ! 21 S ECXPGM="PROCESS^ECXATRT",ECXDESC="TRT Extract Audit Report" 22 S ECXSAVE("ECXHEAD")="",ECXSAVE("ECXALL")="",ECXSAVE("ECXDIV(")="",ECXSAVE("ECXARRAY(")="" 23 W ! 24 D DEVICE^ECXUTLA(ECXPGM,ECXDESC,.ECXSAVE) 25 I ECXSAVE("POP")=1 D Q 26 .W !!,?5,"Try again later... exiting.",! 27 .D AUDIT^ECXKILL 28 I ECXSAVE("ZTSK")=0 D 29 .K ECXSAVE,ECXPGM,ECXDESC 30 .D PROCESS^ECXATRT 31 I IO'=IO(0) D ^%ZISC 32 D HOME^%ZIS 33 D AUDIT^ECXKILL 34 Q 35 ; 36 PROCESS ;process data in file #727.817 37 N X,Y,W,DATA,DATE,DIV,IEN,TS,SPEC,FTS,FTSNM,SERV,ECX,QQFLG,CNT,A1,A2,NUM,MN,NEWFTS,NEWSPEC 38 K ^TMP($J,"ECXAUD"),^TMP($J,"ECXSPEC") 39 S (QQFLG,CNT)=0 40 S ECXEXT=ECXARRAY("EXTRACT"),ECXDEF=ECXARRAY("DEF") 41 S X=ECXARRAY("START") D ^%DT S ECXSTART=Y S X=ECXARRAY("END") D ^%DT S ECXEND=Y 42 ;get run date in external format 43 D NOW^%DTC S Y=$E(%,1,12) D DD^%DT S ECXRUN=Y 44 ;set up the specialty array for site/division 45 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q 46 S DIV="" F S DIV=$O(ECXDIV(DIV)) Q:DIV="" D 47 .S DIC="^DIC(42.4,",DR=".01;3",DIQ(0)="E",DIQ="ECX" 48 .S SPEC="" F S SPEC=$O(^DIC(42.4,"B",SPEC)) Q:SPEC="" S TS=$O(^(SPEC,0)) D 49 ..K ECX S DA=TS D EN^DIQ1 50 ..S SPEC=$G(ECX(42.4,TS,.01,"E")),SERV=$G(ECX(42.4,TS,3,"E")) S:SERV="" SERV="Unknown" 51 ..S ^TMP($J,"ECXSPEC",DIV,TS)=0_U_SERV_U_SPEC,NUM(TS)=0 52 ;set up the specialty to facility treating specialty conversion array; 53 ;determine if active between ecxstart and ecxend; 54 ;ignore if facility treating specialty not active within date range of report; 55 S DIC="^DIC(45.7,",DR=".01;1",DIQ(0)="I",DIQ="ECX" 56 S FTSNM="" F S FTSNM=$O(^DIC(45.7,"B",FTSNM)) Q:FTSNM="" S FTS=$O(^(FTSNM,0)) D 57 .K ECX S DA=FTS D EN^DIQ1 58 .S FTSNM=$G(ECX(45.7,FTS,.01,"I")),TS=$G(ECX(45.7,FTS,1,"I")) 59 .Q:TS="" 60 .S A1=$$ACTIVE^DGACT(45.7,FTS,ECXSTART),A2=$$ACTIVE^DGACT(45.7,FTS,ECXEND) 61 .Q:A1=0&(A2=0) 62 .;num(ts) will hold the number of active facility treat. specialties (file #45.7) associated 63 .;with this national specialty (file #42.4). 64 .I '$D(NUM(TS)) S NUM(TS)=0 65 .S ^TMP($J,"ECXTS",TS,FTS)=FTSNM,^TMP($J,"ECXREVTS",FTS)=TS,NUM(TS)=NUM(TS)+1 66 ;get extract records in date range 67 S IEN="" F S IEN=$O(^ECX(727.817,"AC",ECXEXT,IEN)) Q:IEN="" D Q:QQFLG 68 .S DATA=^ECX(727.817,IEN,0),DATE=$P(DATA,U,9),DIV=$P(DATA,U,4) 69 .;currently the 4th piece of extract record is always null for trt 70 .S:DIV="" DIV=1 71 .;convert free text date to fm internal format date 72 .S $E(DATE,1,2)=$E(DATE,1,2)-17 73 .Q:$L(DATE)<7 Q:(DATE<ECXSTART) Q:(DATE>ECXEND) 74 .I $D(ECXDIV(DIV)) D 75 ..;ts is the old specialty, newfts is the new facility treat. spec. for the movement date; 76 ..;after patch #1 'losing treating specialty los' field (#17) is non-null only for actual specialty changes; 77 ..;so should be able to distinguish true ts changes from provider-only changes; 78 ..;although it will still be possible that old and new specialty are the same, but facility 79 ..;treat. spec. was changed, but we've lost that info in the extract. 80 ..; 81 ..;filter out those records which are definitely provider-only changes; 82 ..;these are the records that have 'losing treating specialty los' which is null; 83 ..;but for extracts done prior to patch #1, still need to compare old & new specialty. 84 ..; 85 ..;convert 15th and 16th piece from PTF code back to Specialty 86 ..;ECX*3.0*107 87 ..; 88 ..N ECXTS 89 ..S ECXTS=$P(DATA,U,15),ECXTS=$O(^DIC(42.4,$G(ECXTS),"C",$P(DATA,U,15),0)),$P(DATA,U,15)=ECXTS 90 ..S ECXTS=$P(DATA,U,16),ECXTS=$O(^DIC(42.4,$G(ECXTS),"C",$P(DATA,U,16),0)),$P(DATA,U,16)=ECXTS 91 ..S NEWTS=$P(DATA,U,15),TS=$P(DATA,U,16),LOS=$P(DATA,U,17) 92 ..;leaving this next line in here for v3.0 extracts done prior to patch #1 93 ..Q:(NUM(TS)=1)&(NEWTS=TS) 94 ..Q:LOS="" 95 ..S $P(^(TS),U,1)=$P(^TMP($J,"ECXSPEC",DIV,TS),U,1)+1,CNT=CNT+1 96 ..I $D(ZTQUEUED),(CNT>499),'(CNT#500),$$S^%ZTLOAD S QQFLG=1,ZTSTOP=1 K ZTREQ 97 ;after all extract records processed, arrange by service and specialty; 98 ;total can only be associated with specialty, not facility treating specialty; 99 ;include specialty only if total loss is non-zero 100 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q 101 S DIV="" F S DIV=$O(ECXDIV(DIV)) Q:DIV="" I $D(^TMP($J,"ECXSPEC",DIV)) D 102 .S TS="" F S TS=$O(^TMP($J,"ECXSPEC",DIV,TS)) Q:TS="" D 103 ..S TOT=+$P(^TMP($J,"ECXSPEC",DIV,TS),U,1) I TOT>0 D 104 ...S SERV=$P(^(TS),U,2),SPEC=$P(^(TS),U,3) 105 ...S ^TMP($J,"ECXAUD",DIV,SERV,SPEC)=TOT_U_TS 106 ;print the report 107 D PRINT 108 D AUDIT^ECXKILL 109 Q 110 ; 111 PRINT ;print trt data by site, by service, by specialty 112 N JJ,SS,LN,P,DIV,DIVNM,GTOT,SVCTOT,PG,QFLG,DIR,DIRUT,DTOUT,DUOUT 113 U IO 114 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q 115 S (QFLG,PG)=0,$P(LN,"-",80)="" 116 ;division associated with the treat. spec. change is not actually known; division is dss site 117 S DIV="" S DIV=$O(ECXDIV(DIV)) Q:DIV="" S GTOT=0 118 D HEADER 119 I '$D(^TMP($J,"ECXAUD",DIV)) D Q 120 .W !!,?5,"No data available for this DSS Site.",!! 121 I $D(^TMP($J,"ECXAUD",DIV)) S SERV="" F S SERV=$O(^TMP($J,"ECXAUD",DIV,SERV)) Q:SERV="" D Q:QFLG 122 .S SVCTOT=0 123 .;write the service name 124 .D:($Y+3>IOSL) HEADER Q:QFLG W !,SERV 125 .S SPEC="" F S SPEC=$O(^TMP($J,"ECXAUD",DIV,SERV,SPEC)) Q:SPEC="" D Q:QFLG 126 ..;write the specialty name and total 127 ..S TOT=$P(^TMP($J,"ECXAUD",DIV,SERV,SPEC),U,1),TS=$P(^(SPEC),U,2) 128 ..W ?22,$E(SPEC,1,30)_" ("_TS_")",?68,$$RJ^XLFSTR(TOT,5," "),! 129 ..S SVCTOT=SVCTOT+TOT,GTOT=GTOT+TOT 130 ..S FTS="" F S FTS=$O(^TMP($J,"ECXTS",TS,FTS)) Q:FTS="" D Q:QFLG 131 ...S FTSNM=^TMP($J,"ECXTS",TS,FTS) 132 ...D:($Y+3>IOSL) HEADER Q:QFLG W ?25,$E(FTSNM,1,30),! 133 .;write the service subtotal 134 .Q:QFLG 135 .W ?22,$E(LN,1,54),! 136 .D:($Y+3>IOSL) HEADER Q:QFLG W "Total for "_SERV_":",?68,$$RJ^XLFSTR(SVCTOT,5," "),! 137 ;write the grandtotal for all services at facility 138 D:($Y+3>IOSL) HEADER Q:QFLG W !!,"Grand Total for all Services:",?68,$$RJ^XLFSTR(GTOT,5," ") 139 ;print the audit descriptive narrative 140 I $E(IOST)'="C" D 141 .W @IOF S PG=PG+1 142 .W !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report" 143 .W !,"DSS Extract Log #: "_ECXEXT 144 .W !,"Date Range of Audit: "_ECXARRAY("START")_" to "_ECXARRAY("END") 145 .W !,"Report Run Date/Time: "_ECXRUN,?68,"Page: ",PG 146 .W !!,LN,!! 147 .S DIC="^ECX(727.1,",DA=ECXARRAY("DEF"),DR="1" D EN^DIQ 148 I $E(IOST)="C",'QFLG D 149 .S SS=22-$Y F JJ=1:1:SS W ! 150 .S DIR(0)="E" W ! D ^DIR K DIR 151 Q 152 ; 153 HEADER ;header and page control 154 N JJ,SS 155 I $E(IOST)="C" D 156 .S SS=22-$Y F JJ=1:1:SS W ! 157 .I PG>0 S DIR(0)="E" W ! D ^DIR K DIR S:'Y QFLG=1 158 Q:QFLG 159 W:$Y!($E(IOST)="C") @IOF S PG=PG+1 160 ;W !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report" 161 W !,"Treating Specialty Change"_" ("_ECXHEAD_") Extract Audit Report" 162 W !,"DSS Extract Log #: "_ECXARRAY("EXTRACT") 163 W !,"Date Range of Audit: "_ECXARRAY("START")_" to "_ECXARRAY("END") 164 W !,"Report Run Date/Time: "_ECXRUN 165 W !,"DSS Site: "_$P(ECXDIV(DIV),U,2)_" ("_$P(ECXDIV(DIV),U,3)_")",?68,"Page: "_PG 166 W !!,"Service",?22,"Specialty (DSS Code)",?68,"# of Losses" 167 W !,?25,"Facility Treating Specialty" 168 W !,LN,! 169 Q
Note:
See TracChangeset
for help on using the changeset viewer.
