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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIULAPIS 3034 printed Dec 13, 2024@02:42:07 Page 2
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
