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
Q
;
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)
Q
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)
Q
;
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
Q
;
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
Q
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)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXLBBC 8211 printed Dec 13, 2024@01:52:57 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
+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
