Routine: ECXLBBC

ECXLBBC ;ALB/MRY - LBB Extract Audit Comparative Report ;2/5/15  15:25

 ;;3.0;DSS EXTRACTS;**120,149,153,154**;Dec 22, 1997;Build 13

EN ;entry point for LBB extract audit comparative report

 N ECSD,ECED,ECSDN,ECEDN,ECXPORT,CNT ;154

 D SETUP^ECXLBB1 I ECFILE="" Q  ;149

 N %X,%Y,%DT,X,Y,DIC,DA,DR,DIQ,DIR,DIRUT,DTOUT,DUOUT,SCRNARR,REPORT

 N SCRNARR,ECXERR,ECXHEAD,ECXAUD,ECXARRAY,STATUS,FLAG,ECXALL,TMP

 N ZTQUEUED,ZTSTOP

 S SCRNARR="^TMP(""ECX"",$J,""SCRNARR"")"

 K @SCRNARR@("DIVISION")

 S (ECXERR,FLAG)=0

 ;ecxaud=0 for 'extract' audit

 S ECXHEAD="LBB",ECXAUD=0

 W !!,"Setup for ",ECXHEAD," Extract Comparative Report --",!!

 ;select extract

 D AUDIT^ECXUTLA(ECXHEAD,.ECXERR,.ECXARRAY,ECXAUD)

 Q:ECXERR

 W !!

 ;select divisions/sites; all divisions if ecxall=1

 ;**not in ECXPLBB report, so leaving multi-divisions out.

 ;S ECXERR=$$NUT^ECXDVSN()

 ;I ECXERR=1 D  Q

 ;.W !!,?5,"Try again later... exiting.",!

 ;.K @SCRNARR@("DIVISION")

 ;.D AUDIT^ECXKILL

 S:'$D(ECINST) ECINST=+$P(^ECX(728,1,0),U)

 S ECXINST=ECINST

 K ECXDIC S DA=ECINST,DIC="^DIC(4,",DIQ(0)="I",DIQ="ECXDIC",DR=".01;99"

 D EN^DIQ1 S ECINST=$G(ECXDIC(4,DA,99,"I")) K DIC,DIQ,DA,DR,ECXDIC

 ;sort by COMP

 S DIR(0)="Y",DIR("A")="Do you want the "_ECXHEAD_" extract comparative report to sort by COMP"

 S DIR("B")="NO" D ^DIR K DIR

 I $G(DIRUT) S ECXERR=1 Q

 ;if y=0 i.e., 'no', then ecxcomp=0 i.e., 'selected'

 S ECXCFLG=Y

 I ECXERR=1 D  Q

 .W !!,?5,"Try again later... exiting.",!

 .D AUDIT^ECXKILL

W !

 Q:(ECXARRAY("END")']"")&(ECXARRAY("START")']"")

 S ECXPORT=$$EXPORT^ECXUTL1 Q:ECXPORT=-1  I $G(ECXPORT) D  Q  ;154 Section added for exporting report

 .S X=ECXARRAY("START") D ^%DT S ECSD=Y S X=ECXARRAY("END") D ^%DT S ECED=Y S ECSD1=ECSD=-1

 .K ^TMP($J,"ECXPORT")

 .S ^TMP($J,"ECXPORT",0)="LOCAL NAME^LOCAL SSN^LOCAL FDR LOC^LOCAL TRANSF DATE^LOCAL COMP^LOCAL NUMBER OF UNITS^LBB EXTRACT LOG NUMBER^LBB EXTRACT SSN^LBB EXTRACT TRANSF DATE^LBB EXTRACT COMP^LBB EXTRACT NUMBER OF UNITS",CNT=1

 .D START

 .D EXPDISP^ECXUTL1

 .D ^ECXKILL

 N ECXPOP S ECXPOP=0 D QUE Q:ECXPOP=1

START ; entry point from tasked job

 ; get LAB DATA and build temporary global ^TMP("ECXLBB",$J)

 N ECXLOGIC,ECXRPT,ECXCRPT,ECXJOB

 S ECXJOB=$J

 K ^TMP("ECXLBBC",ECXJOB)

 U IO

 I '$G(ECXPORT) I $E(IOST,1,2)="C-" W !,"Retrieving records... " ;154

 S (ECXRPT,ECXCRPT)=1 D AUDRPT^ECXLBB1 ;149 build source tmp

 D EXTRACT ;build extract tmp

