[613] | 1 | TIULQ ; SLC/JER - Record Extract Using FM Retriever ; 3/1/06 3:46pm
|
---|
| 2 | ;;1.0;TEXT INTEGRATION UTILITIES;**19,100,157,211**;Jun 20, 1997;Build 26
|
---|
| 3 | EXTRACT(TIUDA,TIUROOT,TIUERR,DR,TIULINE,TIUTEXT,FORMAT,OVRRIDE,ORIGCHLD) ; Gets record & addenda and ID kids
|
---|
| 4 | ; Do we need a new DBIA here? MARGY
|
---|
| 5 | N DA,DIC,DIQ,TIULQ,X,Y
|
---|
| 6 | S TIUROOT=$G(TIUROOT,"^TMP(""TIULQ"",$J)")
|
---|
| 7 | S DA=TIUDA,DIC=8925,DIQ="TIULQ",DIQ(0)=$G(FORMAT,"IE")
|
---|
| 8 | I $G(DR)']"" S DR=".01:.1;1201:1701;89261"
|
---|
| 9 | D EN^DIQ1
|
---|
| 10 | I '$D(TIULQ) S TIUERR="1^ Record Extract Failed"
|
---|
| 11 | M @TIUROOT@(TIUDA)=TIULQ(8925,TIUDA)
|
---|
| 12 | D XTRASIGN(DA,+$G(TIULINE))
|
---|
| 13 | D PROBLEMS(DA,+$G(TIULINE))
|
---|
| 14 | I +$G(TIUTEXT) D TEXT(TIUDA,+$G(TIULINE),TIUDA,+$G(OVRRIDE),+$G(ORIGCHLD))
|
---|
| 15 | Q
|
---|
| 16 | XTRASIGN(TIUDA,TIUJ) ; Get Extra Signers
|
---|
| 17 | N TIUI,TIUXTRA,TIUC,DR,DIC,DIQ S TIUI=0
|
---|
| 18 | F S TIUI=$O(^TIU(8925.7,"B",+TIUDA,TIUI)) Q:+TIUI'>0 D
|
---|
| 19 | . N TIUDT,TIUSGN,TIUSNM,TIUSTTL,TIUEIEN,TIUENAME
|
---|
| 20 | . S DA=TIUI,DR=".03:.07",DIC="^TIU(8925.7,",DIQ="TIUXTRA",DIQ(0)="IE"
|
---|
| 21 | . D EN^DIQ1 Q:$D(TIUXTRA)'>9
|
---|
| 22 | . S TIUC=+$G(TIUC)+1
|
---|
| 23 | . S TIUEIEN=$G(TIUXTRA(8925.7,DA,.03,"I"))
|
---|
| 24 | . S TIUENAME=$G(TIUXTRA(8925.7,DA,.03,"E"))
|
---|
| 25 | . S TIUDT=$G(TIUXTRA(8925.7,DA,.04,"I"))
|
---|
| 26 | . S TIUSGN=$G(TIUXTRA(8925.7,DA,.05,"I"))
|
---|
| 27 | . S TIUSNM=$G(TIUXTRA(8925.7,DA,.06,"E"))
|
---|
| 28 | . S TIUSTTL=$G(TIUXTRA(8925.7,DA,.07,"E"))
|
---|
| 29 | . S @TIUROOT@(TIUDA,"EXTRASGNR",(TIUJ+TIUC),"EXPIEN")=TIUEIEN
|
---|
| 30 | . S @TIUROOT@(TIUDA,"EXTRASGNR",(TIUJ+TIUC),"EXPNAME")=TIUENAME
|
---|
| 31 | . S @TIUROOT@(TIUDA,"EXTRASGNR",(TIUJ+TIUC),"DATE")=TIUDT
|
---|
| 32 | . S @TIUROOT@(TIUDA,"EXTRASGNR",(TIUJ+TIUC),"EXTRA")=TIUSGN
|
---|
| 33 | . S @TIUROOT@(TIUDA,"EXTRASGNR",(TIUJ+TIUC),"NAME")=TIUSNM
|
---|
| 34 | . S @TIUROOT@(TIUDA,"EXTRASGNR",(TIUJ+TIUC),"TITLE")=TIUSTTL
|
---|
| 35 | Q
|
---|
| 36 | PROBLEMS(TIUDA,TIUJ) ; Get associated problems
|
---|
| 37 | N TIUI,TIUP,TIUPROB,TIUC,TIUX,DR,DIC,DIQ S TIUI=0
|
---|
| 38 | F S TIUI=$O(^TIU(8925.9,"B",+TIUDA,TIUI)) Q:+TIUI'>0 D
|
---|
| 39 | . S DA=TIUI,DR=".02;.05",DIC="^TIU(8925.9,",DIQ="TIUPROB"
|
---|
| 40 | . D EN^DIQ1 Q:$D(TIUPROB)'>9
|
---|
| 41 | . S TIUC=+$G(TIUC)+1
|
---|
| 42 | . S TIUP=$$MIXED^TIULS($G(TIUPROB(8925.9,TIUI,.05)))
|
---|
| 43 | . S TIUX=$$SETSTR^VALM1($J(TIUC,2)_".",$G(TIUX),1,3)
|
---|
| 44 | . S TIUX=$$SETSTR^VALM1(TIUP,$G(TIUX),5,35)
|
---|
| 45 | . S TIUP=$G(TIUPROB(8925.9,TIUI,.02))
|
---|
| 46 | . S TIUX=$$SETSTR^VALM1(TIUP,$G(TIUX),40,6)
|
---|
| 47 | . S @TIUROOT@(TIUDA,"PROBLEM",(TIUJ+TIUC),0)=TIUX
|
---|
| 48 | Q
|
---|
| 49 | TEXT(TIUDA,TIUJ,TIUDAD,TIUOVR,ORIGCHLD) ; Get each component
|
---|
| 50 | N TIUKID,TIUDADT,TIUI,TIUD0,TIULVL,CANPRINT S TIUI=0
|
---|
| 51 | S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIULVL=$P($G(^TIU(8925.1,+TIUD0,0)),U,4)
|
---|
| 52 | S CANPRINT=$S(TIULVL="DOC":$$CANDO^TIULP(TIUDA,"PRINT RECORD"),1:1)
|
---|
| 53 | I +TIUOVR'>0,(+CANPRINT'>0) D Q
|
---|
| 54 | . S TIUJ=+$G(TIUJ)+1
|
---|
| 55 | . S @TIUROOT@(TIUDAD,"TEXT",TIUJ,0)=$P(CANPRINT,U,2)
|
---|
| 56 | . S @TIUROOT@(TIUDAD,"TEXT",0)="^^"_TIUJ_U_TIUJ_U_DT_"^^"
|
---|
| 57 | F S TIUI=$O(^TIU(8925,+TIUDA,"TEXT",TIUI)) Q:+TIUI'>0 D
|
---|
| 58 | . S TIUJ=+$G(TIUJ)+1
|
---|
| 59 | . S @TIUROOT@(TIUDAD,"TEXT",TIUJ,0)=$G(^TIU(8925,+TIUDA,"TEXT",TIUI,0))
|
---|
| 60 | S @TIUROOT@(TIUDAD,"TEXT",0)="^^"_TIUJ_U_TIUJ_U_DT_"^^"
|
---|
| 61 | ; Iterate through children, and get their text fields
|
---|
| 62 | S TIUKID=0
|
---|
| 63 | F S TIUKID=$O(^TIU(8925,"DAD",+TIUDA,TIUKID)) Q:+TIUKID'>0 D
|
---|
| 64 | . I +$$ISADDNDM^TIULC1(TIUKID) D
|
---|
| 65 | . . N TIUADRT
|
---|
| 66 | . . I TIUROOT[")" S TIUADRT=$P(TIUROOT,")")_","_TIUDAD_",""ZADD"")"
|
---|
| 67 | . . E S TIUADRT=TIUROOT_"("_TIUDAD_",""ZADD"")"
|
---|
| 68 | . . D EXTRACT(TIUKID,TIUADRT,.TIUERR,DR,.TIUJ,1) I 1
|
---|
| 69 | . E D TEXT(TIUKID,.TIUJ,TIUDAD,+$G(TIUOVR))
|
---|
| 70 | ; Get ID kids in correct sort order; extract data for each kid:
|
---|
| 71 | Q:'$O(^TIU(8925,"GDAD",TIUDA,0))
|
---|
| 72 | N TIUGDATA,TIUSORT,TIUK,TIUIDKID,TIUIDRT,CTR
|
---|
| 73 | S TIUGDATA=$$IDDATA^TIURECL1(TIUDA)
|
---|
| 74 | S TIUSORT=$P(TIUGDATA,U,4)
|
---|
| 75 | D GETIDKID^TIURECL2(TIUDA,TIUSORT)
|
---|
| 76 | S TIUK=0,CTR=0
|
---|
| 77 | F S TIUK=$O(^TMP("TIUIDKID",$J,TIUDA,TIUK)) Q:'TIUK D
|
---|
| 78 | . S TIUIDKID=^TMP("TIUIDKID",$J,TIUDA,TIUK)
|
---|
| 79 | . N TIUIDRT
|
---|
| 80 | . I TIUROOT[")" S TIUIDRT=$P(TIUROOT,")")_","_TIUDAD_",""ZZID"","_TIUK_")"
|
---|
| 81 | . E S TIUIDRT=TIUROOT_"("_TIUDAD_",""ZZID"","_TIUK_")"
|
---|
| 82 | . D EXTRACT(TIUIDKID,TIUIDRT,.TIUERR,DR,.TIUJ,1)
|
---|
| 83 | . S CTR=CTR+1
|
---|
| 84 | I CTR S @TIUROOT@(TIUDAD,"ZZID",0)=CTR ; How many ID kids TIUDAD has
|
---|
| 85 | ;I CTR,$G(ORIGCHLD) S @TIUROOT@(TIUDAD,"REASON")="Note included because interdisciplinary child meets criteria."
|
---|
| 86 | K ^TMP("TIUIDKID",$J)
|
---|
| 87 | Q
|
---|