- ECXALAB ;ALB/JAP - ECS Extract Audit Report ;3/27/14 16:10
- ;;3.0;DSS EXTRACTS;**1,8,149**;Dec 22, 1997;Build 27
- ;
- EN ;entry point for LAB extract audit report
- ;this audit report can be used for extracts done with
- ;either ECXLABN or ECXLABO
- N %X,%Y,X,Y,DIC,DA,DR,DIQ,DIR,ECXPORT,RCNT ;149
- S ECXERR=0
- ;ecxaud=0 for 'extract' audit
- S ECXHEAD="LAB",ECXAUD=0
- W !!,"Setup for ",ECXHEAD," Extract Audit Report --",!!
- ;select extract
- D AUDIT^ECXUTLA(ECXHEAD,.ECXERR,.ECXARRAY,ECXAUD)
- Q:ECXERR
- W !!
- ;get the dss site name for report header
- S ECXALL=1 D DEFAULT^ECXDVSN(.ECXDIV,ECXALL,.ECXERR)
- Q:ECXERR=1
- S DIR(0)="Y",DIR("A")="Do you want the "_ECXHEAD_" extract audit report for all Accession Areas"
- 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 accession areas; all accession areas if ecxall=1
- S X=ECXARRAY("START") D ^%DT S ECXSTART=Y S X=ECXARRAY("END") D ^%DT S ECXEND=Y
- D LAB^ECXDVSN1(.ECXACC,ECXALL,.ECXERR)
- I ECXERR=1 D Q
- .W !!,?5,"Try again later... exiting.",!
- .D AUDIT^ECXKILL
- ;determine output device and queue if requested
- 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 #^DSS SITE^ACCESSION AREA (FEEDER LOCATION)^PROCEDURE^LMIP CODE^# OF TESTS (PATIENTS)^# OF TESTS (REFERRALS)",RCNT=1
- .D PROCESS
- .D EXPDISP^ECXUTL1
- .D AUDIT^ECXKILL
- W !
- S ECXPGM="PROCESS^ECXALAB",ECXDESC="LAB Extract Audit Report"
- S ECXSAVE("ECXHEAD")="",ECXSAVE("ECXALL")="",ECXSAVE("ECXACC(")="",ECXSAVE("ECXDIV(")="",ECXSAVE("ECXARRAY(")=""
- 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^ECXALAB
- I IO'=IO(0) D ^%ZISC
- D HOME^%ZIS
- D AUDIT^ECXKILL
- Q
- ;
- PROCESS ;process data in file #727.813
- N X,Y,JJ,LMIP,IEN,DATA,DATE,ACC,ACCNM,WKLDNM,WKLD,FILE,QQFLG,CNT
- K ^TMP($J,"ECXAUD")
- S (CNT,QQFLG)=0
- ;see if site is using lmip codes
- S LMIP=+$G(^ECX(728,1,"LMIP"))
- 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 acc. area array by name
- S ACC="" F S ACC=$O(ECXACC(ACC)) Q:ACC="" D
- .S ACCNM=$P(ECXACC(ACC),U,1),ACCAB=$P(ECXACC(ACC),U,2),ACC(ACCAB)=ACCNM_" ("_ACCAB_")"
- ;get records within date range and accession area
- S IEN="" F S IEN=$O(^ECX(727.813,"AC",ECXEXT,IEN)) Q:IEN="" D Q:QQFLG
- .S DATA=^ECX(727.813,IEN,0),DATE=$P(DATA,U,9),ACC=$P(DATA,U,11)
- .;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(ACC(ACC))
- .S ACCNM=$P(ACC(ACC),U,1)
- .S WKLD="",WKLD=$P(DATA,U,20) D
- ..S WKLDNM="" I WKLD]"" S X=WKLD,DIC="^LAM(",DIC(0)="MX" D ^DIC S WKLDNM=$P(Y,U,2)
- ..I WKLD="" S:LMIP=1 WKLD="Unknown" S:LMIP=0 WKLD="NA"
- ..I WKLDNM="" S WKLDNM="Unknown "_WKLD
- .S FILE=$P(DATA,U,18)
- .Q:((FILE'=2)&(FILE'=67))
- .I '$D(^TMP($J,"ECXAUD",ACCNM,WKLDNM)) S ^TMP($J,"ECXAUD",ACCNM,WKLDNM)=0_U_0_U_WKLD
- .I FILE=2 S $P(^(WKLDNM),U,1)=$P(^TMP($J,"ECXAUD",ACCNM,WKLDNM),U,1)+1,CNT=CNT+1
- .I FILE=67 S $P(^(WKLDNM),U,2)=$P(^TMP($J,"ECXAUD",ACCNM,WKLDNM),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 LAB audit report by accession area and test
- N SS,LN,PG,QFLG,TOTP,TOTR,GTOT,DIV,DIVNM,ACCAB,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)="",ACCAB="",DIV="",DIV=$O(ECXDIV(DIV)) I '$G(ECXPORT) D HEADER ;149
- F S ACCAB=$O(ACC(ACCAB)) Q:ACCAB="" D Q:QFLG
- .S ACCNM=ACC(ACCAB),GTOT("P")=0,GTOT("R")=0
- .;write the accession area name
- .I '$G(ECXPORT) D:($Y+3>IOSL) HEADER Q:QFLG W !,ACCNM ;149
- .I '$D(^TMP($J,"ECXAUD",ACCNM)) D Q
- ..I $G(ECXPORT) S ^TMP($J,"ECXPORT",RCNT)=ECXARRAY("EXTRACT")_U_$P(ECXDIV(DIV),U,2)_" ("_$P(ECXDIV(DIV),U,3)_")"_U_ACCNM_U_"No data available for this Accession Area",RCNT=RCNT+1 Q ;149
- ..W !,?3,"No data available for this Accession Area.",!!
- .I $D(^TMP($J,"ECXAUD",ACCNM)) S WKLDNM="" F S WKLDNM=$O(^TMP($J,"ECXAUD",ACCNM,WKLDNM)) Q:WKLDNM="" D Q:QFLG
- ..S TOTP=$P(^TMP($J,"ECXAUD",ACCNM,WKLDNM),U,1),TOTR=$P(^(WKLDNM),U,2),WKLD=$P(^(WKLDNM),U,3)
- ..S GTOT("P")=GTOT("P")+TOTP,GTOT("R")=GTOT("R")+TOTR
- ..;write the test data
- ..I $G(ECXPORT) S ^TMP($J,"ECXPORT",RCNT)=ECXARRAY("EXTRACT")_U_$P(ECXDIV(DIV),U,2)_" ("_$P(ECXDIV(DIV),U,3)_")"_U_ACCNM_U_WKLDNM_U_WKLD_U_TOTP_U_TOTR,RCNT=RCNT+1 Q ;149
- ..D:($Y+3>IOSL) HEADER Q:QFLG W !,?3,$E(WKLDNM,1,36),?40,WKLD,?56,$$RJ^XLFSTR(TOTP,5," "),?68,$$RJ^XLFSTR(TOTR,5," ")
- .;write the accession area grandtotal
- .I $G(ECXPORT) S ^TMP($J,"ECXPORT",RCNT)="^",RCNT=RCNT+1,^TMP($J,"ECXPORT",RCNT)="^^^Total For "_ACCNM_"^^"_GTOT("P")_U_GTOT("R"),RCNT=RCNT+1,^TMP($J,"ECXPORT",RCNT)="^",RCNT=RCNT+1 Q ;149
- .D:($Y+3>IOSL) HEADER Q:QFLG W !,?3,$E(LN,1,70)
- .D:($Y+3>IOSL) HEADER Q:QFLG W !,"Total for "_ACCNM_":",?56,$$RJ^XLFSTR(GTOT("P"),5," "),?68,$$RJ^XLFSTR(GTOT("R"),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" D
- .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 !,"DSS Site: "_$P(ECXDIV(DIV),U,2)_" ("_$P(ECXDIV(DIV),U,3)_")",?68,"Page: "_PG
- W !!,"Accession Area (Feeder Location)",?40,"LMIP",?56,"# of Tests",?68,"# of Tests"
- W !,?3,"Procedure",?40,"Code",?56,"(Patients)",?68,"(Referrals)"
- W !,LN,!
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXALAB 6630 printed Feb 18, 2025@23:18:21 Page 2
- ECXALAB ;ALB/JAP - ECS Extract Audit Report ;3/27/14 16:10
- +1 ;;3.0;DSS EXTRACTS;**1,8,149**;Dec 22, 1997;Build 27
- +2 ;
- EN ;entry point for LAB extract audit report
- +1 ;this audit report can be used for extracts done with
- +2 ;either ECXLABN or ECXLABO
- +3 ;149
- NEW %X,%Y,X,Y,DIC,DA,DR,DIQ,DIR,ECXPORT,RCNT
- +4 SET ECXERR=0
- +5 ;ecxaud=0 for 'extract' audit
- +6 SET ECXHEAD="LAB"
- SET ECXAUD=0
- +7 WRITE !!,"Setup for ",ECXHEAD," Extract Audit Report --",!!
- +8 ;select extract
- +9 DO AUDIT^ECXUTLA(ECXHEAD,.ECXERR,.ECXARRAY,ECXAUD)
- +10 if ECXERR
- QUIT
- +11 WRITE !!
- +12 ;get the dss site name for report header
- +13 SET ECXALL=1
- DO DEFAULT^ECXDVSN(.ECXDIV,ECXALL,.ECXERR)
- +14 if ECXERR=1
- QUIT
- +15 SET DIR(0)="Y"
- SET DIR("A")="Do you want the "_ECXHEAD_" extract audit report for all Accession Areas"
- +16 SET DIR("B")="NO"
- DO ^DIR
- KILL DIR
- +17 IF $GET(DIRUT)
- SET ECXERR=1
- QUIT
- +18 ;if y=0 i.e., 'no', then ecxall=0 i.e., 'selected'
- +19 SET ECXALL=Y
- +20 IF ECXERR=1
- Begin DoDot:1
- +21 WRITE !!,?5,"Try again later... exiting.",!
- +22 DO AUDIT^ECXKILL
- End DoDot:1
- QUIT
- +23 ;select accession areas; all accession areas if ecxall=1
- +24 SET X=ECXARRAY("START")
- DO ^%DT
- SET ECXSTART=Y
- SET X=ECXARRAY("END")
- DO ^%DT
- SET ECXEND=Y
- +25 DO LAB^ECXDVSN1(.ECXACC,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 ;149 Section added
- SET ECXPORT=$$EXPORT^ECXUTL1
- if ECXPORT=-1
- QUIT
- IF $GET(ECXPORT)
- Begin DoDot:1
- +31 KILL ^TMP($JOB,"ECXPORT")
- +32 SET ^TMP($JOB,"ECXPORT",0)="EXTRACT LOG #^DSS SITE^ACCESSION AREA (FEEDER LOCATION)^PROCEDURE^LMIP CODE^# OF TESTS (PATIENTS)^# OF TESTS (REFERRALS)"
- SET RCNT=1
- +33 DO PROCESS
- +34 DO EXPDISP^ECXUTL1
- +35 DO AUDIT^ECXKILL
- End DoDot:1
- QUIT
- +36 WRITE !
- +37 SET ECXPGM="PROCESS^ECXALAB"
- SET ECXDESC="LAB Extract Audit Report"
- +38 SET ECXSAVE("ECXHEAD")=""
- SET ECXSAVE("ECXALL")=""
- SET ECXSAVE("ECXACC(")=""
- SET ECXSAVE("ECXDIV(")=""
- SET ECXSAVE("ECXARRAY(")=""
- +39 WRITE !
- +40 DO DEVICE^ECXUTLA(ECXPGM,ECXDESC,.ECXSAVE)
- +41 IF ECXSAVE("POP")=1
- Begin DoDot:1
- +42 WRITE !!,?5,"Try again later... exiting.",!
- +43 DO AUDIT^ECXKILL
- End DoDot:1
- QUIT
- +44 IF ECXSAVE("ZTSK")=0
- Begin DoDot:1
- +45 KILL ECXSAVE,ECXPGM,ECXDESC
- +46 DO PROCESS^ECXALAB
- End DoDot:1
- +47 IF IO'=IO(0)
- DO ^%ZISC
- +48 DO HOME^%ZIS
- +49 DO AUDIT^ECXKILL
- +50 QUIT
- +51 ;
- PROCESS ;process data in file #727.813
- +1 NEW X,Y,JJ,LMIP,IEN,DATA,DATE,ACC,ACCNM,WKLDNM,WKLD,FILE,QQFLG,CNT
- +2 KILL ^TMP($JOB,"ECXAUD")
- +3 SET (CNT,QQFLG)=0
- +4 ;see if site is using lmip codes
- +5 SET LMIP=+$GET(^ECX(728,1,"LMIP"))
- +6 SET ECXEXT=ECXARRAY("EXTRACT")
- SET ECXDEF=ECXARRAY("DEF")
- +7 SET X=ECXARRAY("START")
- DO ^%DT
- SET ECXSTART=Y
- SET X=ECXARRAY("END")
- DO ^%DT
- SET ECXEND=Y
- +8 ;get run date in external format
- +9 DO NOW^%DTC
- SET Y=$EXTRACT(%,1,12)
- DO DD^%DT
- SET ECXRUN=Y
- +10 ;setup acc. area array by name
- +11 SET ACC=""
- FOR
- SET ACC=$ORDER(ECXACC(ACC))
- if ACC=""
- QUIT
- Begin DoDot:1
- +12 SET ACCNM=$PIECE(ECXACC(ACC),U,1)
- SET ACCAB=$PIECE(ECXACC(ACC),U,2)
- SET ACC(ACCAB)=ACCNM_" ("_ACCAB_")"
- End DoDot:1
- +13 ;get records within date range and accession area
- +14 SET IEN=""
- FOR
- SET IEN=$ORDER(^ECX(727.813,"AC",ECXEXT,IEN))
- if IEN=""
- QUIT
- Begin DoDot:1
- +15 SET DATA=^ECX(727.813,IEN,0)
- SET DATE=$PIECE(DATA,U,9)
- SET ACC=$PIECE(DATA,U,11)
- +16 ;convert free text date to fm internal format date
- +17 SET $EXTRACT(DATE,1,2)=$EXTRACT(DATE,1,2)-17
- +18 if $LENGTH(DATE)<7
- QUIT
- if (DATE<ECXSTART)
- QUIT
- if (DATE>ECXEND)
- QUIT
- +19 if '$DATA(ACC(ACC))
- QUIT
- +20 SET ACCNM=$PIECE(ACC(ACC),U,1)
- +21 SET WKLD=""
- SET WKLD=$PIECE(DATA,U,20)
- Begin DoDot:2
- +22 SET WKLDNM=""
- IF WKLD]""
- SET X=WKLD
- SET DIC="^LAM("
- SET DIC(0)="MX"
- DO ^DIC
- SET WKLDNM=$PIECE(Y,U,2)
- +23 IF WKLD=""
- if LMIP=1
- SET WKLD="Unknown"
- if LMIP=0
- SET WKLD="NA"
- +24 IF WKLDNM=""
- SET WKLDNM="Unknown "_WKLD
- End DoDot:2
- +25 SET FILE=$PIECE(DATA,U,18)
- +26 if ((FILE'=2)&(FILE'=67))
- QUIT
- +27 IF '$DATA(^TMP($JOB,"ECXAUD",ACCNM,WKLDNM))
- SET ^TMP($JOB,"ECXAUD",ACCNM,WKLDNM)=0_U_0_U_WKLD
- +28 IF FILE=2
- SET $PIECE(^(WKLDNM),U,1)=$PIECE(^TMP($JOB,"ECXAUD",ACCNM,WKLDNM),U,1)+1
- SET CNT=CNT+1
- +29 IF FILE=67
- SET $PIECE(^(WKLDNM),U,2)=$PIECE(^TMP($JOB,"ECXAUD",ACCNM,WKLDNM),U,2)+1
- SET CNT=CNT+1
- +30 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
- +31 ;print the report
- +32 DO PRINT
- +33 ;149
- IF $GET(ECXPORT)
- QUIT
- +34 DO AUDIT^ECXKILL
- +35 QUIT
- +36 ;
- PRINT ;print the LAB audit report by accession area and test
- +1 NEW SS,LN,PG,QFLG,TOTP,TOTR,GTOT,DIV,DIVNM,ACCAB,DIR,DR,DIRUT,DTOUT,DUOUT
- +2 USE IO
- +3 IF $DATA(ZTQUEUED)
- IF $$S^%ZTLOAD
- SET ZTSTOP=1
- KILL ZTREQ
- QUIT
- +4 ;149
- SET (QFLG,PG)=0
- SET $PIECE(LN,"-",80)=""
- SET ACCAB=""
- SET DIV=""
- SET DIV=$ORDER(ECXDIV(DIV))
- IF '$GET(ECXPORT)
- DO HEADER
- +5 FOR
- SET ACCAB=$ORDER(ACC(ACCAB))
- if ACCAB=""
- QUIT
- Begin DoDot:1
- +6 SET ACCNM=ACC(ACCAB)
- SET GTOT("P")=0
- SET GTOT("R")=0
- +7 ;write the accession area name
- +8 ;149
- IF '$GET(ECXPORT)
- if ($Y+3>IOSL)
- DO HEADER
- if QFLG
- QUIT
- WRITE !,ACCNM
- +9 IF '$DATA(^TMP($JOB,"ECXAUD",ACCNM))
- Begin DoDot:2
- +10 ;149
- IF $GET(ECXPORT)
- SET ^TMP($JOB,"ECXPORT",RCNT)=ECXARRAY("EXTRACT")_U_$PIECE(ECXDIV(DIV),U,2)_" ("_$PIECE(ECXDIV(DIV),U,3)_")"_U_ACCNM_U_"No data available for this Accession Area"
- SET RCNT=RCNT+1
- QUIT
- +11 WRITE !,?3,"No data available for this Accession Area.",!!
- End DoDot:2
- QUIT
- +12 IF $DATA(^TMP($JOB,"ECXAUD",ACCNM))
- SET WKLDNM=""
- FOR
- SET WKLDNM=$ORDER(^TMP($JOB,"ECXAUD",ACCNM,WKLDNM))
- if WKLDNM=""
- QUIT
- Begin DoDot:2
- +13 SET TOTP=$PIECE(^TMP($JOB,"ECXAUD",ACCNM,WKLDNM),U,1)
- SET TOTR=$PIECE(^(WKLDNM),U,2)
- SET WKLD=$PIECE(^(WKLDNM),U,3)
- +14 SET GTOT("P")=GTOT("P")+TOTP
- SET GTOT("R")=GTOT("R")+TOTR
- +15 ;write the test data
- +16 ;149
- IF $GET(ECXPORT)
- SET ^TMP($JOB,"ECXPORT",RCNT)=ECXARRAY("EXTRACT")_U_$PIECE(ECXDIV(DIV),U,2)_" ("_$PIECE(ECXDIV(DIV),U,3)_")"_U_ACCNM_U_WKLDNM_U_WKLD_U_TOTP_U_TOTR
- SET RCNT=RCNT+1
- QUIT
- +17 if ($Y+3>IOSL)
- DO HEADER
- if QFLG
- QUIT
- WRITE !,?3,$EXTRACT(WKLDNM,1,36),?40,WKLD,?56,$$RJ^XLFSTR(TOTP,5," "),?68,$$RJ^XLFSTR(TOTR,5," ")
- End DoDot:2
- if QFLG
- QUIT
- +18 ;write the accession area grandtotal
- +19 ;149
- IF $GET(ECXPORT)
- SET ^TMP($JOB,"ECXPORT",RCNT)="^"
- SET RCNT=RCNT+1
- SET ^TMP($JOB,"ECXPORT",RCNT)="^^^Total For "_ACCNM_"^^"_GTOT("P")_U_GTOT("R")
- SET RCNT=RCNT+1
- SET ^TMP($JOB,"ECXPORT",RCNT)="^"
- SET RCNT=RCNT+1
- QUIT
- +20 if ($Y+3>IOSL)
- DO HEADER
- if QFLG
- QUIT
- WRITE !,?3,$EXTRACT(LN,1,70)
- +21 if ($Y+3>IOSL)
- DO HEADER
- if QFLG
- QUIT
- WRITE !,"Total for "_ACCNM_":",?56,$$RJ^XLFSTR(GTOT("P"),5," "),?68,$$RJ^XLFSTR(GTOT("R"),5," "),!!
- End DoDot:1
- if QFLG
- QUIT
- +22 ;print the audit descriptive narrative
- +23 ;149
- IF $GET(ECXPORT)
- QUIT
- +24 IF $EXTRACT(IOST)'="C"
- Begin DoDot:1
- +25 WRITE @IOF
- SET PG=PG+1
- +26 WRITE !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report"
- +27 WRITE !,"DSS Extract Log #: "_ECXEXT
- +28 WRITE !,"Date Range of Audit: "_ECXARRAY("START")_" to "_ECXARRAY("END")
- +29 WRITE !,"Report Run Date/Time: "_ECXRUN,?68,"Page: ",PG
- +30 WRITE !!,LN,!!
- +31 SET DIC="^ECX(727.1,"
- SET DA=ECXARRAY("DEF")
- SET DR="1"
- DO EN^DIQ
- End DoDot:1
- +32 IF $EXTRACT(IOST)="C"
- IF 'QFLG
- Begin DoDot:1
- +33 SET SS=22-$Y
- FOR JJ=1:1:SS
- WRITE !
- +34 SET DIR(0)="E"
- WRITE !
- DO ^DIR
- KILL DIR
- End DoDot:1
- +35 QUIT
- +36 ;
- +1 NEW JJ,SS
- +2 IF $EXTRACT(IOST)="C"
- 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 !,"DSS Site: "_$PIECE(ECXDIV(DIV),U,2)_" ("_$PIECE(ECXDIV(DIV),U,3)_")",?68,"Page: "_PG
- +12 WRITE !!,"Accession Area (Feeder Location)",?40,"LMIP",?56,"# of Tests",?68,"# of Tests"
- +13 WRITE !,?3,"Procedure",?40,"Code",?56,"(Patients)",?68,"(Referrals)"
- +14 WRITE !,LN,!
- +15 QUIT