source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIULQ2.m@ 1489

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

initial load of WorldVistAEHR

File size: 1.7 KB
Line 
1TIULQ2 ; SLC/JER - Record Extract For Upload Event Display
2 ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
3EXTRACT(TIUDA,TIUROOT,TIUERR,DR,TIULINE,TIUTEXT) ; Gets record & addenda
4 N DA,DIC,DIQ,TIULQ,X,Y
5 S TIUROOT=$G(TIUROOT,"^TMP(""TIULQ"",$J)")
6 S DA=TIUDA,DIC=8925,DIQ="TIULQ",DIQ(0)="IE"
7 I $G(DR)']"" S DR=".01:.1;1201:1701"
8 D EN^DIQ1
9 I '$D(TIULQ) S TIUERR="1^ Record Extract Failed"
10 M @TIUROOT@(TIUDA)=TIULQ(8925,TIUDA)
11 D PROBLEMS(DA,+$G(TIULINE))
12 I +$G(TIUTEXT) D TEXT(TIUDA,+$G(TIULINE),TIUDA)
13 Q
14PROBLEMS(TIUDA,TIUJ) ; Get associated problems
15 N TIUI,TIUP,TIUPROB,TIUC,TIUX,DR,DIC,DIQ S TIUI=0
16 F S TIUI=$O(^TIU(8925.9,"B",+TIUDA,TIUI)) Q:+TIUI'>0 D
17 . S DA=TIUI,DR=".02;.05",DIC="^TIU(8925.9,",DIQ="TIUPROB"
18 . D EN^DIQ1 Q:$D(TIUPROB)'>9
19 . S TIUC=+$G(TIUC)+1
20 . S TIUP=$$MIXED^TIULS($G(TIUPROB(8925.9,TIUI,.05)))
21 . S TIUX=$$SETSTR^VALM1($J(TIUC,2)_".",$G(TIUX),1,3)
22 . S TIUX=$$SETSTR^VALM1(TIUP,$G(TIUX),5,35)
23 . S TIUP=$G(TIUPROB(8925.9,TIUI,.02))
24 . S TIUX=$$SETSTR^VALM1(TIUP,$G(TIUX),40,6)
25 . S @TIUROOT@(TIUDA,"PROBLEM",(TIUJ+TIUC),0)=TIUX
26 Q
27TEXT(TIUDA,TIUJ,TIUDAD) ; Get each component
28 N TIUKID,TIUDADT,TIUI S TIUI=0
29 F S TIUI=$O(^TIU(8925,+TIUDA,"TEXT",TIUI)) Q:+TIUI'>0 D
30 . S TIUJ=+$G(TIUJ)+1
31 . S @TIUROOT@(TIUDAD,"TEXT",TIUJ,0)=$G(^TIU(8925,+TIUDA,"TEXT",TIUI,0))
32 S @TIUROOT@(TIUDAD,"TEXT",0)="^^"_TIUJ_U_TIUJ_U_DT_"^^"
33 ; Iterate through children, and get their text fields
34 S TIUKID=0
35 F S TIUKID=$O(^TIU(8925,"DAD",+TIUDA,TIUKID)) Q:+TIUKID'>0 D
36 . I +$$ISADDNDM^TIULC1(TIUKID) D
37 . . N TIUADRT
38 . . I TIUROOT[")" S TIUADRT=$P(TIUROOT,")")_","_TIUDAD_",""ZADD"")"
39 . . E S TIUADRT=TIUROOT_"("_TIUDAD_",""ZADD"")"
40 . . D EXTRACT(TIUKID,TIUADRT,.TIUERR,DR,.TIUJ) I 1
41 . E D TEXT(TIUKID,.TIUJ,TIUDAD)
42 Q
Note: See TracBrowser for help on using the repository browser.