Changeset 623 for WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXPLBB.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXPLBB.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXPLBB.m
r613 r623 1 ECXPLBB ;DALOI/KML - DSS BLOOD BANK PRE-EXTRACT AUDIT REPORT ; 8/13/07 7:08am2 ;;3.0;DSS EXTRACTS;**78,92,105**;Dec 22, 1997;Build 703 4 5 6 7 8 9 10 11 START 12 13 14 15 16 17 18 19 20 21 OUTPUT 22 23 24 25 26 27 28 29 30 PRINT 31 32 33 34 35 36 37 38 39 HED 40 41 W !,"LBBExtract Audit Report",?72,"Page",$J(ECPG,3)42 43 44 45 46 47 48 DATES 49 50 51 52 W @IOF,!,"LBBExtract Audit Report Information for DSS",!!53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 QUE 73 74 75 76 77 78 79 80 S ZTDESC=ECPACK_"EXTRACT AUDIT REPORT: "_ECSDN_" TO "_ECEDN,ZTRTN="START^ECXPLBB",ZTIO=""81 82 83 84 EN(ECXJOB,ECSD,ECED) 85 86 87 88 89 90 91 92 93 94 95 96 97 98 1 ECXPLBB ;DALOI/KML - DSS BLOOD BANK PRE-EXTRACT AUDIT REPORT ; 8/14/06 10:10am 2 ;;3.0;DSS EXTRACTS;**78,92**;Dec 22, 1997;Build 30 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 Pre-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 Pre-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_" PRE-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
Note:
See TracChangeset
for help on using the changeset viewer.
