- ECXARAD ;ALB/JAP - RAD Extract Audit Report ;3/11/14 12:58
- ;;3.0;DSS EXTRACTS;**8,33,39,149**;Dec 22, 1997;Build 27
- ;
- EN ;entry point for RAD extract audit report
- ;select extract
- N %X,%Y,X,Y,DIC,DA,DR,DIQ,DIR,SITES,ECX,ECXPORT,RCNT ;149
- ;ecxaud=0 for 'extract' audit
- S ECXERR=0
- S ECXHEAD="RAD",ECXAUD=0
- W !!,"Setup for ",ECXHEAD," Extract Audit Report --",!!
- D AUDIT^ECXUTLA(ECXHEAD,.ECXERR,.ECXARRAY,ECXAUD)
- Q:ECXERR
- ;determine if facility is multidivisional
- K ECX D FILE^DID(79,,"ENTRIES","ECX") S SITES=ECX("ENTRIES") K ECX
- I SITES=1 S ECXALL=1
- I SITES>1 D
- .W !!
- .S DIR(0)="Y",DIR("A")="Do you want the "_ECXHEAD_" extract audit report for all divisions"
- .S DIR("B")="NO" D ^DIR K DIR
- .I $G(DIRUT) S ECXERR=1 Q
- .;if y=0 i.e., 'no', then ecxall=0 i.e., 'selected'
- .S ECXALL=Y
- I ECXERR=1 D Q
- .W !!,?5,"Try again later... exiting.",!
- .D AUDIT^ECXKILL
- ;select divisions/sites; all divisions if ecxall=1
- W !
- S ECXSTART=ECXARRAY("START"),ECXEND=ECXARRAY("END")
- D RAD^ECXDVSN2(.ECXDIV,ECXALL,.ECXERR)
- I ECXERR=1 D Q
- .W !!,?5,"Try again later... exiting.",!
- .D AUDIT^ECXKILL
- ;determine output device and queue if requested
- S ECXPGM="PROCESS^ECXARAD",ECXDESC="RAD Extract Audit Report"
- S ECXSAVE("ECXHEAD")="",ECXSAVE("ECXALL")="",ECXSAVE("ECXDIV(")="",ECXSAVE("ECXARRAY(")=""
- S ECXPORT=$$EXPORT^ECXUTL1 Q:ECXPORT=-1 I $G(ECXPORT) D Q ;149 Section added
- .K ^TMP($J,"ECXPORT")
- .S ^TMP($J,"ECXPORT",0)="EXTRACT LOG #^RADIOLOGY DIVISION^IMAGING TYPE (FEEDER LOCATION)^CPT CODE^PROCEDURE^# OF INPT PROCEDURES^# OF OUTPT PROCEDURES",RCNT=1
- .D PROCESS
- .D EXPDISP^ECXUTL1
- .D AUDIT^ECXKILL
- W !
- D DEVICE^ECXUTLA(ECXPGM,ECXDESC,.ECXSAVE)
- I ECXSAVE("POP")=1 D Q
- .W !!,?5,"Try again later... exiting.",!
- .D AUDIT^ECXKILL
- I ECXSAVE("ZTSK")=0 D
- .K ECXSAVE,ECXPGM,ECXDESC
- .D PROCESS^ECXARAD
- I IO'=IO(0) D ^%ZISC
- D HOME^%ZIS
- D AUDIT^ECXKILL
- Q
- ;
- PROCESS ;process data in file #727.814
- N X,Y,JJ,DIV,IEN,DATA,DATE,ECX,PAT,TYPE,IMNM,IMAB,PROC,PROCN,CPT,DIC,DIQ,DR,DA,QQFLG,CNT
- K ^TMP($J,"ECXAUD")
- S (CNT,QQFLG)=0
- S ECXEXT=ECXARRAY("EXTRACT"),ECXDEF=ECXARRAY("DEF")
- S X=ECXARRAY("START") D ^%DT S ECXSTART=Y S X=ECXARRAY("END") D ^%DT S ECXEND=Y
- ;get run date in external format
- D NOW^%DTC S Y=$E(%,1,12) D DD^%DT S ECXRUN=Y
- ;setup array of imaging types
- S TYPE=0 F S TYPE=$O(^RA(79.2,TYPE)) Q:+TYPE<1 D
- .K ECX S DIC="^RA(79.2,",DR=".01;3",DIQ="ECX",DIQ(0)="I",DA=TYPE D EN^DIQ1
- .S TYPE(TYPE)=ECX(79.2,TYPE,.01,"I")_U_ECX(79.2,TYPE,3,"I")
- ;get records within date range and radiology site(s)
- S IEN="" F S IEN=$O(^ECX(727.814,"AC",ECXEXT,IEN)) Q:IEN="" D Q:QQFLG
- .S DATA=^ECX(727.814,IEN,0),DATE=$P(DATA,U,9),DIV=$P(DATA,U,4)
- .;convert free text date to fm internal format date
- .S $E(DATE,1,2)=$E(DATE,1,2)-17
- .Q:$L(DATE)<7 Q:(DATE<ECXSTART) Q:(DATE>ECXEND)
- .Q:'$D(ECXDIV(DIV))
- .S PAT=$P(DATA,U,8),TYPE=$P(DATA,U,21),PROC=$P(DATA,U,11)
- .S CPT=$E($P(DATA,U,10),1,5),CPT="A"_$$RJ^XLFSTR(CPT,5,0)
- .S IMNM=$P(TYPE(TYPE),U,1),IMAB=$P(TYPE(TYPE),U,2)
- .K ECX S DIC="^RAMIS(71,",DR=".01",DIQ="ECX",DIQ(0)="I",DA=+PROC D EN^DIQ1
- .S PROCN=$G(ECX(71,+PROC,.01,"I")) I PROCN="" S PROCN="Unknown"
- .;tally procedures; 1st piece is outpatient total, 2nd piece is inpatient total
- .I '$D(^TMP($J,"ECXAUD",DIV,IMNM,CPT)) S ^TMP($J,"ECXAUD",DIV,IMNM,CPT)=0_U_0_U_PROCN
- .I PAT=1!(PAT="O") S $P(^(CPT),U,1)=$P(^TMP($J,"ECXAUD",DIV,IMNM,CPT),U,1)+1,CNT=CNT+1
- .I PAT=3!(PAT="I") S $P(^(CPT),U,2)=$P(^TMP($J,"ECXAUD",DIV,IMNM,CPT),U,2)+1,CNT=CNT+1
- .I $D(ZTQUEUED),(CNT>499),'(CNT#500),$$S^%ZTLOAD S QQFLG=1,ZTSTOP=1 K ZTREQ
- ;print the report
- D PRINT
- I $G(ECXPORT) Q ;149
- D AUDIT^ECXKILL
- Q
- ;
- PRINT ;print the RAD audit report by radiology site
- N LN,P,PG,QFLG,TOT,STOT,GTOT,DIVNM,IMAG,IMTYPE,T,SS,DIC,DIR,DR,DIRUT,DTOUT,DUOUT
- U IO
- I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q
- S (QFLG,PG)=0,$P(LN,"-",80)="",DIV=""
- ;arrange type array by name
- S T=0 F S T=$O(TYPE(T)) Q:T="" S IMNM=$P(TYPE(T),U,1),IMAG(IMNM)=T
- F S DIV=$O(ECXDIV(DIV)) Q:DIV="" D Q:QFLG
- .S DIVNM=$P(ECXDIV(DIV),U,2)_" ("_DIV_")",GTOT(1)=0,GTOT(3)=0 I '$G(ECXPORT) D HEADER ;149
- .I '$D(^TMP($J,"ECXAUD",DIV)) D Q
- ..I $G(ECXPORT) S ^TMP($J,"ECXPORT",RCNT)=ECXARRAY("EXTRACT")_U_DIVNM_U_"No data available for this Radiology Division",RCNT=RCNT+1 Q ;149
- ..W !!,?5,"No data available for this Radiology Division.",!!
- .I $D(^TMP($J,"ECXAUD",DIV)) S IMNM="" F S IMNM=$O(^TMP($J,"ECXAUD",DIV,IMNM)) Q:IMNM="" D Q:QFLG
- ..S STOT(1)=0,STOT(3)=0,IMTYPE=IMAG(IMNM),CPT=""
- ..;write the imaging type name
- ..I '$G(ECXPORT) D:($Y+3>IOSL) HEADER Q:QFLG W !,IMNM_" ("_DIV_"-"_IMTYPE_")",! ;149
- ..F S CPT=$O(^TMP($J,"ECXAUD",DIV,IMNM,CPT)) Q:CPT="" S TOT(1)=$P(^(CPT),U,1),TOT(3)=$P(^(CPT),U,2),PROCN=$P(^(CPT),U,3) D Q:QFLG
- ...S STOT(1)=STOT(1)+TOT(1),STOT(3)=STOT(3)+TOT(3)
- ...S GTOT(1)=GTOT(1)+TOT(1),GTOT(3)=GTOT(3)+TOT(3)
- ...;write procedure and total
- ...I $G(ECXPORT) S ^TMP($J,"ECXPORT",RCNT)=ECXARRAY("EXTRACT")_U_DIVNM_U_IMNM_" ("_DIV_"-"_IMTYPE_")"_U_$E(CPT,2,6)_U_PROCN_U_TOT(3)_U_TOT(1),RCNT=RCNT+1 Q ;149
- ...D:($Y+3>IOSL) HEADER Q:QFLG W ?3,$E(CPT,2,6),?14,$E(PROCN,1,38),?60,$$RJ^XLFSTR(TOT(3),5," "),?70,$$RJ^XLFSTR(TOT(1),5," "),!
- ..;write the unit subtotal
- ..I $G(ECXPORT) S ^TMP($J,"ECXPORT",RCNT)="^",RCNT=RCNT+1,^TMP($J,"ECXPORT",RCNT)="^^Sub-totals for "_IMNM_" ("_DIV_"-"_IMTYPE_")"_"^^^"_STOT(3)_U_STOT(1)_U,RCNT=RCNT+1,^TMP($J,"ECXPORT",RCNT)="^",RCNT=RCNT+1 Q ;149
- ..D:($Y+3>IOSL) HEADER Q:QFLG W !,?5,$E(LN,1,74)
- ..D:($Y+3>IOSL) HEADER Q:QFLG W !,"Sub-totals for "_IMNM_" ("_DIV_"-"_IMTYPE_"):",?60,$$RJ^XLFSTR(STOT(3),5," "),?70,$$RJ^XLFSTR(STOT(1),5," "),!
- .;write the division grandtotal
- .I $G(ECXPORT) S ^TMP($J,"ECXPORT",RCNT)="^^Grand Total for Divsion "_DIVNM_"^^^"_GTOT(3)_U_GTOT(1),RCNT=RCNT+1,^TMP($J,"ECXPORT",RCNT)="^",RCNT=RCNT+1 Q ;149
- .D:($Y+3>IOSL) HEADER Q:QFLG W !!,"Grand Total for Division "_DIVNM_":",?60,$$RJ^XLFSTR(GTOT(3),5," "),?70,$$RJ^XLFSTR(GTOT(1),5," ")
- ;print the audit descriptive narrative
- I $G(ECXPORT) Q ;149
- I $E(IOST)'="C" D
- .W @IOF S PG=PG+1
- .W !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report"
- .W !,"DSS Extract Log #: "_ECXEXT
- .W !,"Date Range of Audit: "_ECXARRAY("START")_" to "_ECXARRAY("END")
- .W !,"Report Run Date/Time: "_ECXRUN,?68,"Page: ",PG
- .W !!,LN,!!
- .S DIC="^ECX(727.1,",DA=ECXARRAY("DEF"),DR="1" D EN^DIQ
- I $E(IOST)="C",'QFLG D
- .S SS=22-$Y F JJ=1:1:SS W !
- .S DIR(0)="E" W ! D ^DIR K DIR
- Q
- ;
- N JJ,SS
- I $E(IOST)="C",'QFLG D ;149 Fixed problem with report not stopping when user enters "^"
- .S SS=22-$Y F JJ=1:1:SS W !
- .I PG>0 S DIR(0)="E" W ! D ^DIR K DIR S:'Y QFLG=1
- Q:QFLG
- W:$Y!($E(IOST)="C") @IOF S PG=PG+1
- W !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report"
- W !,"DSS Extract Log #: "_ECXARRAY("EXTRACT")
- W !,"Date Range of Audit: "_ECXARRAY("START")_" to "_ECXARRAY("END")
- W !,"Report Run Date/Time: "_ECXRUN
- W !,"Radiology Division: "_$P(ECXDIV(DIV),U,2)_" ("_DIV_")",?60,"Page: "_PG
- W !!,"Imaging Type (Feeder Location)",?60,"# of Procedures"
- W !,?3,"CPT Code",?14,"Procedure",?60,"Inpt.",?70,"Outpt."
- W !,LN,!
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXARAD 7276 printed Feb 18, 2025@23:18:37 Page 2
- ECXARAD ;ALB/JAP - RAD Extract Audit Report ;3/11/14 12:58
- +1 ;;3.0;DSS EXTRACTS;**8,33,39,149**;Dec 22, 1997;Build 27
- +2 ;
- EN ;entry point for RAD extract audit report
- +1 ;select extract
- +2 ;149
- NEW %X,%Y,X,Y,DIC,DA,DR,DIQ,DIR,SITES,ECX,ECXPORT,RCNT
- +3 ;ecxaud=0 for 'extract' audit
- +4 SET ECXERR=0
- +5 SET ECXHEAD="RAD"
- SET ECXAUD=0
- +6 WRITE !!,"Setup for ",ECXHEAD," Extract Audit Report --",!!
- +7 DO AUDIT^ECXUTLA(ECXHEAD,.ECXERR,.ECXARRAY,ECXAUD)
- +8 if ECXERR
- QUIT
- +9 ;determine if facility is multidivisional
- +10 KILL ECX
- DO FILE^DID(79,,"ENTRIES","ECX")
- SET SITES=ECX("ENTRIES")
- KILL ECX
- +11 IF SITES=1
- SET ECXALL=1
- +12 IF SITES>1
- Begin DoDot:1
- +13 WRITE !!
- +14 SET DIR(0)="Y"
- SET DIR("A")="Do you want the "_ECXHEAD_" extract audit report for all divisions"
- +15 SET DIR("B")="NO"
- DO ^DIR
- KILL DIR
- +16 IF $GET(DIRUT)
- SET ECXERR=1
- QUIT
- +17 ;if y=0 i.e., 'no', then ecxall=0 i.e., 'selected'
- +18 SET ECXALL=Y
- End DoDot:1
- +19 IF ECXERR=1
- Begin DoDot:1
- +20 WRITE !!,?5,"Try again later... exiting.",!
- +21 DO AUDIT^ECXKILL
- End DoDot:1
- QUIT
- +22 ;select divisions/sites; all divisions if ecxall=1
- +23 WRITE !
- +24 SET ECXSTART=ECXARRAY("START")
- SET ECXEND=ECXARRAY("END")
- +25 DO RAD^ECXDVSN2(.ECXDIV,ECXALL,.ECXERR)
- +26 IF ECXERR=1
- Begin DoDot:1
- +27 WRITE !!,?5,"Try again later... exiting.",!
- +28 DO AUDIT^ECXKILL
- End DoDot:1
- QUIT
- +29 ;determine output device and queue if requested
- +30 SET ECXPGM="PROCESS^ECXARAD"
- SET ECXDESC="RAD Extract Audit Report"
- +31 SET ECXSAVE("ECXHEAD")=""
- SET ECXSAVE("ECXALL")=""
- SET ECXSAVE("ECXDIV(")=""
- SET ECXSAVE("ECXARRAY(")=""
- +32 ;149 Section added
- SET ECXPORT=$$EXPORT^ECXUTL1
- if ECXPORT=-1
- QUIT
- IF $GET(ECXPORT)
- Begin DoDot:1
- +33 KILL ^TMP($JOB,"ECXPORT")
- +34 SET ^TMP($JOB,"ECXPORT",0)="EXTRACT LOG #^RADIOLOGY DIVISION^IMAGING TYPE (FEEDER LOCATION)^CPT CODE^PROCEDURE^# OF INPT PROCEDURES^# OF OUTPT PROCEDURES"
- SET RCNT=1
- +35 DO PROCESS
- +36 DO EXPDISP^ECXUTL1
- +37 DO AUDIT^ECXKILL
- End DoDot:1
- QUIT
- +38 WRITE !
- +39 DO DEVICE^ECXUTLA(ECXPGM,ECXDESC,.ECXSAVE)
- +40 IF ECXSAVE("POP")=1
- Begin DoDot:1
- +41 WRITE !!,?5,"Try again later... exiting.",!
- +42 DO AUDIT^ECXKILL
- End DoDot:1
- QUIT
- +43 IF ECXSAVE("ZTSK")=0
- Begin DoDot:1
- +44 KILL ECXSAVE,ECXPGM,ECXDESC
- +45 DO PROCESS^ECXARAD
- End DoDot:1
- +46 IF IO'=IO(0)
- DO ^%ZISC
- +47 DO HOME^%ZIS
- +48 DO AUDIT^ECXKILL
- +49 QUIT
- +50 ;
- PROCESS ;process data in file #727.814
- +1 NEW X,Y,JJ,DIV,IEN,DATA,DATE,ECX,PAT,TYPE,IMNM,IMAB,PROC,PROCN,CPT,DIC,DIQ,DR,DA,QQFLG,CNT
- +2 KILL ^TMP($JOB,"ECXAUD")
- +3 SET (CNT,QQFLG)=0
- +4 SET ECXEXT=ECXARRAY("EXTRACT")
- SET ECXDEF=ECXARRAY("DEF")
- +5 SET X=ECXARRAY("START")
- DO ^%DT
- SET ECXSTART=Y
- SET X=ECXARRAY("END")
- DO ^%DT
- SET ECXEND=Y
- +6 ;get run date in external format
- +7 DO NOW^%DTC
- SET Y=$EXTRACT(%,1,12)
- DO DD^%DT
- SET ECXRUN=Y
- +8 ;setup array of imaging types
- +9 SET TYPE=0
- FOR
- SET TYPE=$ORDER(^RA(79.2,TYPE))
- if +TYPE<1
- QUIT
- Begin DoDot:1
- +10 KILL ECX
- SET DIC="^RA(79.2,"
- SET DR=".01;3"
- SET DIQ="ECX"
- SET DIQ(0)="I"
- SET DA=TYPE
- DO EN^DIQ1
- +11 SET TYPE(TYPE)=ECX(79.2,TYPE,.01,"I")_U_ECX(79.2,TYPE,3,"I")
- End DoDot:1
- +12 ;get records within date range and radiology site(s)
- +13 SET IEN=""
- FOR
- SET IEN=$ORDER(^ECX(727.814,"AC",ECXEXT,IEN))
- if IEN=""
- QUIT
- Begin DoDot:1
- +14 SET DATA=^ECX(727.814,IEN,0)
- SET DATE=$PIECE(DATA,U,9)
- SET DIV=$PIECE(DATA,U,4)
- +15 ;convert free text date to fm internal format date
- +16 SET $EXTRACT(DATE,1,2)=$EXTRACT(DATE,1,2)-17
- +17 if $LENGTH(DATE)<7
- QUIT
- if (DATE<ECXSTART)
- QUIT
- if (DATE>ECXEND)
- QUIT
- +18 if '$DATA(ECXDIV(DIV))
- QUIT
- +19 SET PAT=$PIECE(DATA,U,8)
- SET TYPE=$PIECE(DATA,U,21)
- SET PROC=$PIECE(DATA,U,11)
- +20 SET CPT=$EXTRACT($PIECE(DATA,U,10),1,5)
- SET CPT="A"_$$RJ^XLFSTR(CPT,5,0)
- +21 SET IMNM=$PIECE(TYPE(TYPE),U,1)
- SET IMAB=$PIECE(TYPE(TYPE),U,2)
- +22 KILL ECX
- SET DIC="^RAMIS(71,"
- SET DR=".01"
- SET DIQ="ECX"
- SET DIQ(0)="I"
- SET DA=+PROC
- DO EN^DIQ1
- +23 SET PROCN=$GET(ECX(71,+PROC,.01,"I"))
- IF PROCN=""
- SET PROCN="Unknown"
- +24 ;tally procedures; 1st piece is outpatient total, 2nd piece is inpatient total
- +25 IF '$DATA(^TMP($JOB,"ECXAUD",DIV,IMNM,CPT))
- SET ^TMP($JOB,"ECXAUD",DIV,IMNM,CPT)=0_U_0_U_PROCN
- +26 IF PAT=1!(PAT="O")
- SET $PIECE(^(CPT),U,1)=$PIECE(^TMP($JOB,"ECXAUD",DIV,IMNM,CPT),U,1)+1
- SET CNT=CNT+1
- +27 IF PAT=3!(PAT="I")
- SET $PIECE(^(CPT),U,2)=$PIECE(^TMP($JOB,"ECXAUD",DIV,IMNM,CPT),U,2)+1
- SET CNT=CNT+1
- +28 IF $DATA(ZTQUEUED)
- IF (CNT>499)
- IF '(CNT#500)
- IF $$S^%ZTLOAD
- SET QQFLG=1
- SET ZTSTOP=1
- KILL ZTREQ
- End DoDot:1
- if QQFLG
- QUIT
- +29 ;print the report
- +30 DO PRINT
- +31 ;149
- IF $GET(ECXPORT)
- QUIT
- +32 DO AUDIT^ECXKILL
- +33 QUIT
- +34 ;
- PRINT ;print the RAD audit report by radiology site
- +1 NEW LN,P,PG,QFLG,TOT,STOT,GTOT,DIVNM,IMAG,IMTYPE,T,SS,DIC,DIR,DR,DIRUT,DTOUT,DUOUT
- +2 USE IO
- +3 IF $DATA(ZTQUEUED)
- IF $$S^%ZTLOAD
- SET ZTSTOP=1
- KILL ZTREQ
- QUIT
- +4 SET (QFLG,PG)=0
- SET $PIECE(LN,"-",80)=""
- SET DIV=""
- +5 ;arrange type array by name
- +6 SET T=0
- FOR
- SET T=$ORDER(TYPE(T))
- if T=""
- QUIT
- SET IMNM=$PIECE(TYPE(T),U,1)
- SET IMAG(IMNM)=T
- +7 FOR
- SET DIV=$ORDER(ECXDIV(DIV))
- if DIV=""
- QUIT
- Begin DoDot:1
- +8 ;149
- SET DIVNM=$PIECE(ECXDIV(DIV),U,2)_" ("_DIV_")"
- SET GTOT(1)=0
- SET GTOT(3)=0
- IF '$GET(ECXPORT)
- DO HEADER
- +9 IF '$DATA(^TMP($JOB,"ECXAUD",DIV))
- Begin DoDot:2
- +10 ;149
- IF $GET(ECXPORT)
- SET ^TMP($JOB,"ECXPORT",RCNT)=ECXARRAY("EXTRACT")_U_DIVNM_U_"No data available for this Radiology Division"
- SET RCNT=RCNT+1
- QUIT
- +11 WRITE !!,?5,"No data available for this Radiology Division.",!!
- End DoDot:2
- QUIT
- +12 IF $DATA(^TMP($JOB,"ECXAUD",DIV))
- SET IMNM=""
- FOR
- SET IMNM=$ORDER(^TMP($JOB,"ECXAUD",DIV,IMNM))
- if IMNM=""
- QUIT
- Begin DoDot:2
- +13 SET STOT(1)=0
- SET STOT(3)=0
- SET IMTYPE=IMAG(IMNM)
- SET CPT=""
- +14 ;write the imaging type name
- +15 ;149
- IF '$GET(ECXPORT)
- if ($Y+3>IOSL)
- DO HEADER
- if QFLG
- QUIT
- WRITE !,IMNM_" ("_DIV_"-"_IMTYPE_")",!
- +16 FOR
- SET CPT=$ORDER(^TMP($JOB,"ECXAUD",DIV,IMNM,CPT))
- if CPT=""
- QUIT
- SET TOT(1)=$PIECE(^(CPT),U,1)
- SET TOT(3)=$PIECE(^(CPT),U,2)
- SET PROCN=$PIECE(^(CPT),U,3)
- Begin DoDot:3
- +17 SET STOT(1)=STOT(1)+TOT(1)
- SET STOT(3)=STOT(3)+TOT(3)
- +18 SET GTOT(1)=GTOT(1)+TOT(1)
- SET GTOT(3)=GTOT(3)+TOT(3)
- +19 ;write procedure and total
- +20 ;149
- IF $GET(ECXPORT)
- SET ^TMP($JOB,"ECXPORT",RCNT)=ECXARRAY("EXTRACT")_U_DIVNM_U_IMNM_" ("_DIV_"-"_IMTYPE_")"_U_$EXTRACT(CPT,2,6)_U_PROCN_U_TOT(3)_U_TOT(1)
- SET RCNT=RCNT+1
- QUIT
- +21 if ($Y+3>IOSL)
- DO HEADER
- if QFLG
- QUIT
- WRITE ?3,$EXTRACT(CPT,2,6),?14,$EXTRACT(PROCN,1,38),?60,$$RJ^XLFSTR(TOT(3),5," "),?70,$$RJ^XLFSTR(TOT(1),5," "),!
- End DoDot:3
- if QFLG
- QUIT
- +22 ;write the unit subtotal
- +23 ;149
- IF $GET(ECXPORT)
- SET ^TMP($JOB,"ECXPORT",RCNT)="^"
- SET RCNT=RCNT+1
- SET ^TMP($JOB,"ECXPORT",RCNT)="^^Sub-totals for "_IMNM_" ("_DIV_"-"_IMTYPE_")"_"^^^"_STOT(3)_U_STOT(1)_U
- SET RCNT=RCNT+1
- SET ^TMP($JOB,"ECXPORT",RCNT)="^"
- SET RCNT=RCNT+1
- QUIT
- +24 if ($Y+3>IOSL)
- DO HEADER
- if QFLG
- QUIT
- WRITE !,?5,$EXTRACT(LN,1,74)
- +25 if ($Y+3>IOSL)
- DO HEADER
- if QFLG
- QUIT
- WRITE !,"Sub-totals for "_IMNM_" ("_DIV_"-"_IMTYPE_"):",?60,$$RJ^XLFSTR(STOT(3),5," "),?70,$$RJ^XLFSTR(STOT(1),5," "),!
- End DoDot:2
- if QFLG
- QUIT
- +26 ;write the division grandtotal
- +27 ;149
- IF $GET(ECXPORT)
- SET ^TMP($JOB,"ECXPORT",RCNT)="^^Grand Total for Divsion "_DIVNM_"^^^"_GTOT(3)_U_GTOT(1)
- SET RCNT=RCNT+1
- SET ^TMP($JOB,"ECXPORT",RCNT)="^"
- SET RCNT=RCNT+1
- QUIT
- +28 if ($Y+3>IOSL)
- DO HEADER
- if QFLG
- QUIT
- WRITE !!,"Grand Total for Division "_DIVNM_":",?60,$$RJ^XLFSTR(GTOT(3),5," "),?70,$$RJ^XLFSTR(GTOT(1),5," ")
- End DoDot:1
- if QFLG
- QUIT
- +29 ;print the audit descriptive narrative
- +30 ;149
- IF $GET(ECXPORT)
- QUIT
- +31 IF $EXTRACT(IOST)'="C"
- Begin DoDot:1
- +32 WRITE @IOF
- SET PG=PG+1
- +33 WRITE !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report"
- +34 WRITE !,"DSS Extract Log #: "_ECXEXT
- +35 WRITE !,"Date Range of Audit: "_ECXARRAY("START")_" to "_ECXARRAY("END")
- +36 WRITE !,"Report Run Date/Time: "_ECXRUN,?68,"Page: ",PG
- +37 WRITE !!,LN,!!
- +38 SET DIC="^ECX(727.1,"
- SET DA=ECXARRAY("DEF")
- SET DR="1"
- DO EN^DIQ
- End DoDot:1
- +39 IF $EXTRACT(IOST)="C"
- IF 'QFLG
- Begin DoDot:1
- +40 SET SS=22-$Y
- FOR JJ=1:1:SS
- WRITE !
- +41 SET DIR(0)="E"
- WRITE !
- DO ^DIR
- KILL DIR
- End DoDot:1
- +42 QUIT
- +43 ;
- +1 NEW JJ,SS
- +2 ;149 Fixed problem with report not stopping when user enters "^"
- IF $EXTRACT(IOST)="C"
- IF 'QFLG
- Begin DoDot:1
- +3 SET SS=22-$Y
- FOR JJ=1:1:SS
- WRITE !
- +4 IF PG>0
- SET DIR(0)="E"
- WRITE !
- DO ^DIR
- KILL DIR
- if 'Y
- SET QFLG=1
- End DoDot:1
- +5 if QFLG
- QUIT
- +6 if $Y!($EXTRACT(IOST)="C")
- WRITE @IOF
- SET PG=PG+1
- +7 WRITE !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report"
- +8 WRITE !,"DSS Extract Log #: "_ECXARRAY("EXTRACT")
- +9 WRITE !,"Date Range of Audit: "_ECXARRAY("START")_" to "_ECXARRAY("END")
- +10 WRITE !,"Report Run Date/Time: "_ECXRUN
- +11 WRITE !,"Radiology Division: "_$PIECE(ECXDIV(DIV),U,2)_" ("_DIV_")",?60,"Page: "_PG
- +12 WRITE !!,"Imaging Type (Feeder Location)",?60,"# of Procedures"
- +13 WRITE !,?3,"CPT Code",?14,"Procedure",?60,"Inpt.",?70,"Outpt."
- +14 WRITE !,LN,!
- +15 QUIT