- 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 Jan 18, 2025@03:43:16 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