source: WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXALAR.m@ 824

Last change on this file since 824 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.3 KB
Line 
1ECXALAR ;ALB/TMD-LAR Extract Report of Untranslatable Results ; 9/17/02 6:17pm
2 ;;3.0;DSS EXTRACTS;**46,51**;Dec 22, 1997
3 ;
4EN ; entry point
5 N X,Y,DATE,ECRUN,ECXOPT,ECXDESC,ECXSAVE,ECXTL,ECTHLD,ECSD,ECSD1,ECSTART,ECED,ECEND,ECXERR,QFLG
6 S QFLG=0,ECXTL="LAR"
7 ; get today's date
8 D NOW^%DTC S DATE=X,Y=$E(%,1,12) D DD^%DT S ECRUN=$P(Y,"@") K %DT
9 D SETUP^ECXLABR I ECFILE="" Q
10 I '$D(ECNODE) S ECNODE=7
11 I $P($G(^ECX(728,1,ECNODE+.1)),U,ECPIECE)]"" D Q
12 .W !!,$C(7),ECPACK," extract is already scheduled to run. Try later",!!
13 D BEGIN Q:QFLG
14 S ECXDESC=ECXTL_" Extract Report of Untranslatable Results"
15 S ECXSAVE("EC*")=""
16 D EN^XUTMDEVQ("PROCESS^ECXALAR",ECXDESC,.ECXSAVE)
17 I POP W !!,"No device selected...exiting.",! Q
18 I IO'=IO(0) D ^%ZISC
19 D HOME^%ZIS
20 D AUDIT^ECXKILL
21 Q
22 ;
23BEGIN ; display report description
24 W @IOF,!,"This report prints a listing of results that are not translatable i.e. have",!,"no entry in the Lab Results Translation File (#727.7)."
25 W !!,"This report is a pre-extract type audit report and should be run prior to the",!,"generation of the actual extract. Running this report has no effect on the",!,"actual extract."
26 W !!,"Enter the date range for which you would like to scan the ",ECXTL," Extract records.",!
27 S DONE=0 F S (ECED,ECSD)="" D Q:QFLG!DONE
28 .K %DT S %DT="AEX",%DT("A")="Starting with Date: ",%DT(0)=-DATE D ^%DT
29 .I Y<0 S QFLG=1 Q
30 .S ECSD=Y,ECSD1=ECSD-.1
31 .D DD^%DT S ECSTART=Y
32 .K %DT S %DT="AEX",%DT("A")="Ending with Date: ",%DT(0)=-DATE D ^%DT
33 .I Y<0 S QFLG=1 Q
34 .I Y<ECSD D Q
35 ..W !!,"The ending date cannot be earlier than the starting date."
36 ..W !,"Please try again.",!!
37 .I $E(Y,1,5)'=$E(ECSD,1,5) D Q
38 ..W !!,"Beginning and ending dates must be in the same month and year."
39 ..W !,"Please try again.",!!
40 .S ECED=Y
41 .D DD^%DT S ECEND=Y
42 .S DONE=1
43 Q
44 ;
45PROCESS ; entry point for queued report
46 S ZTREQ="@"
47 S $P(^ECX(728,1,ECNODE+.1),U,ECPIECE)="R"
48 S ECXERR=0 D EN^ECXALAR2 S $P(^ECX(728,1,ECNODE+.1),U,ECPIECE)="" Q:ECXERR
49 S QFLG=0 D PRINT
50 Q
51 ;
52PRINT ; process temp file and print report
53 N X,CNT,LN,REC,ECXDFN,ECXSSN,ECXPNM,ECRS,ECTC,ECFMDT,ECDTM,ECXTNM
54 U IO
55 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q
56 S (PG,QFLG,GTOT)=0,$P(LN,"-",80)=""
57 D HEADER Q:QFLG
58 S COUNT=0,CNT="" F S CNT=$O(^TMP($J,CNT)) Q:CNT=""!QFLG S REC=^(CNT) D
59 .S ECXDFN=$P(REC,U),ECTC=$P(REC,U,4),ECRS=$P(REC,U,5)
60 .S ECFMDT=$P(REC,U,2)_"."_$P(REC,U,3),ECDTM=$$FMTE^XLFDT(ECFMDT,2)
61 .S (ECXPNM,ECXSSN)=""
62 .K ECXPAT S OK=$$PAT^ECXUTL3(ECXDFN,,"1;",.ECXPAT)
63 .I OK S ECXPNM=ECXPAT("NAME"),ECXSSN=ECXPAT("SSN")
64 .S ECXTNM=$P($G(^ECX(727.2,1,1,ECTC,0)),U)
65 .I $Y+3>IOSL D HEADER
66 .W !,ECXPNM,?6,ECXSSN,?17,ECDTM,?34,ECTC,?40,$E(ECXTNM,1,22),?64,$E(ECRS,1,17)
67 .S COUNT=COUNT+1
68 Q:QFLG
69 I COUNT=0 W !!,?8,"No untranslatable results for this extract"
70CLOSE ;
71 I $E(IOST)="C",'QFLG D
72 .S SS=22-$Y F JJ=1:1:SS W !
73 .S DIR(0)="E" W ! D ^DIR K DIR
74 Q
75 ;
76HEADER ;header and page control
77 N SS,JJ
78 I $E(IOST)="C" D
79 .S SS=22-$Y F JJ=1:1:SS W !
80 .I PG>0 S DIR(0)="E" W ! D ^DIR K DIR S:'Y QFLG=1
81 Q:QFLG
82 W:$Y!($E(IOST)="C") @IOF S PG=PG+1
83 W !,ECXTL_" Extract Untranslatable Results Audit Report",?71,"Page: "_PG
84 W !,"Start Date: ",ECSTART
85 W !,"End Date: ",ECEND,?49,"Report Run Date: "_ECRUN
86 W !!,"Pat.",?6,"SSN",?17,"Date/Time",?34,"Test",?40,"Test Name",?64,"Result"
87 W !,"Name",?17,"Collected",?34,"Code"
88 W !,LN,!
89 Q
90 ;
Note: See TracBrowser for help on using the repository browser.