ECXPLBB ;DALOI/KML - DSS BLOOD BANK PRE-EXTRACT AUDIT REPORT ;5/31/17 16:32
;;3.0;DSS EXTRACTS;**78,92,105,136,143,149,153,156,166**;Dec 22, 1997;Build 24
;Per VA Directive 6402, this routine should not be modified. Medical Device # BK970021
;entry point from option
D SETUP^ECXLBB1 I ECFILE="" Q ;149
N ECXINST,ECXPORT,CNT ;149
D DATES
Q:ECED']""!(ECSD']"") ;149 Changed logic so it stops if either start or stop date is null
S ECXPORT=$$EXPORT^ECXUTL1 Q:ECXPORT=-1 I $G(ECXPORT) D Q ;149 Section added
.W !!,"This report may take a while to generate. Please be patient.",!
.S ECSDN=$$FMTE^XLFDT(ECSD),ECEDN=$$FMTE^XLFDT(ECED),ECSD1=ECSD-.1
.K ^TMP($J,"ECXPORT")
.S ^TMP($J,"ECXPORT",0)="NAME^SSN^FEEDER LOCATION^TRANSFUSION DATE^COMPONENT^NUMBER OF UNITS",CNT=1
.D START
.D EXPDISP^ECXUTL1
.D ^ECXKILL
N ECXPOP S ECXPOP=0 D QUE Q:ECXPOP
;
START ; entry point from tasked job
; get LAB DATA and build temporary global ^TMP("ECXLBB",$J)
N ECTRSP,ECADMT,ECTODT,ECXRPT,ECOUT,ECXSTR,ECRDT,ECLINE,ECPG,ECQUIT
N ECD,ECXDFN,ECARRY,EC66,ECERR,ECTRFDT,ECTRFTM,ECX,ECINOUT,ECXJOB
N ECXLOGIC,ECXREC ;156
S ECXJOB=$J
K ^TMP("ECXLBB",ECXJOB)
U IO
I '$G(ECXPORT) I $E(IOST,1,2)="C-" W !,"Retrieving records... " ;149
S ECXRPT=1 D AUDRPT^ECXLBB1 ;149
OUTPUT ; entry point called by EN tag
I '$D(^TMP("ECXLBB",ECXJOB)) W:'$G(ECXPORT) !,"There were no records that met the date range criteria" Q ;149
S (ECPG,ECDATE,ECQUIT,ECXDFN,ECXREC)=0,ECLINE="",$P(ECLINE,"=",80)="="
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 ;149
F S ECXDFN=$O(^TMP("ECXLBB",ECXJOB,ECXDFN)) Q:'ECXDFN D Q:ECQUIT
.F S ECDATE=$O(^TMP("ECXLBB",ECXJOB,ECXDFN,ECDATE)) Q:'ECDATE D Q:ECQUIT
..F S ECXREC=$O(^TMP("ECXLBB",ECXJOB,ECXDFN,ECDATE,ECXREC)) Q:'+ECXREC S ECXSTR=^(ECXREC) D PRINT Q:ECQUIT ;143,156-added additional for loop
I '$G(ECXPORT) D ^ECXKILL ;149
Q
;
PRINT ;
I $G(ECXPORT) S ^TMP($J,"ECXPORT",CNT)=$P(ECXSTR,U,5)_U_$P(ECXSTR,U,4)_U_$P(ECXSTR,U,16)_U_$$FMTE^XLFDT($$HL7TFM^XLFDT($P(ECXSTR,U,8)),2)_U_$P(ECXSTR,U,11)_U_+$P(ECXSTR,U,12),CNT=CNT+1 Q ;149
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
W !,$P(ECXSTR,"^",5),?11,$P(ECXSTR,"^",4),?26,$P(ECXSTR,"^",16)
W ?37,$$FMTE^XLFDT($$HL7TFM^XLFDT($P(ECXSTR,"^",8)),2)
W ?49,$P(ECXSTR,"^",11),?60,$J(+$P(ECXSTR,"^",12),2)
Q
;
HED ;
S ECPG=ECPG+1
W !,"Laboratory Blood Bank (LBB) Pre-Extract Audit Report",?72,"Page",$J(ECPG,3) ;136,166 tjl - Changed report title
W !,ECSDN," - ",ECEDN,?58,"Run Date:",$J(ECRDT,12)
W !,?37,"Transf",?57,"Number"
W !,"Name",?14,"SSN",?25,"FDR LOC",?37,"Date",?49,"COMP"
W ?57,"of Units"
W !,ECLINE
Q
DATES ;
N OUT,CHKFLG
I '$D(ECNODE) S ECNODE=7
I '$D(ECHEAD) S ECHEAD=" "
W @IOF,!,"Laboratory Blood Bank (LBB) Pre-Extract Audit Report Information for DSS",!! ;136,166 tjl - Changed report title
;Added descriptive text DSS FY13 Logic
W !,"**NOTE: This audit can only be run prior to the LBB Extract being generated." ;136
W !,"If you have already generated your LBB Extract, refer to the Processing "
W !,"Guide Chapter 4 section on Regenerating.**",!
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
S ECLDT=$S($D(^ECX(728,1,ECNODE)):$P(^(ECNODE),U,ECPIECE),1:2610624)
S:ECLDT="" ECLDT=2610624
S ECOUT=0 F S (ECED,ECSD)="" D Q:ECOUT
. K %DT S %DT="AEX",%DT("A")="Starting with Date: " D ^%DT
. I Y<0 S ECOUT=1 Q
. S ECSD=Y
. K %DT S %DT="AEX",%DT("A")="Ending with Date: " D ^%DT
. I Y<0 S ECOUT=1 Q
. I Y<ECSD W !!,"The ending date cannot be earlier than the starting date.",!,"Please try again.",!! Q
. I $E(Y,1,5)'=$E(ECSD,1,5) W !!,"Beginning and ending dates must be in the same month and year.",!,"Please try again.",!! Q
. S ECED=Y
. I ECLDT'<ECSD W !!,"The Blood Bank information has already been extracted through ",$$FMTE^XLFDT(ECLDT),".",!,"Please enter a new date range.",!! Q
. S ECOUT=1
Q
;
QUE ;
K ZTSAVE
S ECSDN=$$FMTE^XLFDT(ECSD),ECEDN=$$FMTE^XLFDT(ECED),ECSD1=ECSD-.1
K ZTSAVE
F X="ECINST","ECED","ECSD","ECSD1","ECEDN","ECSDN" S ZTSAVE(X)=""
F X="ECPACK","ECPIECE","ECRTN","ECGRP","ECNODE" S ZTSAVE(X)=""
F X="ECFILE","ECHEAD","ECVER","ECINST","ECXINST" S ZTSAVE(X)=""
F X="ECXLOGIC","ECXDATES" S ZTSAVE(X)=""
S ZTDESC=ECPACK_" EXTRACT AUDIT REPORT: "_ECSDN_" TO "_ECEDN,ZTRTN="START^ECXPLBB",ZTIO="" ;149,153
S IOP="Q" W ! S %ZIS="QMP" D ^%ZIS S:POP ECXPOP=1 Q:POP I $D(IO("Q")) K IO("Q"),ZTIO D ^%ZTLOAD W:$D(ZTSK) !,$C(7),"REQUEST QUEUED",!,"Task #: ",$G(ZTSK) K I,ZTSK,ZTIO,ZTSAVE,ZTRTN D HOME^%ZIS S ECXPOP=1
Q
;
EN(ECXJOB,ECSD,ECED) ; entry point used primarily for testing
; input:
; ECXJOB = $J that is assigned to the 2nd subscript of
; the temporary global array containing the
; extracted data that feeds the pre-extract
; audit report
; ECSD = starting date range representing the FM
; date used to retrieve data from file #63
; ECED = ending date range representing the FM date
; used to retrieve data from file #63
; syntax of the call: D EN^ECXPLBB(541571372,3000101,3000131)
D OUTPUT
Q
;
;ECXPLBB
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXPLBB 5520 printed Oct 16, 2024@17:54:15 Page 2
ECXPLBB ;DALOI/KML - DSS BLOOD BANK PRE-EXTRACT AUDIT REPORT ;5/31/17 16:32
+1 ;;3.0;DSS EXTRACTS;**78,92,105,136,143,149,153,156,166**;Dec 22, 1997;Build 24
+2 ;Per VA Directive 6402, this routine should not be modified. Medical Device # BK970021
+3 ;entry point from option
+4 ;149
DO SETUP^ECXLBB1
IF ECFILE=""
QUIT
+5 ;149
NEW ECXINST,ECXPORT,CNT
+6 DO DATES
+7 ;149 Changed logic so it stops if either start or stop date is null
if ECED']""!(ECSD']"")
QUIT
+8 ;149 Section added
SET ECXPORT=$$EXPORT^ECXUTL1
if ECXPORT=-1
QUIT
IF $GET(ECXPORT)
Begin DoDot:1
+9 WRITE !!,"This report may take a while to generate. Please be patient.",!
+10 SET ECSDN=$$FMTE^XLFDT(ECSD)
SET ECEDN=$$FMTE^XLFDT(ECED)
SET ECSD1=ECSD-.1
+11 KILL ^TMP($JOB,"ECXPORT")
+12 SET ^TMP($JOB,"ECXPORT",0)="NAME^SSN^FEEDER LOCATION^TRANSFUSION DATE^COMPONENT^NUMBER OF UNITS"
SET CNT=1
+13 DO START
+14 DO EXPDISP^ECXUTL1
+15 DO ^ECXKILL
End DoDot:1
QUIT
+16 NEW ECXPOP
SET ECXPOP=0
DO QUE
if ECXPOP
QUIT
+17 ;
START ; entry point from tasked job
+1 ; get LAB DATA and build temporary global ^TMP("ECXLBB",$J)
+2 NEW ECTRSP,ECADMT,ECTODT,ECXRPT,ECOUT,ECXSTR,ECRDT,ECLINE,ECPG,ECQUIT
+3 NEW ECD,ECXDFN,ECARRY,EC66,ECERR,ECTRFDT,ECTRFTM,ECX,ECINOUT,ECXJOB
+4 ;156
NEW ECXLOGIC,ECXREC
+5 SET ECXJOB=$JOB
+6 KILL ^TMP("ECXLBB",ECXJOB)
+7 USE IO
+8 ;149
IF '$GET(ECXPORT)
IF $EXTRACT(IOST,1,2)="C-"
WRITE !,"Retrieving records... "
+9 ;149
SET ECXRPT=1
DO AUDRPT^ECXLBB1
OUTPUT ; entry point called by EN tag
+1 ;149
IF '$DATA(^TMP("ECXLBB",ECXJOB))
if '$GET(ECXPORT)
WRITE !,"There were no records that met the date range criteria"
QUIT
+2 SET (ECPG,ECDATE,ECQUIT,ECXDFN,ECXREC)=0
SET ECLINE=""
SET $PIECE(ECLINE,"=",80)="="
+3 SET ECSDN=$$FMTE^XLFDT(ECSD,9)
SET ECEDN=$$FMTE^XLFDT(ECED,9)
SET ECRDT=$$FMTE^XLFDT(DT,9)
+4 ;149
IF '$GET(ECXPORT)
if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
DO HED
+5 FOR
SET ECXDFN=$ORDER(^TMP("ECXLBB",ECXJOB,ECXDFN))
if 'ECXDFN
QUIT
Begin DoDot:1
+6 FOR
SET ECDATE=$ORDER(^TMP("ECXLBB",ECXJOB,ECXDFN,ECDATE))
if 'ECDATE
QUIT
Begin DoDot:2
+7 ;143,156-added additional for loop
FOR
SET ECXREC=$ORDER(^TMP("ECXLBB",ECXJOB,ECXDFN,ECDATE,ECXREC))
if '+ECXREC
QUIT
SET ECXSTR=^(ECXREC)
DO PRINT
if ECQUIT
QUIT
End DoDot:2
if ECQUIT
QUIT
End DoDot:1
if ECQUIT
QUIT
+8 ;149
IF '$GET(ECXPORT)
DO ^ECXKILL
+9 QUIT
+10 ;
PRINT ;
+1 ;149
IF $GET(ECXPORT)
SET ^TMP($JOB,"ECXPORT",CNT)=$PIECE(ECXSTR,U,5)_U_$PIECE(ECXSTR,U,4)_U_$PIECE(ECXSTR,U,16)_U_$$FMTE^XLFDT($$HL7TFM^XLFDT($PIECE(ECXSTR,U,8)),2)_U_$PIECE(ECXSTR,U,11)_U_+$PIECE(ECXSTR,U,12)
SET CNT=CNT+1
QUIT
+2 IF $Y+5>IOSL
Begin DoDot:1
+3 IF $EXTRACT(IOST,1,2)["C-"
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET ECQUIT=1
QUIT
+4 WRITE @IOF
DO HED
End DoDot:1
if ECQUIT
QUIT
+5 WRITE !,$PIECE(ECXSTR,"^",5),?11,$PIECE(ECXSTR,"^",4),?26,$PIECE(ECXSTR,"^",16)
+6 WRITE ?37,$$FMTE^XLFDT($$HL7TFM^XLFDT($PIECE(ECXSTR,"^",8)),2)
+7 WRITE ?49,$PIECE(ECXSTR,"^",11),?60,$JUSTIFY(+$PIECE(ECXSTR,"^",12),2)
+8 QUIT
+9 ;
HED ;
+1 SET ECPG=ECPG+1
+2 ;136,166 tjl - Changed report title
WRITE !,"Laboratory Blood Bank (LBB) Pre-Extract Audit Report",?72,"Page",$JUSTIFY(ECPG,3)
+3 WRITE !,ECSDN," - ",ECEDN,?58,"Run Date:",$JUSTIFY(ECRDT,12)
+4 WRITE !,?37,"Transf",?57,"Number"
+5 WRITE !,"Name",?14,"SSN",?25,"FDR LOC",?37,"Date",?49,"COMP"
+6 WRITE ?57,"of Units"
+7 WRITE !,ECLINE
+8 QUIT
DATES ;
+1 NEW OUT,CHKFLG
+2 IF '$DATA(ECNODE)
SET ECNODE=7
+3 IF '$DATA(ECHEAD)
SET ECHEAD=" "
+4 ;136,166 tjl - Changed report title
WRITE @IOF,!,"Laboratory Blood Bank (LBB) Pre-Extract Audit Report Information for DSS",!!
+5 ;Added descriptive text DSS FY13 Logic
+6 ;136
WRITE !,"**NOTE: This audit can only be run prior to the LBB Extract being generated."
+7 WRITE !,"If you have already generated your LBB Extract, refer to the Processing "
+8 WRITE !,"Guide Chapter 4 section on Regenerating.**",!
+9 if '$DATA(ECINST)
SET ECINST=+$PIECE(^ECX(728,1,0),U)
+10 SET ECXINST=ECINST
+11 KILL ECXDIC
SET DA=ECINST
SET DIC="^DIC(4,"
SET DIQ(0)="I"
SET DIQ="ECXDIC"
SET DR=".01;99"
+12 DO EN^DIQ1
SET ECINST=$GET(ECXDIC(4,DA,99,"I"))
KILL DIC,DIQ,DA,DR,ECXDIC
+13 SET ECLDT=$SELECT($DATA(^ECX(728,1,ECNODE)):$PIECE(^(ECNODE),U,ECPIECE),1:2610624)
+14 if ECLDT=""
SET ECLDT=2610624
+15 SET ECOUT=0
FOR
SET (ECED,ECSD)=""
Begin DoDot:1
+16 KILL %DT
SET %DT="AEX"
SET %DT("A")="Starting with Date: "
DO ^%DT
+17 IF Y<0
SET ECOUT=1
QUIT
+18 SET ECSD=Y
+19 KILL %DT
SET %DT="AEX"
SET %DT("A")="Ending with Date: "
DO ^%DT
+20 IF Y<0
SET ECOUT=1
QUIT
+21 IF Y<ECSD
WRITE !!,"The ending date cannot be earlier than the starting date.",!,"Please try again.",!!
QUIT
+22 IF $EXTRACT(Y,1,5)'=$EXTRACT(ECSD,1,5)
WRITE !!,"Beginning and ending dates must be in the same month and year.",!,"Please try again.",!!
QUIT
+23 SET ECED=Y
+24 IF ECLDT'<ECSD
WRITE !!,"The Blood Bank information has already been extracted through ",$$FMTE^XLFDT(ECLDT),".",!,"Please enter a new date range.",!!
QUIT
+25 SET ECOUT=1
End DoDot:1
if ECOUT
QUIT
+26 QUIT
+27 ;
QUE ;
+1 KILL ZTSAVE
+2 SET ECSDN=$$FMTE^XLFDT(ECSD)
SET ECEDN=$$FMTE^XLFDT(ECED)
SET ECSD1=ECSD-.1
+3 KILL ZTSAVE
+4 FOR X="ECINST","ECED","ECSD","ECSD1","ECEDN","ECSDN"
SET ZTSAVE(X)=""
+5 FOR X="ECPACK","ECPIECE","ECRTN","ECGRP","ECNODE"
SET ZTSAVE(X)=""
+6 FOR X="ECFILE","ECHEAD","ECVER","ECINST","ECXINST"
SET ZTSAVE(X)=""
+7 FOR X="ECXLOGIC","ECXDATES"
SET ZTSAVE(X)=""
+8 ;149,153
SET ZTDESC=ECPACK_" EXTRACT AUDIT REPORT: "_ECSDN_" TO "_ECEDN
SET ZTRTN="START^ECXPLBB"
SET ZTIO=""
+9 SET IOP="Q"
WRITE !
SET %ZIS="QMP"
DO ^%ZIS
if POP
SET ECXPOP=1
if POP
QUIT
IF $DATA(IO("Q"))
KILL IO("Q"),ZTIO
DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !,$CHAR(7),"REQUEST QUEUED",!,"Task #: ",$GET(ZTSK)
KILL I,ZTSK,ZTIO,ZTSAVE,ZTRTN
DO HOME^%ZIS
SET ECXPOP=1
+10 QUIT
+11 ;
EN(ECXJOB,ECSD,ECED) ; entry point used primarily for testing
+1 ; input:
+2 ; ECXJOB = $J that is assigned to the 2nd subscript of
+3 ; the temporary global array containing the
+4 ; extracted data that feeds the pre-extract
+5 ; audit report
+6 ; ECSD = starting date range representing the FM
+7 ; date used to retrieve data from file #63
+8 ; ECED = ending date range representing the FM date
+9 ; used to retrieve data from file #63
+10 ; syntax of the call: D EN^ECXPLBB(541571372,3000101,3000131)
+11 DO OUTPUT
+12 QUIT
+13 ;
+14 ;ECXPLBB
