TIULAPIS.m

TIULAPIS ; SLC/JER - Extract selected documents from TIU ; 9/19/07 2:39pm

 ;;1.0;TEXT INTEGRATION UTILITIES;**100,121,211,227**;Jun 20, 1997;Build 15

MAIN(DFN,TIUDOC,STATUS,TIME1,TIME2,OCCLIM,TEXT) ; Control branching

 N TIUDA,TIUDT,TIUPRM0,TIUPRM1,TIUPRM3,COUNT,TIUSI,TIUS,TIUTI

 N CANDO,OLDRPARY,TIUDOCI,CKCANVW,ORIGCHLD

 D SETPARM^TIULE

 S:+$G(OCCLIM)'>0 OCCLIM=999

 S:+$G(TIME1)'>0 TIME1=6666666

 S:+$G(TIME2)'>0 TIME2=9999999

 K ^TMP("TIU",$J),^TMP("TIUREPLACE",$J)

 I '$D(TIUPRM0) D SETPARM^TIULE

 I $D(TIUDOC)'>0 Q

 I $D(STATUS)'>9 D STATUS^TIUSRVL(.STATUS,$S($G(STATUS)]"":STATUS,1:"ALL"))

 S TIUTI=0 F  S TIUTI=$O(TIUDOC(TIUTI)) Q:+TIUTI'>0  D  ;TIUTI=1,2,3...

 . S TIUDOC=+$G(TIUDOC(TIUTI)),COUNT=0

 . S TIUSI=0 F  S TIUSI=$O(STATUS(TIUSI)) Q:+TIUSI'>0  D

 . . S TIUS=+$G(STATUS(TIUSI)),TIUDT=TIME1

 . . F  S TIUDT=$O(^TIU(8925,"APT",DFN,TIUDOC,TIUS,TIUDT)) Q:+TIUDT'>0!(TIUDT>TIME2)!(+$G(COUNT)'<OCCLIM)  D

 . . . S TIUDA=0 F  S TIUDA=$O(^TIU(8925,"APT",DFN,TIUDOC,TIUS,TIUDT,TIUDA)) Q:+TIUDA'>0  D

 . . . . I +$$ISADDNDM^TIULC1(TIUDA),+TEXT Q

 . . . . ; -- CKCANVW: If user is viewing, check in REPLACE if user

 . . . . ;    can view, and add record to ^TMP("TIUREPLACE",$J) only if user

 . . . . ;    can view.  Tell EXTRACT it doesn't need to check again

 . . . . ;    when EXTRACT loops thru ^TMP("TIUREPLACE",$J).

 . . . . S CKCANVW=$S($E(IOST,1)="C":1,1:0)

 . . . . I $E(IOST,1)'="C" S CANDO=+$$CANDO^TIULP(TIUDA,"PRINT RECORD") Q:'CANDO  ;TIU*1*91

 . . . . ; -- Since ID children must print as part of the whole ID

 . . . . ;    note, set array ^TMP("TIUREPLACE",$J) of standalone notes

 . . . . ;    and ID parents.

 . . . . ;    Add TIUDA to ^TMP("TIUREPLACE",$J), replacing TIUDA

 . . . . ;    w its ID parent IFN if TIUDA is an ID kid.

 . . . . ;    Raise count of records if "good" element was added

 . . . . ;    to ^TMP("TIUREPLACE",$J).

 . . . . S OLDRPARY=$G(^TMP("TIUREPLACE",$J)) ;How many "GOOD" elements in array

 . . . . D REPLACE^TIUPRPN3(TIUDA,TIUDT,1301,CKCANVW)

 . . . . S COUNT=COUNT+^TMP("TIUREPLACE",$J)-OLDRPARY

 . . . . S ^TMP("TIU",$J,TIUDT,TIUTI,0)=COUNT

 . . . . ; -- Track which title to collate TIUDA with:

 . . . . S TIUDOCI(TIUDA)=TIUTI

 ; -- Loop thru array of standalone or ID parent records and

 ;    set ^TMP("TIU",$J for each record.

 S TIUDA=0

 F  S TIUDA=$O(^TMP("TIUREPLACE",$J,TIUDA)) Q:'TIUDA  D

 . Q:^TMP("TIUREPLACE",$J,TIUDA)=0  ;User can't view

 . S TIUDT=^TMP("TIUREPLACE",$J,TIUDA,"DT")

 . ; -- ORIGCHLD: If a parent is added to array solely on merit

 . ;    of an ID kid, retrieve the child that meets the criteria

 . ;    and collate w child title:

 . S ORIGCHLD=+$P(^TMP("TIUREPLACE",$J,TIUDA),U,2)

 . S TIUTI=$G(TIUDOCI(TIUDA)) I 'TIUTI S TIUTI=$G(TIUDOCI(ORIGCHLD))

 . ;VMP/RJT - *227

 . 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;1601;1701;89261","",1,"IE",CKCANVW,ORIGCHLD)

 K ^TMP("TIUREPLACE",$J)

 Q

TIULAPIS  ; SLC/JER - Extract selected documents from TIU ; 9/19/07 2:39pm

 +1       ;;1.0;TEXT INTEGRATION UTILITIES;**100,121,211,227**;Jun 20, 1997;Build 15

MAIN(DFN,TIUDOC,STATUS,TIME1,TIME2,OCCLIM,TEXT) ; Control branching

 +1        NEW TIUDA,TIUDT,TIUPRM0,TIUPRM1,TIUPRM3,COUNT,TIUSI,TIUS,TIUTI

 +2        NEW CANDO,OLDRPARY,TIUDOCI,CKCANVW,ORIGCHLD

 +3        DO SETPARM^TIULE

 +4        IF +$GET(OCCLIM)'>0

               SET OCCLIM=999

 +5        IF +$GET(TIME1)'>0

               SET TIME1=6666666

 +6        IF +$GET(TIME2)'>0

               SET TIME2=9999999

 +7        KILL ^TMP("TIU",$JOB),^TMP("TIUREPLACE",$JOB)

 +8        IF '$DATA(TIUPRM0)

               DO SETPARM^TIULE

 +9        IF $DATA(TIUDOC)'>0

               QUIT 

 +10       IF $DATA(STATUS)'>9

               DO STATUS^TIUSRVL(.STATUS,$SELECT($GET(STATUS)]"":STATUS,1:"ALL"))

 +11      ;TIUTI=1,2,3...

           SET TIUTI=0

           FOR 

               SET TIUTI=$ORDER(TIUDOC(TIUTI))

               IF +TIUTI'>0

                   QUIT 

               Begin DoDot:1

 +12               SET TIUDOC=+$GET(TIUDOC(TIUTI))

                   SET COUNT=0

 +13               SET TIUSI=0

                   FOR 

                       SET TIUSI=$ORDER(STATUS(TIUSI))

                       IF +TIUSI'>0

                           QUIT 

                       Begin DoDot:2

 +14                       SET TIUS=+$GET(STATUS(TIUSI))

                           SET TIUDT=TIME1

 +15                       FOR 

                               SET TIUDT=$ORDER(^TIU(8925,"APT",DFN,TIUDOC,TIUS,TIUDT))

                               IF +TIUDT'>0!(TIUDT>TIME2)!(+$GET(COUNT)'<OCCLIM)

                                   QUIT 

                               Begin DoDot:3

 +16                               SET TIUDA=0

                                   FOR 

                                       SET TIUDA=$ORDER(^TIU(8925,"APT",DFN,TIUDOC,TIUS,TIUDT,TIUDA))

                                       IF +TIUDA'>0

                                           QUIT 

                                       Begin DoDot:4

 +17                                       IF +$$ISADDNDM^TIULC1(TIUDA)

                                               IF +TEXT

                                                   QUIT 

 +18      ; -- CKCANVW: If user is viewing, check in REPLACE if user

 +19      ;    can view, and add record to ^TMP("TIUREPLACE",$J) only if user

 +20      ;    can view.  Tell EXTRACT it doesn't need to check again

 +21      ;    when EXTRACT loops thru ^TMP("TIUREPLACE",$J).

 +22                                       SET CKCANVW=$SELECT($EXTRACT(IOST,1)="C":1,1:0)

 +23      ;TIU*1*91

                                           IF $EXTRACT(IOST,1)'="C"

                                               SET CANDO=+$$CANDO^TIULP(TIUDA,"PRINT RECORD")

                                               IF 'CANDO

                                                   QUIT 

 +24      ; -- Since ID children must print as part of the whole ID

 +25      ;    note, set array ^TMP("TIUREPLACE",$J) of standalone notes

 +26      ;    and ID parents.

 +27      ;    Add TIUDA to ^TMP("TIUREPLACE",$J), replacing TIUDA

 +28      ;    w its ID parent IFN if TIUDA is an ID kid.

 +29      ;    Raise count of records if "good" element was added

 +30      ;    to ^TMP("TIUREPLACE",$J).

 +31      ;How many "GOOD" elements in array

                                           SET OLDRPARY=$GET(^TMP("TIUREPLACE",$JOB))

 +32                                       DO REPLACE^TIUPRPN3(TIUDA,TIUDT,1301,CKCANVW)

 +33                                       SET COUNT=COUNT+^TMP("TIUREPLACE",$JOB)-OLDRPARY

 +34                                       SET ^TMP("TIU",$JOB,TIUDT,TIUTI,0)=COUNT

 +35      ; -- Track which title to collate TIUDA with:

 +36                                       SET TIUDOCI(TIUDA)=TIUTI

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +37      ; -- Loop thru array of standalone or ID parent records and

 +38      ;    set ^TMP("TIU",$J for each record.

 +39       SET TIUDA=0

 +40       FOR 

               SET TIUDA=$ORDER(^TMP("TIUREPLACE",$JOB,TIUDA))

               IF 'TIUDA

                   QUIT 

               Begin DoDot:1

 +41      ;User can't view

                   IF ^TMP("TIUREPLACE",$JOB,TIUDA)=0

                       QUIT 

 +42               SET TIUDT=^TMP("TIUREPLACE",$JOB,TIUDA,"DT")

 +43      ; -- ORIGCHLD: If a parent is added to array solely on merit

 +44      ;    of an ID kid, retrieve the child that meets the criteria

 +45      ;    and collate w child title:

 +46               SET ORIGCHLD=+$PIECE(^TMP("TIUREPLACE",$JOB,TIUDA),U,2)

 +47               SET TIUTI=$GET(TIUDOCI(TIUDA))

                   IF 'TIUTI

                       SET TIUTI=$GET(TIUDOCI(ORIGCHLD))

 +48      ;VMP/RJT - *227

 +49               DO EXTRACT^TIULQ(TIUDA,"^TMP(""TIU"","_$JOB_","_TIUDT_","_TIUTI_")",.TIUERR,".01;.05;.07;.08;1202;1203;1205;1208;1209;1301;1307;1402;1501:1505;1507:1513;1601;1701;89261","",1,"IE",CKCANVW,ORIGCHLD)

               End DoDot:1

 +50       KILL ^TMP("TIUREPLACE",$JOB)

 +51       QUIT