| 1 | ECXPLBB ;DALOI/KML - DSS BLOOD BANK PRE-EXTRACT AUDIT REPORT ; 8/13/07 7:08am
|
|---|
| 2 | ;;3.0;DSS EXTRACTS;**78,92,105**;Dec 22, 1997;Build 70
|
|---|
| 3 | ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
|
|---|
| 4 | ;entry point from option
|
|---|
| 5 | D SETUP^ECXLBB I ECFILE="" Q
|
|---|
| 6 | N ECXINST
|
|---|
| 7 | D DATES
|
|---|
| 8 | Q:ECED']""&(ECSD']"")
|
|---|
| 9 | N ECXPOP S ECXPOP=0 D QUE Q:ECXPOP
|
|---|
| 10 | ;
|
|---|
| 11 | START ; entry point from tasked job
|
|---|
| 12 | ; get LAB DATA and build temporary global ^TMP("ECXLBB",$J)
|
|---|
| 13 | N ECTRSP,ECADMT,ECTODT,ECXRPT,ECOUT,ECXSTR,ECRDT,ECLINE,ECPG,ECQUIT
|
|---|
| 14 | N ECD,ECXDFN,ECARRY,EC66,ECERR,ECTRFDT,ECTRFTM,ECX,ECINOUT,ECXJOB
|
|---|
| 15 | N ECXLOGIC
|
|---|
| 16 | S ECXJOB=$J
|
|---|
| 17 | K ^TMP("ECXLBB",ECXJOB)
|
|---|
| 18 | U IO
|
|---|
| 19 | I $E(IOST,1,2)="C-" W !,"Retrieving records... "
|
|---|
| 20 | S ECXRPT=1 D AUDRPT^ECXLBB
|
|---|
| 21 | OUTPUT ; entry point called by EN tag
|
|---|
| 22 | I '$D(^TMP("ECXLBB",ECXJOB)) W !,"There were no records that met the date range criteria" Q
|
|---|
| 23 | S (ECPG,ECDATE,ECQUIT,ECXDFN)=0,ECLINE="",$P(ECLINE,"=",80)="="
|
|---|
| 24 | S ECSDN=$$FMTE^XLFDT(ECSD,9),ECEDN=$$FMTE^XLFDT(ECED,9),ECRDT=$$FMTE^XLFDT(DT,9)
|
|---|
| 25 | W:$E(IOST,1,2)="C-" @IOF D HED
|
|---|
| 26 | F S ECXDFN=$O(^TMP("ECXLBB",ECXJOB,ECXDFN)) Q:'ECXDFN F S ECDATE=$O(^TMP("ECXLBB",ECXJOB,ECXDFN,ECDATE)) Q:'ECDATE Q:ECQUIT S ECXSTR=^(ECDATE) D PRINT
|
|---|
| 27 | D ^ECXKILL
|
|---|
| 28 | Q
|
|---|
| 29 | ;
|
|---|
| 30 | PRINT ;
|
|---|
| 31 | I $Y+5>IOSL D Q:ECQUIT
|
|---|
| 32 | . I $E(IOST,1,2)["C-" S DIR(0)="E" D ^DIR K DIR I 'Y S ECQUIT=1 Q
|
|---|
| 33 | . W @IOF D HED
|
|---|
| 34 | W !,$P(ECXSTR,"^",5),?11,$P(ECXSTR,"^",4),?26,$P(ECXSTR,"^",16)
|
|---|
| 35 | W ?37,$$FMTE^XLFDT($$HL7TFM^XLFDT($P(ECXSTR,"^",8)),2)
|
|---|
| 36 | W ?49,$P(ECXSTR,"^",11),?60,$J(+$P(ECXSTR,"^",12),2)
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
| 39 | HED ;
|
|---|
| 40 | S ECPG=ECPG+1
|
|---|
| 41 | W !,"LBB Extract Audit Report",?72,"Page",$J(ECPG,3)
|
|---|
| 42 | W !,ECSDN," - ",ECEDN,?58,"Run Date:",$J(ECRDT,12)
|
|---|
| 43 | W !,?37,"Transf",?57,"Number"
|
|---|
| 44 | W !,"Name",?14,"SSN",?25,"FDR LOC",?37,"Date",?49,"COMP"
|
|---|
| 45 | W ?57,"of Units"
|
|---|
| 46 | W !,ECLINE
|
|---|
| 47 | Q
|
|---|
| 48 | DATES ;
|
|---|
| 49 | N OUT,CHKFLG
|
|---|
| 50 | I '$D(ECNODE) S ECNODE=7
|
|---|
| 51 | I '$D(ECHEAD) S ECHEAD=" "
|
|---|
| 52 | W @IOF,!,"LBB Extract Audit Report Information for DSS",!!
|
|---|
| 53 | S:'$D(ECINST) ECINST=+$P(^ECX(728,1,0),U)
|
|---|
| 54 | S ECXINST=ECINST
|
|---|
| 55 | K ECXDIC S DA=ECINST,DIC="^DIC(4,",DIQ(0)="I",DIQ="ECXDIC",DR=".01;99"
|
|---|
| 56 | D EN^DIQ1 S ECINST=$G(ECXDIC(4,DA,99,"I")) K DIC,DIQ,DA,DR,ECXDIC
|
|---|
| 57 | S ECLDT=$S($D(^ECX(728,1,ECNODE)):$P(^(ECNODE),U,ECPIECE),1:2610624)
|
|---|
| 58 | S:ECLDT="" ECLDT=2610624
|
|---|
| 59 | S ECOUT=0 F S (ECED,ECSD)="" D Q:ECOUT
|
|---|
| 60 | . K %DT S %DT="AEX",%DT("A")="Starting with Date: " D ^%DT
|
|---|
| 61 | . I Y<0 S ECOUT=1 Q
|
|---|
| 62 | . S ECSD=Y
|
|---|
| 63 | . K %DT S %DT="AEX",%DT("A")="Ending with Date: " D ^%DT
|
|---|
| 64 | . I Y<0 S ECOUT=1 Q
|
|---|
| 65 | . I Y<ECSD W !!,"The ending date cannot be earlier than the starting date.",!,"Please try again.",!! Q
|
|---|
| 66 | . 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
|
|---|
| 67 | . S ECED=Y
|
|---|
| 68 | . I ECLDT'<ECSD W !!,"The Blood Bank information has already been extracted through ",$$FMTE^XLFDT(ECLDT),".",!,"Please enter a new date range.",!! Q
|
|---|
| 69 | . S ECOUT=1
|
|---|
| 70 | Q
|
|---|
| 71 | ;
|
|---|
| 72 | QUE ;
|
|---|
| 73 | K ZTSAVE
|
|---|
| 74 | S ECSDN=$$FMTE^XLFDT(ECSD),ECEDN=$$FMTE^XLFDT(ECED),ECSD1=ECSD-.1
|
|---|
| 75 | K ZTSAVE
|
|---|
| 76 | F X="ECINST","ECED","ECSD","ECSD1","ECEDN","ECSDN" S ZTSAVE(X)=""
|
|---|
| 77 | F X="ECPACK","ECPIECE","ECRTN","ECGRP","ECNODE" S ZTSAVE(X)=""
|
|---|
| 78 | F X="ECFILE","ECHEAD","ECVER","ECINST","ECXINST" S ZTSAVE(X)=""
|
|---|
| 79 | F X="ECXLOGIC","ECXDATES" S ZTSAVE(X)=""
|
|---|
| 80 | S ZTDESC=ECPACK_" EXTRACT AUDIT REPORT: "_ECSDN_" TO "_ECEDN,ZTRTN="START^ECXPLBB",ZTIO=""
|
|---|
| 81 | 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
|
|---|
| 82 | Q
|
|---|
| 83 | ;
|
|---|
| 84 | EN(ECXJOB,ECSD,ECED) ; entry point used primarily for testing
|
|---|
| 85 | ; input:
|
|---|
| 86 | ; ECXJOB = $J that is assigned to the 2nd subscript of
|
|---|
| 87 | ; the temporary global array containing the
|
|---|
| 88 | ; extracted data that feeds the pre-extract
|
|---|
| 89 | ; audit report
|
|---|
| 90 | ; ECSD = starting date range representing the FM
|
|---|
| 91 | ; date used to retrieve data from file #63
|
|---|
| 92 | ; ECED = ending date range representing the FM date
|
|---|
| 93 | ; used to retrieve data from file #63
|
|---|
| 94 | ; syntax of the call: D EN^ECXPLBB(541571372,3000101,3000131)
|
|---|
| 95 | D OUTPUT
|
|---|
| 96 | Q
|
|---|
| 97 | ;
|
|---|
| 98 | ;ECXPLBB
|
|---|
