TIULQ2.m

TIULQ2 ; SLC/JER - Record Extract For Upload Event Display

 ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997

EXTRACT(TIUDA,TIUROOT,TIUERR,DR,TIULINE,TIUTEXT) ; Gets record & addenda

 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 ---TIULQ2   1787     printed  Apr 09, 2024@21:48:01                                                                                                                                                                                                      Page 2

TIULQ2    ; SLC/JER - Record Extract For Upload Event Display

 +1       ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997

EXTRACT(TIUDA,TIUROOT,TIUERR,DR,TIULINE,TIUTEXT) ; Gets record & addenda

 +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