| [613] | 1 | ECXALAR2 ;ALB/TMD-LAR Extract Report of Untranslatable Results ; 9/17/02 5:43pm
|
|---|
| 2 | ;;3.0;DSS EXTRACTS;**46,51**;Dec 22, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | EN ; 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 | ;
|
|---|
| 12 | PROCESS ;
|
|---|
| 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 | ;
|
|---|
| 57 | FILE ; 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
|
|---|
