| 1 | TIULAPIS ; SLC/JER - Extract selected documents from TIU ; 5/11/06 12:25pm
|
|---|
| 2 | ;;1.0;TEXT INTEGRATION UTILITIES;**100,121,211**;Jun 20, 1997;Build 26
|
|---|
| 3 | MAIN(DFN,TIUDOC,STATUS,TIME1,TIME2,OCCLIM,TEXT) ; Control branching
|
|---|
| 4 | N TIUDA,TIUDT,TIUPRM0,TIUPRM1,TIUPRM3,COUNT,TIUSI,TIUS,TIUTI
|
|---|
| 5 | N CANDO,OLDRPARY,TIUDOCI,CKCANVW,ORIGCHLD
|
|---|
| 6 | D SETPARM^TIULE
|
|---|
| 7 | S:+$G(OCCLIM)'>0 OCCLIM=999
|
|---|
| 8 | S:+$G(TIME1)'>0 TIME1=6666666
|
|---|
| 9 | S:+$G(TIME2)'>0 TIME2=9999999
|
|---|
| 10 | K ^TMP("TIU",$J),^TMP("TIUREPLACE",$J)
|
|---|
| 11 | I '$D(TIUPRM0) D SETPARM^TIULE
|
|---|
| 12 | I $D(TIUDOC)'>0 Q
|
|---|
| 13 | I $D(STATUS)'>9 D STATUS^TIUSRVL(.STATUS,$S($G(STATUS)]"":STATUS,1:"ALL"))
|
|---|
| 14 | S TIUTI=0 F S TIUTI=$O(TIUDOC(TIUTI)) Q:+TIUTI'>0 D ;TIUTI=1,2,3...
|
|---|
| 15 | . S TIUDOC=+$G(TIUDOC(TIUTI)),COUNT=0
|
|---|
| 16 | . S TIUSI=0 F S TIUSI=$O(STATUS(TIUSI)) Q:+TIUSI'>0 D
|
|---|
| 17 | . . S TIUS=+$G(STATUS(TIUSI)),TIUDT=TIME1
|
|---|
| 18 | . . F S TIUDT=$O(^TIU(8925,"APT",DFN,TIUDOC,TIUS,TIUDT)) Q:+TIUDT'>0!(TIUDT>TIME2)!(+$G(COUNT)'<OCCLIM) D
|
|---|
| 19 | . . . S TIUDA=0 F S TIUDA=$O(^TIU(8925,"APT",DFN,TIUDOC,TIUS,TIUDT,TIUDA)) Q:+TIUDA'>0 D
|
|---|
| 20 | . . . . I +$$ISADDNDM^TIULC1(TIUDA),+TEXT Q
|
|---|
| 21 | . . . . ; -- CKCANVW: If user is viewing, check in REPLACE if user
|
|---|
| 22 | . . . . ; can view, and add record to ^TMP("TIUREPLACE",$J) only if user
|
|---|
| 23 | . . . . ; can view. Tell EXTRACT it doesn't need to check again
|
|---|
| 24 | . . . . ; when EXTRACT loops thru ^TMP("TIUREPLACE",$J).
|
|---|
| 25 | . . . . S CKCANVW=$S($E(IOST,1)="C":1,1:0)
|
|---|
| 26 | . . . . I $E(IOST,1)'="C" S CANDO=+$$CANDO^TIULP(TIUDA,"PRINT RECORD") Q:'CANDO ;TIU*1*91
|
|---|
| 27 | . . . . ; -- Since ID children must print as part of the whole ID
|
|---|
| 28 | . . . . ; note, set array ^TMP("TIUREPLACE",$J) of standalone notes
|
|---|
| 29 | . . . . ; and ID parents.
|
|---|
| 30 | . . . . ; Add TIUDA to ^TMP("TIUREPLACE",$J), replacing TIUDA
|
|---|
| 31 | . . . . ; w its ID parent IFN if TIUDA is an ID kid.
|
|---|
| 32 | . . . . ; Raise count of records if "good" element was added
|
|---|
| 33 | . . . . ; to ^TMP("TIUREPLACE",$J).
|
|---|
| 34 | . . . . S OLDRPARY=$G(^TMP("TIUREPLACE",$J)) ;How many "GOOD" elements in array
|
|---|
| 35 | . . . . D REPLACE^TIUPRPN3(TIUDA,TIUDT,1301,CKCANVW)
|
|---|
| 36 | . . . . S COUNT=COUNT+^TMP("TIUREPLACE",$J)-OLDRPARY
|
|---|
| 37 | . . . . S ^TMP("TIU",$J,TIUDT,TIUTI,0)=COUNT
|
|---|
| 38 | . . . . ; -- Track which title to collate TIUDA with:
|
|---|
| 39 | . . . . S TIUDOCI(TIUDA)=TIUTI
|
|---|
| 40 | ; -- Loop thru array of standalone or ID parent records and
|
|---|
| 41 | ; set ^TMP("TIU",$J for each record.
|
|---|
| 42 | S TIUDA=0
|
|---|
| 43 | F S TIUDA=$O(^TMP("TIUREPLACE",$J,TIUDA)) Q:'TIUDA D
|
|---|
| 44 | . Q:^TMP("TIUREPLACE",$J,TIUDA)=0 ;User can't view
|
|---|
| 45 | . S TIUDT=^TMP("TIUREPLACE",$J,TIUDA,"DT")
|
|---|
| 46 | . ; -- ORIGCHLD: If a parent is added to array solely on merit
|
|---|
| 47 | . ; of an ID kid, retrieve the child that meets the criteria
|
|---|
| 48 | . ; and collate w child title:
|
|---|
| 49 | . S ORIGCHLD=+$P(^TMP("TIUREPLACE",$J,TIUDA),U,2)
|
|---|
| 50 | . S TIUTI=$G(TIUDOCI(TIUDA)) I 'TIUTI S TIUTI=$G(TIUDOCI(ORIGCHLD))
|
|---|
| 51 | . D EXTRACT^TIULQ(TIUDA,"^TMP(""TIU"","_$J_","_TIUDT_","_TIUTI_")",.TIUERR,".01;.05;.07;.08;1202;1203;1205;1208;1209;1301;1307;1402;1501:1505;1507:1513;1701;89261","",1,"IE",CKCANVW,ORIGCHLD)
|
|---|
| 52 | K ^TMP("TIUREPLACE",$J)
|
|---|
| 53 | Q
|
|---|