OUTPUT ; entry point called by EN tag

 N ECDATE,ECXTOT,ECXSTOT,ECXSTRX,ECXSTRS,ECRDT,ECQUIT,ECPG,ECLINE,ECLINE1,ECXCLAST

 I '$D(^TMP("ECXLBBC",ECXJOB)) W:'$G(ECXPORT) !,"There were no records that met the date range criteria" Q  ;154

 S (ECPG,ECDATE,ECQUIT,ECXCOMP,ECXTOT,ECXSTOT)=0

 S ECXCOMP("TOTAL","S")=0,ECXCOMP("TOTAL","X")=0,ECXCLAST=0

 S ECLINE="",$P(ECLINE,"=",132)="=",ECLINE1="",$P(ECLINE1,"-",132)="-"

 S ECSDN=$$FMTE^XLFDT(ECSD,9),ECEDN=$$FMTE^XLFDT(ECED,9),ECRDT=$$FMTE^XLFDT(DT,9)

 I '$G(ECXPORT) W:$E(IOST,1,2)="C-" @IOF D HED ;154

 S ECXCOMP=0 F  S ECXCOMP=$O(^TMP("ECXLBBC",ECXJOB,ECXCOMP)) D  Q:ECXCOMP=""  Q:ECQUIT

 . I ECXCFLG,ECXCLAST'=0,ECXCOMP="" S ECXSTOT=1 D TOTAL S ECXSTOT=0 Q

 . Q:ECXCOMP=""

 . I ECXCFLG,ECXCLAST'=0,ECXCLAST'=ECXCOMP S ECXSTOT=1 D TOTAL S ECXSTOT=0

 . S ECXCLAST=ECXCOMP

 . S ECXCOMP(ECXCOMP,"S")=0,ECXCOMP(ECXCOMP,"X")=0

 . S ECXDFN=0 F  S ECXDFN=$O(^TMP("ECXLBBC",ECXJOB,ECXCOMP,ECXDFN)) Q:'ECXDFN  D  Q:ECQUIT

 .. S ECDATE=0 F  S ECDATE=$O(^TMP("ECXLBBC",ECXJOB,ECXCOMP,ECXDFN,ECDATE))  Q:'ECDATE  D  Q:ECQUIT

 ... S ECXSTRS=$G(^TMP("ECXLBBC",ECXJOB,ECXCOMP,ECXDFN,ECDATE,"S"))

 ... S ECXSTRX=$G(^TMP("ECXLBBC",ECXJOB,ECXCOMP,ECXDFN,ECDATE,"X"))

 ... I ECXSTRS'="" D

 .... S ECXCOMP(ECXCOMP,"S")=ECXCOMP(ECXCOMP,"S")+(+$P(ECXSTRS,"^",12))

 .... S ECXCOMP("TOTAL","S")=ECXCOMP("TOTAL","S")+(+$P(ECXSTRS,"^",12))

 ... I ECXSTRX'="" D

 .... S ECXCOMP(ECXCOMP,"X")=ECXCOMP(ECXCOMP,"X")+(+$P(ECXSTRX,"^",12))

 .... S ECXCOMP("TOTAL","X")=ECXCOMP("TOTAL","X")+(+$P(ECXSTRX,"^",12))

 ... D PRINT

 S ECXTOT=1 D TOTAL S ECXTOT=0

 I $G(ECXPORT) Q  ;154

 D ^ECXKILL

