TIULAPIC ; SLC/JER,KER - Extract selected classes from TIU ; 9/19/07 2:38pm
;;1.0;TEXT INTEGRATION UTILITIES;**83,100,121,211,227**;Jun 20, 1997;Build 15
MAIN(DFN,TIUDOC,TIME1,TIME2,OCCLIM,TEXT) ; Control branching
; Notes for Health Summaries, by Reference Date
; For comments, see rtn TIULAPIS
N TIUDA,TIUDT,TIUPRM0,TIUPRM1,TIUPRM3,COUNT,TIUSI,TIUS,TIUTI,TYPES
N CANDO,CKCANVW,ORIGCHLD
K ^TMP("TIUREPLACE",$J)
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) I '$D(TIUPRM0) D SETPARM^TIULE
S TIUDT=TIME1 F S TIUDT=$O(^TIU(8925,"APTCL",DFN,TIUDOC,TIUDT)) Q:+TIUDT'>0!(TIUDT>TIME2)!(+$G(COUNT)'<OCCLIM) D
. S TIUDA=0 F S TIUDA=$O(^TIU(8925,"APTCL",DFN,TIUDOC,TIUDT,TIUDA)) Q:+TIUDA'>0 D
. . I +$$ISADDNDM^TIULC1(TIUDA),+TEXT Q
. . 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
. . D REPLACE^TIUPRPN3(TIUDA,TIUDT,1301,CKCANVW)
. . S COUNT=^TMP("TIUREPLACE",$J)
S TIUDA=0
F S TIUDA=$O(^TMP("TIUREPLACE",$J,TIUDA)) Q:'TIUDA D
. Q:^TMP("TIUREPLACE",$J,TIUDA)=0 ;not viewable
. S TIUDT=^TMP("TIUREPLACE",$J,TIUDA,"DT")
. S ORIGCHLD=+$P(^TMP("TIUREPLACE",$J,TIUDA),U,2)
. ;VMP/RJT - *227
. D EXTRACT^TIULQ(TIUDA,"^TMP(""TIU"",$J,"_TIUDT_")",.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
;
VISIT(DFN,TIUDOC,TIME1,TIME2,OCCLIM,TEXT) ; Control branching
; Visit Date
N TIUDA,TIUDT,TIUPRM0,TIUPRM1,TIUPRM3,COUNT,TIUSI,TIUS,TIUTI,TIUVD,TYPES
N CANDO,CKCANVW,ORIGCHLD
K ^TMP("TIUREPLACE",$J)
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) I '$D(TIUPRM0) D SETPARM^TIULE
S TIUDT=TIME1 F S TIUDT=$O(^TIU(8925,"AE",DFN,TIUDT)) Q:+TIUDT'>0!(TIUDT>TIME2)!(+$G(COUNT)'<OCCLIM) D
. S TIUVD=0 F S TIUVD=$O(^TIU(8925,"AE",DFN,TIUDT,TIUVD)) Q:+TIUVD'>0 D
. . S TIUDA=0 F S TIUDA=$O(^TIU(8925,"AE",DFN,TIUDT,TIUVD,TIUDA)) Q:+TIUDA'>0 D
. . . N TIUIVD,TIUIRD S TIUIVD=(9999999-TIUDT),TIUIRD=+($P($G(^TIU(8925,+TIUDA,13)),"^",1))
. . . Q:'$D(^TIU(8925,"APTCL",DFN,TIUDOC,(9999999-TIUIRD)))
. . . I +$$ISADDNDM^TIULC1(TIUDA),+TEXT Q
. . . 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
. . . D REPLACE^TIUPRPN3(TIUDA,TIUDT,1301,CKCANVW)
. . . S COUNT=^TMP("TIUREPLACE",$J)
S TIUDA=0
F S TIUDA=$O(^TMP("TIUREPLACE",$J,TIUDA)) Q:'TIUDA D
. Q:^TMP("TIUREPLACE",$J,TIUDA)=0
. S TIUDT=^TMP("TIUREPLACE",$J,TIUDA,"DT")
. S ORIGCHLD=+$P(^TMP("TIUREPLACE",$J,TIUDA),U,2)
. ;VMP/RJT - *227
. D EXTRACT^TIULQ(TIUDA,"^TMP(""TIU"",$J,"_(TIUDT)_")",.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[HTIULAPIC 2989 printed Apr 09, 2024@21:46:07 Page 2
TIULAPIC ; SLC/JER,KER - Extract selected classes from TIU ; 9/19/07 2:38pm
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**83,100,121,211,227**;Jun 20, 1997;Build 15
MAIN(DFN,TIUDOC,TIME1,TIME2,OCCLIM,TEXT) ; Control branching
+1 ; Notes for Health Summaries, by Reference Date
+2 ; For comments, see rtn TIULAPIS
+3 NEW TIUDA,TIUDT,TIUPRM0,TIUPRM1,TIUPRM3,COUNT,TIUSI,TIUS,TIUTI,TYPES
+4 NEW CANDO,CKCANVW,ORIGCHLD
+5 KILL ^TMP("TIUREPLACE",$JOB)
+6 DO SETPARM^TIULE
if +$GET(OCCLIM)'>0
SET OCCLIM=999
if +$GET(TIME1)'>0
SET TIME1=6666666
if +$GET(TIME2)'>0
SET TIME2=9999999
KILL ^TMP("TIU",$JOB)
IF '$DATA(TIUPRM0)
DO SETPARM^TIULE
+7 SET TIUDT=TIME1
FOR
SET TIUDT=$ORDER(^TIU(8925,"APTCL",DFN,TIUDOC,TIUDT))
if +TIUDT'>0!(TIUDT>TIME2)!(+$GET(COUNT)'<OCCLIM)
QUIT
Begin DoDot:1
+8 SET TIUDA=0
FOR
SET TIUDA=$ORDER(^TIU(8925,"APTCL",DFN,TIUDOC,TIUDT,TIUDA))
if +TIUDA'>0
QUIT
Begin DoDot:2
+9 IF +$$ISADDNDM^TIULC1(TIUDA)
IF +TEXT
QUIT
+10 SET CKCANVW=$SELECT($EXTRACT(IOST,1)="C":1,1:0)
+11 ;TIU*1*91
IF $EXTRACT(IOST,1)'="C"
SET CANDO=+$$CANDO^TIULP(TIUDA,"PRINT RECORD")
if 'CANDO
QUIT
+12 DO REPLACE^TIUPRPN3(TIUDA,TIUDT,1301,CKCANVW)
+13 SET COUNT=^TMP("TIUREPLACE",$JOB)
End DoDot:2
End DoDot:1
+14 SET TIUDA=0
+15 FOR
SET TIUDA=$ORDER(^TMP("TIUREPLACE",$JOB,TIUDA))
if 'TIUDA
QUIT
Begin DoDot:1
+16 ;not viewable
if ^TMP("TIUREPLACE",$JOB,TIUDA)=0
QUIT
+17 SET TIUDT=^TMP("TIUREPLACE",$JOB,TIUDA,"DT")
+18 SET ORIGCHLD=+$PIECE(^TMP("TIUREPLACE",$JOB,TIUDA),U,2)
+19 ;VMP/RJT - *227
+20 DO EXTRACT^TIULQ(TIUDA,"^TMP(""TIU"",$J,"_TIUDT_")",.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
+21 KILL ^TMP("TIUREPLACE",$JOB)
+22 QUIT
+23 ;
VISIT(DFN,TIUDOC,TIME1,TIME2,OCCLIM,TEXT) ; Control branching
+1 ; Visit Date
+2 NEW TIUDA,TIUDT,TIUPRM0,TIUPRM1,TIUPRM3,COUNT,TIUSI,TIUS,TIUTI,TIUVD,TYPES
+3 NEW CANDO,CKCANVW,ORIGCHLD
+4 KILL ^TMP("TIUREPLACE",$JOB)
+5 DO SETPARM^TIULE
if +$GET(OCCLIM)'>0
SET OCCLIM=999
if +$GET(TIME1)'>0
SET TIME1=6666666
if +$GET(TIME2)'>0
SET TIME2=9999999
KILL ^TMP("TIU",$JOB)
IF '$DATA(TIUPRM0)
DO SETPARM^TIULE
+6 SET TIUDT=TIME1
FOR
SET TIUDT=$ORDER(^TIU(8925,"AE",DFN,TIUDT))
if +TIUDT'>0!(TIUDT>TIME2)!(+$GET(COUNT)'<OCCLIM)
QUIT
Begin DoDot:1
+7 SET TIUVD=0
FOR
SET TIUVD=$ORDER(^TIU(8925,"AE",DFN,TIUDT,TIUVD))
if +TIUVD'>0
QUIT
Begin DoDot:2
+8 SET TIUDA=0
FOR
SET TIUDA=$ORDER(^TIU(8925,"AE",DFN,TIUDT,TIUVD,TIUDA))
if +TIUDA'>0
QUIT
Begin DoDot:3
+9 NEW TIUIVD,TIUIRD
SET TIUIVD=(9999999-TIUDT)
SET TIUIRD=+($PIECE($GET(^TIU(8925,+TIUDA,13)),"^",1))
+10 if '$DATA(^TIU(8925,"APTCL",DFN,TIUDOC,(9999999-TIUIRD)))
QUIT
+11 IF +$$ISADDNDM^TIULC1(TIUDA)
IF +TEXT
QUIT
+12 SET CKCANVW=$SELECT($EXTRACT(IOST,1)="C":1,1:0)
+13 ;TIU*1*91
IF $EXTRACT(IOST,1)'="C"
SET CANDO=+$$CANDO^TIULP(TIUDA,"PRINT RECORD")
if 'CANDO
QUIT
+14 DO REPLACE^TIUPRPN3(TIUDA,TIUDT,1301,CKCANVW)
+15 SET COUNT=^TMP("TIUREPLACE",$JOB)
End DoDot:3
End DoDot:2
End DoDot:1
+16 SET TIUDA=0
+17 FOR
SET TIUDA=$ORDER(^TMP("TIUREPLACE",$JOB,TIUDA))
if 'TIUDA
QUIT
Begin DoDot:1
+18 if ^TMP("TIUREPLACE",$JOB,TIUDA)=0
QUIT
+19 SET TIUDT=^TMP("TIUREPLACE",$JOB,TIUDA,"DT")
+20 SET ORIGCHLD=+$PIECE(^TMP("TIUREPLACE",$JOB,TIUDA),U,2)
+21 ;VMP/RJT - *227
+22 DO EXTRACT^TIULQ(TIUDA,"^TMP(""TIU"",$J,"_(TIUDT)_")",.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
+23 KILL ^TMP("TIUREPLACE",$JOB)
+24 QUIT
