TIULQ2 ; SLC/JER - Record Extract For Upload Event Display
;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
N DA,DIC,DIQ,TIULQ,X,Y
S TIUROOT=$G(TIUROOT,"^TMP(""TIULQ"",$J)")
S DA=TIUDA,DIC=8925,DIQ="TIULQ",DIQ(0)="IE"
I $G(DR)']"" S DR=".01:.1;1201:1701"
D EN^DIQ1
I '$D(TIULQ) S TIUERR="1^ Record Extract Failed"
M @TIUROOT@(TIUDA)=TIULQ(8925,TIUDA)
D PROBLEMS(DA,+$G(TIULINE))
I +$G(TIUTEXT) D TEXT(TIUDA,+$G(TIULINE),TIUDA)
Q
PROBLEMS(TIUDA,TIUJ) ; Get associated problems
N TIUI,TIUP,TIUPROB,TIUC,TIUX,DR,DIC,DIQ S TIUI=0
F S TIUI=$O(^TIU(8925.9,"B",+TIUDA,TIUI)) Q:+TIUI'>0 D
. S DA=TIUI,DR=".02;.05",DIC="^TIU(8925.9,",DIQ="TIUPROB"
. D EN^DIQ1 Q:$D(TIUPROB)'>9
. S TIUC=+$G(TIUC)+1
. S TIUP=$$MIXED^TIULS($G(TIUPROB(8925.9,TIUI,.05)))
. S TIUX=$$SETSTR^VALM1($J(TIUC,2)_".",$G(TIUX),1,3)
. S TIUX=$$SETSTR^VALM1(TIUP,$G(TIUX),5,35)
. S TIUP=$G(TIUPROB(8925.9,TIUI,.02))
. S TIUX=$$SETSTR^VALM1(TIUP,$G(TIUX),40,6)
. S @TIUROOT@(TIUDA,"PROBLEM",(TIUJ+TIUC),0)=TIUX
Q
TEXT(TIUDA,TIUJ,TIUDAD) ; Get each component
N TIUKID,TIUDADT,TIUI S TIUI=0
F S TIUI=$O(^TIU(8925,+TIUDA,"TEXT",TIUI)) Q:+TIUI'>0 D
. S TIUJ=+$G(TIUJ)+1
. S @TIUROOT@(TIUDAD,"TEXT",TIUJ,0)=$G(^TIU(8925,+TIUDA,"TEXT",TIUI,0))
S @TIUROOT@(TIUDAD,"TEXT",0)="^^"_TIUJ_U_TIUJ_U_DT_"^^"
; Iterate through children, and get their text fields
S TIUKID=0
F S TIUKID=$O(^TIU(8925,"DAD",+TIUDA,TIUKID)) Q:+TIUKID'>0 D
. I +$$ISADDNDM^TIULC1(TIUKID) D
. . N TIUADRT
. . I TIUROOT[")" S TIUADRT=$P(TIUROOT,")")_","_TIUDAD_",""ZADD"")"
. . E S TIUADRT=TIUROOT_"("_TIUDAD_",""ZADD"")"
. . D EXTRACT(TIUKID,TIUADRT,.TIUERR,DR,.TIUJ) I 1
. E D TEXT(TIUKID,.TIUJ,TIUDAD)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIULQ2 1787 printed Dec 13, 2024@02:42:25 Page 2
TIULQ2 ; SLC/JER - Record Extract For Upload Event Display
+1 ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
+1 NEW DA,DIC,DIQ,TIULQ,X,Y
+2 SET TIUROOT=$GET(TIUROOT,"^TMP(""TIULQ"",$J)")
+3 SET DA=TIUDA
SET DIC=8925
SET DIQ="TIULQ"
SET DIQ(0)="IE"
+4 IF $GET(DR)']""
SET DR=".01:.1;1201:1701"
+5 DO EN^DIQ1
+6 IF '$DATA(TIULQ)
SET TIUERR="1^ Record Extract Failed"
+7 MERGE @TIUROOT@(TIUDA)=TIULQ(8925,TIUDA)
+8 DO PROBLEMS(DA,+$GET(TIULINE))
+9 IF +$GET(TIUTEXT)
DO TEXT(TIUDA,+$GET(TIULINE),TIUDA)
+10 QUIT
PROBLEMS(TIUDA,TIUJ) ; Get associated problems
+1 NEW TIUI,TIUP,TIUPROB,TIUC,TIUX,DR,DIC,DIQ
SET TIUI=0
+2 FOR
SET TIUI=$ORDER(^TIU(8925.9,"B",+TIUDA,TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+3 SET DA=TIUI
SET DR=".02;.05"
SET DIC="^TIU(8925.9,"
SET DIQ="TIUPROB"
+4 DO EN^DIQ1
if $DATA(TIUPROB)'>9
QUIT
+5 SET TIUC=+$GET(TIUC)+1
+6 SET TIUP=$$MIXED^TIULS($GET(TIUPROB(8925.9,TIUI,.05)))
+7 SET TIUX=$$SETSTR^VALM1($JUSTIFY(TIUC,2)_".",$GET(TIUX),1,3)
+8 SET TIUX=$$SETSTR^VALM1(TIUP,$GET(TIUX),5,35)
+9 SET TIUP=$GET(TIUPROB(8925.9,TIUI,.02))
+10 SET TIUX=$$SETSTR^VALM1(TIUP,$GET(TIUX),40,6)
+11 SET @TIUROOT@(TIUDA,"PROBLEM",(TIUJ+TIUC),0)=TIUX
End DoDot:1
+12 QUIT
TEXT(TIUDA,TIUJ,TIUDAD) ; Get each component
+1 NEW TIUKID,TIUDADT,TIUI
SET TIUI=0
+2 FOR
SET TIUI=$ORDER(^TIU(8925,+TIUDA,"TEXT",TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+3 SET TIUJ=+$GET(TIUJ)+1
+4 SET @TIUROOT@(TIUDAD,"TEXT",TIUJ,0)=$GET(^TIU(8925,+TIUDA,"TEXT",TIUI,0))
End DoDot:1
+5 SET @TIUROOT@(TIUDAD,"TEXT",0)="^^"_TIUJ_U_TIUJ_U_DT_"^^"
+6 ; Iterate through children, and get their text fields
+7 SET TIUKID=0
+8 FOR
SET TIUKID=$ORDER(^TIU(8925,"DAD",+TIUDA,TIUKID))
if +TIUKID'>0
QUIT
Begin DoDot:1
+9 IF +$$ISADDNDM^TIULC1(TIUKID)
Begin DoDot:2
+10 NEW TIUADRT
+11 IF TIUROOT[")"
SET TIUADRT=$PIECE(TIUROOT,")")_","_TIUDAD_",""ZADD"")"
+12 IF '$TEST
SET TIUADRT=TIUROOT_"("_TIUDAD_",""ZADD"")"
+13 DO EXTRACT(TIUKID,TIUADRT,.TIUERR,DR,.TIUJ)
IF 1
End DoDot:2
+14 IF '$TEST
DO TEXT(TIUKID,.TIUJ,TIUDAD)
End DoDot:1
+15 QUIT