PRINT ;

 I $G(ECXPORT) D  Q  ;154 Section added for exporting report

 .S ^TMP($J,"ECXPORT",CNT)=$S(ECXSTRS="":"NO DATA^^^^^",1:$P(ECXSTRS,U,5)_U_$P(ECXSTRS,U,4)_U_$P(ECXSTRS,U,16)_U_$$FMTE^XLFDT($$HL7TFM^XLFDT($P(ECXSTRS,U,8)),2)_U_$P(ECXSTRS,U,11)_U_+$P(ECXSTRS,U,12))

 .S ^TMP($J,"ECXPORT",CNT)=^TMP($J,"ECXPORT",CNT)_U_$S(ECXSTRX="":"NO DATA",1:ECXARRAY("EXTRACT")_U_$P(ECXSTRX,U,4)_U_$$FMTE^XLFDT($$HL7TFM^XLFDT($P(ECXSTRX,U,8)),2)_U_$P(ECXSTRX,U,11)_U_+$P(ECXSTRX,U,12)),CNT=CNT+1

 I $Y+5>IOSL D  Q:ECQUIT

 . I $E(IOST,1,2)["C-" S DIR(0)="E" D ^DIR K DIR I 'Y S ECQUIT=1 Q

 . W @IOF D HED

 I ECXSTRS="" W !?3,"***************N*O***D*A*T*A*****************"

 I ECXSTRS'="" D

 . W !,$P(ECXSTRS,"^",5),?11,$P(ECXSTRS,"^",4),?26,$P(ECXSTRS,"^",16)

 . W ?37,$$FMTE^XLFDT($$HL7TFM^XLFDT($P(ECXSTRS,"^",8)),2)

 . W ?49,$P(ECXSTRS,"^",11),?60,$J(+$P(ECXSTRS,"^",12),2)

 I ECXSTRX="" W ?83,"*******N*O***D*A*T*A*********"

 I ECXSTRX'="" D

 . W ?80,$P(ECXSTRX,"^",4)

 . W ?92,$$FMTE^XLFDT($$HL7TFM^XLFDT($P(ECXSTRX,"^",8)),2)

 . W ?102,$P(ECXSTRX,"^",11),?113,$J(+$P(ECXSTRX,"^",12),2)

TOTAL ;

 ;I $Y+3>IOSL D  Q:ECQUIT

 ;. I $E(IOST,1,2)["C-" S DIR(0)="E" D ^DIR K DIR I 'Y S ECQUIT=1 Q

 ;. W @IOF D HED

 I $G(ECXPORT) D  Q  ;154 Section added for exporting report

 .I $G(ECXSTOT)!($G(ECXTOT)&('ECXCFLG)) S ^TMP($J,"ECXPORT",CNT)="^",CNT=CNT+1

 .S ^TMP($J,"ECXPORT",CNT)=$S($G(ECXSTOT):"^^^^"_ECXCLAST_" TOTAL^"_+$G(ECXCOMP(ECXCLAST,"S"))_"^^^^"_ECXCLAST_" TOTAL^"_+$G(ECXCOMP(ECXCLAST,"X")),1:"TOTAL^^^^^"_+$G(ECXCOMP("TOTAL","S"))_"^^^^^"_+$G(ECXCOMP("TOTAL","X"))),CNT=CNT+1

 .I $G(ECXSTOT) S ^TMP($J,"ECXPORT",CNT)="^",CNT=CNT+1

 W !,ECLINE1

 I $G(ECXSTOT) W !,?47,$J(ECXCLAST_" TOTAL",12),?60,$J(+$G(ECXCOMP(ECXCLAST,"S")),4),?100,$J(ECXCLAST_" TOTAL",12),?113,$J(+$G(ECXCOMP(ECXCLAST,"X")),4)

 I $G(ECXTOT) W !,"TOTAL",?60,$J(+$G(ECXCOMP("TOTAL","S")),4),?113,$J(+$G(ECXCOMP("TOTAL","X")),4)

HED ;

 S ECPG=ECPG+1

 W !,"LBB Extract Comparative Report",?124,"Page",$J(ECPG,3)

 W !,ECSDN," - ",ECEDN,?111,"Run Date:",$J(ECRDT,12)

 W !!,"------------------ LOCAL BLOOD BANK SOURCE ----------------------"

 W ?80,"------------- LBB EXTRACT (#"_ECXARRAY("EXTRACT")_") ---------------"

 W !,?37,"Transf",?57,"Number",?92,"Transf",?113,"Number"

 W !,"Name",?14,"SSN",?25,"FDR LOC",?37,"Date",?49,"COMP",?57,"of Units",?80,"SSN",?92,"Date",?102,"COMP",?113,"of Units"

 W !,ECLINE

QUE ;

 ;determine output device and queue if requested

 N %,X,%DT

 S X=ECXARRAY("START") D ^%DT S ECSD=Y S X=ECXARRAY("END") D ^%DT S ECED=Y

 S ECSDN=$$FMTE^XLFDT(ECSD),ECEDN=$$FMTE^XLFDT(ECED),ECSD1=ECSD-.1

 F X="ECINST","ECED","ECSD","ECSD1","ECEDN","ECSDN" S ECXSAVE(X)=""

 F X="ECPACK","ECPIECE","ECRTN","ECGRP","ECNODE" S ECXSAVE(X)=""

 F X="ECFILE","ECHEAD","ECVER","ECINST","ECXINST","ECXCFLG" S ECXSAVE(X)=""

 ;S ECXSAVE("ECXDIV(")=""

 S ECXSAVE("ECXARRAY(")="",ECXSAVE("SCRNARR")="",TMP=$$OREF^DILF(SCRNARR),ECXSAVE(TMP)=""

 S ECXPGM="START^ECXLBBC",ECXDESC="LBB Extract Audit Comparative Report"

 W !!,"This report requires a print width of 132 characters.",!!

 D DEVICE^ECXUTLA(ECXPGM,ECXDESC,.ECXSAVE)

 I ECXSAVE("POP")=1 D  S ECXPOP=1 Q

 .W !!,?5,"Try again later... exiting.",!

 .K @SCRNARR@("DIVISION")

 .D AUDIT^ECXKILL

 I ECXSAVE("ZTSK")=0 D

 .K ECXSAVE,ECXPGM,ECXDESC

 .D START^ECXLBBC

 I IO'=IO(0) D ^%ZISC

 D HOME^%ZIS S ECXPOP=1

 D AUDIT^ECXKILL

EXTRACT ;build extract tmp

 N ECXEXT,IEN,NODE0,ECXDFN,ECXTDT,ECXTTM,ECXCOMP

 S ECXEXT=ECXARRAY("EXTRACT")

 S IEN=0 F  S IEN=$O(^ECX(727.829,"AC",ECXEXT,IEN)) Q:IEN=""  D

 . S NODE0=$G(^ECX(727.829,IEN,0)),ECXDFN=$P(NODE0,"^",5)

 . S ECXTDT=$P(NODE0,"^",10)

 . I ($E(ECXTDT,1)+1_$E(ECXTDT,3,8))>ECED Q

 . I ($E(ECXTDT,1)+1_$E(ECXTDT,3,8))<ECSD Q

 . S ECXTTM=$P(NODE0,"^",11),ECXCOMP=$P(NODE0,"^",13)

 . N ECCOUNT S ECCOUNT=0

 . F  S ECCOUNT=ECCOUNT+1 Q:'$D(^TMP("ECXLBBC",$J,$S($G(ECXCFLG)=1:ECXCOMP,1:"ZZNOZZ"),ECXDFN,ECXTDT_"."_ECXTTM_"."_ECCOUNT,"X"))

 . S ^TMP("ECXLBBC",$J,$S($G(ECXCFLG)=1:ECXCOMP,1:"ZZNOZZ"),ECXDFN,ECXTDT_"."_ECXTTM_"."_ECCOUNT,"X")="^"_$P(NODE0,"^",4,99)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXLBBC   8211     printed  Mar 13, 2025@20:57:37                                                                                                                                                                                                     Page 2

ECXLBBC   ;ALB/MRY - LBB Extract Audit Comparative Report ;2/5/15  15:25

 +1       ;;3.0;DSS EXTRACTS;**120,149,153,154**;Dec 22, 1997;Build 13

 +2       ;

EN        ;entry point for LBB extract audit comparative report

 +1       ;154

           NEW ECSD,ECED,ECSDN,ECEDN,ECXPORT,CNT

 +2       ;149

           DO SETUP^ECXLBB1

           IF ECFILE=""

               QUIT

 +3        NEW %X,%Y,%DT,X,Y,DIC,DA,DR,DIQ,DIR,DIRUT,DTOUT,DUOUT,SCRNARR,REPORT

 +4        NEW SCRNARR,ECXERR,ECXHEAD,ECXAUD,ECXARRAY,STATUS,FLAG,ECXALL,TMP

 +5        NEW ZTQUEUED,ZTSTOP

 +6        SET SCRNARR="^TMP(""ECX"",$J,""SCRNARR"")"

 +7        KILL @SCRNARR@("DIVISION")

 +8        SET (ECXERR,FLAG)=0

 +9       ;ecxaud=0 for 'extract' audit

 +10       SET ECXHEAD="LBB"

           SET ECXAUD=0

 +11       WRITE !!,"Setup for ",ECXHEAD," Extract Comparative Report --",!!

 +12      ;select extract

 +13       DO AUDIT^ECXUTLA(ECXHEAD,.ECXERR,.ECXARRAY,ECXAUD)

 +14       if ECXERR

               QUIT

 +15       WRITE !!

 +16      ;select divisions/sites; all divisions if ecxall=1

 +17      ;**not in ECXPLBB report, so leaving multi-divisions out.

 +18      ;S ECXERR=$$NUT^ECXDVSN()

 +19      ;I ECXERR=1 D  Q

 +20      ;.W !!,?5,"Try again later... exiting.",!

 +21      ;.K @SCRNARR@("DIVISION")

 +22      ;.D AUDIT^ECXKILL

 +23       if '$DATA(ECINST)

               SET ECINST=+$PIECE(^ECX(728,1,0),U)

 +24       SET ECXINST=ECINST

 +25       KILL ECXDIC

           SET DA=ECINST

           SET DIC="^DIC(4,"

           SET DIQ(0)="I"

           SET DIQ="ECXDIC"

           SET DR=".01;99"

 +26       DO EN^DIQ1

           SET ECINST=$GET(ECXDIC(4,DA,99,"I"))

           KILL DIC,DIQ,DA,DR,ECXDIC

 +27      ;sort by COMP

 +28       SET DIR(0)="Y"

           SET DIR("A")="Do you want the "_ECXHEAD_" extract comparative report to sort by COMP"

 +29       SET DIR("B")="NO"

           DO ^DIR

           KILL DIR

 +30       IF $GET(DIRUT)

               SET ECXERR=1

               QUIT

 +31      ;if y=0 i.e., 'no', then ecxcomp=0 i.e., 'selected'

 +32       SET ECXCFLG=Y

 +33       IF ECXERR=1

               Begin DoDot:1

 +34               WRITE !!,?5,"Try again later... exiting.",!

 +35               DO AUDIT^ECXKILL

               End DoDot:1

               QUIT

 +36       WRITE !

 +37       if (ECXARRAY("END")']"")&(ECXARRAY("START")']"")

               QUIT

 +38      ;154 Section added for exporting report

           SET ECXPORT=$$EXPORT^ECXUTL1

           if ECXPORT=-1

               QUIT

           IF $GET(ECXPORT)

               Begin DoDot:1

 +39               SET X=ECXARRAY("START")

                   DO ^%DT

                   SET ECSD=Y

                   SET X=ECXARRAY("END")

                   DO ^%DT

                   SET ECED=Y

                   SET ECSD1=ECSD=-1

 +40               KILL ^TMP($JOB,"ECXPORT")

 +41               SET ^TMP($JOB,"ECXPORT",0)="LOCAL NAME^LOCAL SSN^LOCAL FDR LOC^LOCAL TRANSF DATE^LOCAL COMP^LOCAL NUMBER OF UNITS^LBB EXTRACT LOG NUMBER^LBB EXTRACT SSN^LBB EXTRACT TRANSF DATE^LBB EXTRACT COMP^LBB EXTRACT NUMBER OF UNITS"

                   SET CNT=1

 +42               DO START

 +43               DO EXPDISP^ECXUTL1

 +44               DO ^ECXKILL

               End DoDot:1

               QUIT

 +45       NEW ECXPOP

           SET ECXPOP=0

           DO QUE

           if ECXPOP=1

               QUIT

 +46      ;

START     ; entry point from tasked job

 +1       ; get LAB DATA and build temporary global ^TMP("ECXLBB",$J)

 +2        NEW ECXLOGIC,ECXRPT,ECXCRPT,ECXJOB

 +3        SET ECXJOB=$JOB

 +4        KILL ^TMP("ECXLBBC",ECXJOB)

 +5        USE IO

 +6       ;154

           IF '$GET(ECXPORT)

               IF $EXTRACT(IOST,1,2)="C-"

                   WRITE !,"Retrieving records... "

 +7       ;149 build source tmp

           SET (ECXRPT,ECXCRPT)=1

           DO AUDRPT^ECXLBB1

 +8       ;build extract tmp

           DO EXTRACT

 +9       ;

OUTPUT    ; entry point called by EN tag

 +1        NEW ECDATE,ECXTOT,ECXSTOT,ECXSTRX,ECXSTRS,ECRDT,ECQUIT,ECPG,ECLINE,ECLINE1,ECXCLAST

 +2       ;154

           IF '$DATA(^TMP("ECXLBBC",ECXJOB))

               if '$GET(ECXPORT)

                   WRITE !,"There were no records that met the date range criteria"

               QUIT

 +3        SET (ECPG,ECDATE,ECQUIT,ECXCOMP,ECXTOT,ECXSTOT)=0

 +4        SET ECXCOMP("TOTAL","S")=0

           SET ECXCOMP("TOTAL","X")=0

           SET ECXCLAST=0

 +5        SET ECLINE=""

           SET $PIECE(ECLINE,"=",132)="="

           SET ECLINE1=""

           SET $PIECE(ECLINE1,"-",132)="-"

 +6        SET ECSDN=$$FMTE^XLFDT(ECSD,9)

           SET ECEDN=$$FMTE^XLFDT(ECED,9)

           SET ECRDT=$$FMTE^XLFDT(DT,9)

 +7       ;154

           IF '$GET(ECXPORT)

               if $EXTRACT(IOST,1,2)="C-"

                   WRITE @IOF

               DO HED

 +8        SET ECXCOMP=0

FOR

               SET ECXCOMP=$ORDER(^TMP("ECXLBBC",ECXJOB,ECXCOMP))

               Begin DoDot:1

 +9                IF ECXCFLG

                       IF ECXCLAST'=0

                           IF ECXCOMP=""

                               SET ECXSTOT=1

                               DO TOTAL

                               SET ECXSTOT=0

                               QUIT

 +10               if ECXCOMP=""

                       QUIT

 +11               IF ECXCFLG

                       IF ECXCLAST'=0

                           IF ECXCLAST'=ECXCOMP

                               SET ECXSTOT=1

                               DO TOTAL

                               SET ECXSTOT=0

 +12               SET ECXCLAST=ECXCOMP

 +13               SET ECXCOMP(ECXCOMP,"S")=0

                   SET ECXCOMP(ECXCOMP,"X")=0

 +14               SET ECXDFN=0

FOR

                       SET ECXDFN=$ORDER(^TMP("ECXLBBC",ECXJOB,ECXCOMP,ECXDFN))

                       if 'ECXDFN

                           QUIT

                       Begin DoDot:2

 +15                       SET ECDATE=0

FOR

                               SET ECDATE=$ORDER(^TMP("ECXLBBC",ECXJOB,ECXCOMP,ECXDFN,ECDATE))

                               if 'ECDATE

                                   QUIT

                               Begin DoDot:3

 +16                               SET ECXSTRS=$GET(^TMP("ECXLBBC",ECXJOB,ECXCOMP,ECXDFN,ECDATE,"S"))

 +17                               SET ECXSTRX=$GET(^TMP("ECXLBBC",ECXJOB,ECXCOMP,ECXDFN,ECDATE,"X"))

 +18                               IF ECXSTRS'=""

                                       Begin DoDot:4

 +19                                       SET ECXCOMP(ECXCOMP,"S")=ECXCOMP(ECXCOMP,"S")+(+$PIECE(ECXSTRS,"^",12))

 +20                                       SET ECXCOMP("TOTAL","S")=ECXCOMP("TOTAL","S")+(+$PIECE(ECXSTRS,"^",12))

                                       End DoDot:4

 +21                               IF ECXSTRX'=""

                                       Begin DoDot:4

 +22                                       SET ECXCOMP(ECXCOMP,"X")=ECXCOMP(ECXCOMP,"X")+(+$PIECE(ECXSTRX,"^",12))

 +23                                       SET ECXCOMP("TOTAL","X")=ECXCOMP("TOTAL","X")+(+$PIECE(ECXSTRX,"^",12))

                                       End DoDot:4

 +24                               DO PRINT

                               End DoDot:3

                               if ECQUIT

                                   QUIT

                       End DoDot:2

                       if ECQUIT

                           QUIT

               End DoDot:1

               if ECXCOMP=""

                   QUIT

               if ECQUIT

                   QUIT

 +25       SET ECXTOT=1

           DO TOTAL

           SET ECXTOT=0

 +26      ;154

           IF $GET(ECXPORT)

               QUIT

 +27       DO ^ECXKILL

 +28       QUIT

 +29      ;

PRINT     ;

 +1       ;154 Section added for exporting report

           IF $GET(ECXPORT)

               Begin DoDot:1

 +2                SET ^TMP($JOB,"ECXPORT",CNT)=$SELECT(ECXSTRS="":"NO DATA^^^^^",1:$PIECE(ECXSTRS,U,5)_U_$PIECE(ECXSTRS,U,4)_U_$PIECE(ECXSTRS,U,16)_U_$$FMTE^XLFDT($$HL7TFM^XLFDT($PIECE(ECXSTRS,U,8)),2)_U_$PIECE(ECXSTRS,U,11)_U_+$PIECE(ECXSTRS,U,12))

 +3                SET ^TMP($JOB,"ECXPORT",CNT)=^TMP($JOB,"ECXPORT",CNT)_U_$SELECT(ECXSTRX="":"NO DATA",1:ECXARRAY("EXTRACT")_U_$PIECE(ECXSTRX,U,4)_U_$$FMTE^XLFDT($$HL7TFM^XLFDT($PIECE(ECXSTRX,U,8)),2)_U_$PIECE(ECXSTRX,U,11)_U_+$PIECE(ECXSTRX,U,12))

                   SET CNT=CNT+1

               End DoDot:1

               QUIT

 +4        IF $Y+5>IOSL

               Begin DoDot:1

 +5                IF $EXTRACT(IOST,1,2)["C-"

                       SET DIR(0)="E"

                       DO ^DIR

                       KILL DIR

                       IF 'Y

                           SET ECQUIT=1

                           QUIT

 +6                WRITE @IOF

                   DO HED

               End DoDot:1

               if ECQUIT

                   QUIT

 +7        IF ECXSTRS=""

               WRITE !?3,"***************N*O***D*A*T*A*****************"

 +8        IF ECXSTRS'=""

               Begin DoDot:1

 +9                WRITE !,$PIECE(ECXSTRS,"^",5),?11,$PIECE(ECXSTRS,"^",4),?26,$PIECE(ECXSTRS,"^",16)

 +10               WRITE ?37,$$FMTE^XLFDT($$HL7TFM^XLFDT($PIECE(ECXSTRS,"^",8)),2)

 +11               WRITE ?49,$PIECE(ECXSTRS,"^",11),?60,$JUSTIFY(+$PIECE(ECXSTRS,"^",12),2)

               End DoDot:1

 +12       IF ECXSTRX=""

               WRITE ?83,"*******N*O***D*A*T*A*********"

 +13       IF ECXSTRX'=""

               Begin DoDot:1

 +14               WRITE ?80,$PIECE(ECXSTRX,"^",4)

 +15               WRITE ?92,$$FMTE^XLFDT($$HL7TFM^XLFDT($PIECE(ECXSTRX,"^",8)),2)

 +16               WRITE ?102,$PIECE(ECXSTRX,"^",11),?113,$JUSTIFY(+$PIECE(ECXSTRX,"^",12),2)

               End DoDot:1

 +17       QUIT

TOTAL     ;

 +1       ;I $Y+3>IOSL D  Q:ECQUIT

 +2       ;. I $E(IOST,1,2)["C-" S DIR(0)="E" D ^DIR K DIR I 'Y S ECQUIT=1 Q

 +3       ;. W @IOF D HED

 +4       ;154 Section added for exporting report

           IF $GET(ECXPORT)

               Begin DoDot:1

 +5                IF $GET(ECXSTOT)!($GET(ECXTOT)&('ECXCFLG))

                       SET ^TMP($JOB,"ECXPORT",CNT)="^"

                       SET CNT=CNT+1

 +6                SET ^TMP($JOB,"ECXPORT",CNT)=$SELECT($GET(ECXSTOT):"^^^^"_ECXCLAST_" TOTAL^"_+$GET(ECXCOMP(ECXCLAST,"S"))_"^^^^"_ECXCLAST_" TOTAL^"_+$GET(ECXCOMP(ECXCLAST,"X")),1:"TOTAL^^^^^"_+$GET(ECXCOMP("TOTAL","S"))_"^^^^^"_+$GET(ECXCOMP("TOTAL","X

")))

                   SET CNT=CNT+1

 +7                IF $GET(ECXSTOT)

                       SET ^TMP($JOB,"ECXPORT",CNT)="^"

                       SET CNT=CNT+1

               End DoDot:1

               QUIT

 +8        WRITE !,ECLINE1

 +9        IF $GET(ECXSTOT)

               WRITE !,?47,$JUSTIFY(ECXCLAST_" TOTAL",12),?60,$JUSTIFY(+$GET(ECXCOMP(ECXCLAST,"S")),4),?100,$JUSTIFY(ECXCLAST_" TOTAL",12),?113,$JUSTIFY(+$GET(ECXCOMP(ECXCLAST,"X")),4)

 +10       IF $GET(ECXTOT)

               WRITE !,"TOTAL",?60,$JUSTIFY(+$GET(ECXCOMP("TOTAL","S")),4),?113,$JUSTIFY(+$GET(ECXCOMP("TOTAL","X")),4)

 +11       QUIT

 +12      ;

HED       ;

 +1        SET ECPG=ECPG+1

 +2        WRITE !,"LBB Extract Comparative Report",?124,"Page",$JUSTIFY(ECPG,3)

 +3        WRITE !,ECSDN," - ",ECEDN,?111,"Run Date:",$JUSTIFY(ECRDT,12)

 +4        WRITE !!,"------------------ LOCAL BLOOD BANK SOURCE ----------------------"

 +5        WRITE ?80,"------------- LBB EXTRACT (#"_ECXARRAY("EXTRACT")_") ---------------"

 +6        WRITE !,?37,"Transf",?57,"Number",?92,"Transf",?113,"Number"

 +7        WRITE !,"Name",?14,"SSN",?25,"FDR LOC",?37,"Date",?49,"COMP",?57,"of Units",?80,"SSN",?92,"Date",?102,"COMP",?113,"of Units"

 +8        WRITE !,ECLINE

 +9        QUIT

 +10      ;

QUE       ;

 +1       ;determine output device and queue if requested

 +2        NEW %,X,%DT

 +3        SET X=ECXARRAY("START")

           DO ^%DT

           SET ECSD=Y

           SET X=ECXARRAY("END")

           DO ^%DT

           SET ECED=Y

 +4        SET ECSDN=$$FMTE^XLFDT(ECSD)

           SET ECEDN=$$FMTE^XLFDT(ECED)

           SET ECSD1=ECSD-.1

 +5        FOR X="ECINST","ECED","ECSD","ECSD1","ECEDN","ECSDN"

               SET ECXSAVE(X)=""

 +6        FOR X="ECPACK","ECPIECE","ECRTN","ECGRP","ECNODE"

               SET ECXSAVE(X)=""

 +7        FOR X="ECFILE","ECHEAD","ECVER","ECINST","ECXINST","ECXCFLG"

               SET ECXSAVE(X)=""

 +8       ;S ECXSAVE("ECXDIV(")=""

 +9        SET ECXSAVE("ECXARRAY(")=""

           SET ECXSAVE("SCRNARR")=""

           SET TMP=$$OREF^DILF(SCRNARR)

           SET ECXSAVE(TMP)=""

 +10       SET ECXPGM="START^ECXLBBC"

           SET ECXDESC="LBB Extract Audit Comparative Report"

 +11       WRITE !!,"This report requires a print width of 132 characters.",!!

 +12       DO DEVICE^ECXUTLA(ECXPGM,ECXDESC,.ECXSAVE)

 +13       IF ECXSAVE("POP")=1

               Begin DoDot:1

 +14               WRITE !!,?5,"Try again later... exiting.",!

 +15               KILL @SCRNARR@("DIVISION")

 +16               DO AUDIT^ECXKILL

               End DoDot:1

               SET ECXPOP=1

               QUIT

 +17       IF ECXSAVE("ZTSK")=0

               Begin DoDot:1

 +18               KILL ECXSAVE,ECXPGM,ECXDESC

 +19               DO START^ECXLBBC

               End DoDot:1

 +20       IF IO'=IO(0)

               DO ^%ZISC

 +21       DO HOME^%ZIS

           SET ECXPOP=1

 +22       DO AUDIT^ECXKILL

 +23       QUIT

EXTRACT   ;build extract tmp

 +1        NEW ECXEXT,IEN,NODE0,ECXDFN,ECXTDT,ECXTTM,ECXCOMP

 +2        SET ECXEXT=ECXARRAY("EXTRACT")

 +3        SET IEN=0

FOR

               SET IEN=$ORDER(^ECX(727.829,"AC",ECXEXT,IEN))

               if IEN=""

                   QUIT

               Begin DoDot:1

 +4                SET NODE0=$GET(^ECX(727.829,IEN,0))

                   SET ECXDFN=$PIECE(NODE0,"^",5)

 +5                SET ECXTDT=$PIECE(NODE0,"^",10)

 +6                IF ($EXTRACT(ECXTDT,1)+1_$EXTRACT(ECXTDT,3,8))>ECED

                       QUIT

 +7                IF ($EXTRACT(ECXTDT,1)+1_$EXTRACT(ECXTDT,3,8))<ECSD

                       QUIT

 +8                SET ECXTTM=$PIECE(NODE0,"^",11)

                   SET ECXCOMP=$PIECE(NODE0,"^",13)

 +9                NEW ECCOUNT

                   SET ECCOUNT=0

 +10               FOR

                       SET ECCOUNT=ECCOUNT+1

                       if '$DATA(^TMP("ECXLBBC",$JOB,$SELECT($GET(ECXCFLG)=1

                           QUIT

 +11               SET ^TMP("ECXLBBC",$JOB,$SELECT($GET(ECXCFLG)=1:ECXCOMP,1:"ZZNOZZ"),ECXDFN,ECXTDT_"."_ECXTTM_"."_ECCOUNT,"X")="^"_$PIECE(NODE0,"^",4,99)

               End DoDot:1

 +12       QUIT

ECXLBBC.m