source: WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXALAR2.m@ 1046

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

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1ECXALAR2 ;ALB/TMD-LAR Extract Report of Untranslatable Results ; 9/17/02 5:43pm
2 ;;3.0;DSS EXTRACTS;**46,51**;Dec 22, 1997
3 ;
4EN ; entry point
5 N COUNT
6 K ^TMP($J)
7 S COUNT=0
8 S ECSD=ECSD1,ECED=ECED+.3
9 D PROCESS
10 Q
11 ;
12PROCESS ;
13 N QFLG,ECDTST,ECLTST,ECWCDA,ECWC,ECLOC,ECLRN,ECRES,EC2,ECN,ECRS,ECTRS,ECTRANS,ECTRIEN,ECSCDT,ECSCTM,ECXDFN
14 K ^LAR(64.036) S LRSDT=$P(ECSD,"."),LREDT=$P(ECED,".")
15 D ^LRCAPDAR
16 ;quit if no completion date for API compile
17 ;I '$P($G(^LAR(64.036,1,2,1,0)),U,4) S ECXERR=1 Q
18 ;build local array of workload codes for local lab tests linked to
19 ;DSS tests
20 K ECLOC S ECDTST=0
21 F S ECDTST=$O(^ECX(727.2,1,1,ECDTST)) Q:('ECDTST)!ECXERR S ECLTST=0 D
22 .F S ECLTST=$O(^ECX(727.2,1,1,ECDTST,"LOC",ECLTST)) Q:('ECLTST)!ECXERR D
23 ..S ECLTIEN=+^ECX(727.2,1,1,ECDTST,"LOC",ECLTST,0)
24 ..S ECWCDA=+$G(^LAB(60,ECLTIEN,64))
25 ..I ECWCDA S ECWC=$P(^LAM(ECWCDA,0),U,2),ECLOC(ECWCDA)=ECWC
26 K ECLTIEN
27 ;process temporary lab file #64.036
28 S QFLG=0,ECLRN=1
29 F S ECLRN=$O(^LAR(64.036,ECLRN)) Q:('ECLRN)!(QFLG)!(ECXERR) D
30 .I $D(^LAR(64.036,ECLRN,0)) D
31 ..S EC1=^LAR(64.036,ECLRN,0)
32 ..Q:$P(EC1,U,2)=""
33 ..S ECXDFN=$P(EC1,U,3)
34 ..S ECSCDT=$P(EC1,U,9),ECSCTM=$P(EC1,U,10)
35 ..;loop on results multiple
36 ..S ECRES=0
37 ..F S ECRES=$O(^LAR(64.036,ECLRN,1,ECRES)) Q:('ECRES)!(QFLG)!(ECXERR) D
38 ...I $D(^LAR(64.036,ECLRN,1,ECRES,0)) D Q:QFLG
39 ....S EC2=^LAR(64.036,ECLRN,1,ECRES,0)
40 ....S ECN=$P(EC2,U),ECRS=$P(EC2,U,2),ECWC=+$P(EC2,U,4)
41 ....S ECWC=$S($D(ECLOC(ECWC)):ECLOC(ECWC),1:"")
42 ....; - Free text results translation
43 ....S ECTRANS="",ECTRS=ECRS
44 ....I +ECTRS S ECTRS=$TR(ECTRS,",","") D
45 .....I (ECTRS?.N)!(ECTRS?.N1".".N) S ECRS=ECTRS
46 ....F Q:$E(ECTRS,1)'=" " S ECTRS=$E(ECTRS,2,$L(ECTRS))
47 ....F Q:$E(ECTRS,$L(ECTRS))'=" " S ECTRS=$E(ECTRS,1,($L(ECTRS)-1))
48 ....I ECTRS]"" I ECTRS'?.N I ECTRS'?.N1".".N D ;translate
49 .....S ECTRS=$TR(ECRS,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
50 .....I ("<>"[$E(ECTRS))!($E(ECTRS,1,2)="GT")!($E(ECTRS,1,2)="LT") Q
51 .....S ECTRIEN="",ECTRIEN=$O(^ECX(727.7,"B",ECTRS,ECTRIEN))
52 .....S ECTRANS=$S(ECTRIEN:$P(^ECX(727.7,ECTRIEN,0),U,2),1:"5~")
53 ...I ECTRANS="5~" I ECWC]"" D FILE
54 K ^LAR(64.036) S ^LAR(64.036,0)="LAB DSS LAR EXTRACT^64.036^"
55 Q
56 ;
57FILE ; put records in temp file to print later
58 S COUNT=COUNT+1
59 S ^TMP($J,COUNT)=ECXDFN_U_ECSCDT_U_ECSCTM_U_ECN_U_ECRS
60 Q
Note: See TracBrowser for help on using the repository browser.