| [613] | 1 | TIULAPIC ; SLC/JER,KER - Extract selected classes from TIU ; 4/19/06 1:51pm
|
|---|
| 2 | ;;1.0;TEXT INTEGRATION UTILITIES;**83,100,121,211**;Jun 20, 1997;Build 26
|
|---|
| 3 | MAIN(DFN,TIUDOC,TIME1,TIME2,OCCLIM,TEXT) ; Control branching
|
|---|
| 4 | ; Notes for Health Summaries, by Reference Date
|
|---|
| 5 | ; For comments, see rtn TIULAPIS
|
|---|
| 6 | N TIUDA,TIUDT,TIUPRM0,TIUPRM1,TIUPRM3,COUNT,TIUSI,TIUS,TIUTI,TYPES
|
|---|
| 7 | N CANDO,CKCANVW,ORIGCHLD
|
|---|
| 8 | K ^TMP("TIUREPLACE",$J)
|
|---|
| 9 | 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
|
|---|
| 10 | S TIUDT=TIME1 F S TIUDT=$O(^TIU(8925,"APTCL",DFN,TIUDOC,TIUDT)) Q:+TIUDT'>0!(TIUDT>TIME2)!(+$G(COUNT)'<OCCLIM) D
|
|---|
| 11 | . S TIUDA=0 F S TIUDA=$O(^TIU(8925,"APTCL",DFN,TIUDOC,TIUDT,TIUDA)) Q:+TIUDA'>0 D
|
|---|
| 12 | . . I +$$ISADDNDM^TIULC1(TIUDA),+TEXT Q
|
|---|
| 13 | . . S CKCANVW=$S($E(IOST,1)="C":1,1:0)
|
|---|
| 14 | . . I $E(IOST,1)'="C" S CANDO=+$$CANDO^TIULP(TIUDA,"PRINT RECORD") Q:'CANDO ;TIU*1*91
|
|---|
| 15 | . . D REPLACE^TIUPRPN3(TIUDA,TIUDT,1301,CKCANVW)
|
|---|
| 16 | . . S COUNT=^TMP("TIUREPLACE",$J)
|
|---|
| 17 | S TIUDA=0
|
|---|
| 18 | F S TIUDA=$O(^TMP("TIUREPLACE",$J,TIUDA)) Q:'TIUDA D
|
|---|
| 19 | . Q:^TMP("TIUREPLACE",$J,TIUDA)=0 ;not viewable
|
|---|
| 20 | . S TIUDT=^TMP("TIUREPLACE",$J,TIUDA,"DT")
|
|---|
| 21 | . S ORIGCHLD=+$P(^TMP("TIUREPLACE",$J,TIUDA),U,2)
|
|---|
| 22 | . 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;1701;89261","",1,"IE",CKCANVW,ORIGCHLD)
|
|---|
| 23 | K ^TMP("TIUREPLACE",$J)
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | VISIT(DFN,TIUDOC,TIME1,TIME2,OCCLIM,TEXT) ; Control branching
|
|---|
| 27 | ; Visit Date
|
|---|
| 28 | N TIUDA,TIUDT,TIUPRM0,TIUPRM1,TIUPRM3,COUNT,TIUSI,TIUS,TIUTI,TIUVD,TYPES
|
|---|
| 29 | N CANDO,CKCANVW,ORIGCHLD
|
|---|
| 30 | K ^TMP("TIUREPLACE",$J)
|
|---|
| 31 | 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
|
|---|
| 32 | S TIUDT=TIME1 F S TIUDT=$O(^TIU(8925,"AE",DFN,TIUDT)) Q:+TIUDT'>0!(TIUDT>TIME2)!(+$G(COUNT)'<OCCLIM) D
|
|---|
| 33 | . S TIUVD=0 F S TIUVD=$O(^TIU(8925,"AE",DFN,TIUDT,TIUVD)) Q:+TIUVD'>0 D
|
|---|
| 34 | . . S TIUDA=0 F S TIUDA=$O(^TIU(8925,"AE",DFN,TIUDT,TIUVD,TIUDA)) Q:+TIUDA'>0 D
|
|---|
| 35 | . . . N TIUIVD,TIUIRD S TIUIVD=(9999999-TIUDT),TIUIRD=+($P($G(^TIU(8925,+TIUDA,13)),"^",1))
|
|---|
| 36 | . . . Q:'$D(^TIU(8925,"APTCL",DFN,TIUDOC,(9999999-TIUIRD)))
|
|---|
| 37 | . . . I +$$ISADDNDM^TIULC1(TIUDA),+TEXT Q
|
|---|
| 38 | . . . S CKCANVW=$S($E(IOST,1)="C":1,1:0)
|
|---|
| 39 | . . . I $E(IOST,1)'="C" S CANDO=+$$CANDO^TIULP(TIUDA,"PRINT RECORD") Q:'CANDO ;TIU*1*91
|
|---|
| 40 | . . . D REPLACE^TIUPRPN3(TIUDA,TIUDT,1301,CKCANVW)
|
|---|
| 41 | . . . S COUNT=^TMP("TIUREPLACE",$J)
|
|---|
| 42 | S TIUDA=0
|
|---|
| 43 | F S TIUDA=$O(^TMP("TIUREPLACE",$J,TIUDA)) Q:'TIUDA D
|
|---|
| 44 | . Q:^TMP("TIUREPLACE",$J,TIUDA)=0
|
|---|
| 45 | . S TIUDT=^TMP("TIUREPLACE",$J,TIUDA,"DT")
|
|---|
| 46 | . S ORIGCHLD=+$P(^TMP("TIUREPLACE",$J,TIUDA),U,2)
|
|---|
| 47 | . 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;1701;89261","",1,"IE",CKCANVW,ORIGCHLD)
|
|---|
| 48 | K ^TMP("TIUREPLACE",$J)
|
|---|
| 49 | Q
|
|---|
