TIUO70 ; SLC/JM - TIU Object Export Routine ; 4/9/99@13:30:53
;;1.0;TEXT INTEGRATION UTILITIES;**70**;Jun 20, 1997
Q
INSTALL N FILENUM,TAG,ROUTINE,TEXTLINE,FLDNUMS,XPDIDTOT,DIERR,DISYS,%1
S FILENUM=8925.1
S U="^",ROUTINE=""
S XPDIDTOT=1
F TAG=1:1:1 D
.N FLD,IDX,IEN,RECORD,DATA,FIELD,TIUFPRIV,ADDCMD
.S IDX=0,TIUFPRIV=1
.F D Q:RECORD=""
..S IDX=IDX+1
..S TEXTLINE="EN"_TAG_"+"_IDX_U_"TIUO70"
..I $L($T(@(TEXTLINE_ROUTINE)))'>0 D
...I ROUTINE="" S ROUTINE="A"
...E S ROUTINE=$C($A(ROUTINE)+1)
..S RECORD=$P($T(@("EN"_TAG_"+"_IDX_U_"TIUO70"_ROUTINE)),";;",2)
..I RECORD'="" D
...S FIELD=$P(RECORD,U,1)
...S DATA=$P(RECORD,U,2,99)
...I IDX=1 D
....S IEN=$$FIND1^DIC(FILENUM,"","X",DATA,"B","I $P(^(0),U,4)=""O""")
....I +IEN'>0 D I 1
.....N ADDCMD,IENLIST
.....D ADD("+1")
.....D UPDATE^DIE("",$NA(ADDCMD),$NA(IENLIST))
.....S IEN=IENLIST(1)
....E D
.....N DELCMD
.....K ^TMP("TIUOBJINS",$J)
.....D GETS^DIQ(FILENUM,IEN,"*","N",$NA(^TMP("TIUOBJINS",$J)))
.....S FLD=0
.....F S FLD=$O(^TMP("TIUOBJINS",$J,FILENUM,IEN_",",FLD)) Q:'FLD D
......I FLD'=.01 D
.......S DELCMD(FILENUM,IEN_",",FLD)="@"
.....D FILE^DIE("",$NA(DELCMD))
.....K ^TMP("TIUOBJINS",$J)
...D ADD(IEN)
.D FILE^DIE("E",$NA(ADDCMD))
.D UPDATE^XPDID(TAG)
K ^TMP("DIERR",$J)
Q
ADD(IEN) ;
I '$D(FLDNUMS(FIELD)) D
.S FLDNUMS(FIELD)=$$FLDNUM^DILFD(FILENUM,FIELD)
S ADDCMD(FILENUM,IEN_",",FLDNUMS(FIELD))=DATA
Q
EN1 ;TIU Object:PAIN
;;NAME^PAIN
;;ABBREVIATION^PAIN
;;PRINT NAME^PAIN
;;TYPE^OBJECT
;;CLASS OWNER^CLINICAL COORDINATOR
;;STATUS^ACTIVE
;;OBJECT METHOD^S X=$$PAIN^TIULO(+$G(DFN))
;;TIMESTAMP^57807,40699
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUO70 1686 printed Apr 09, 2024@21:41:49 Page 2
TIUO70 ; SLC/JM - TIU Object Export Routine ; 4/9/99@13:30:53
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**70**;Jun 20, 1997
+2 QUIT
INSTALL NEW FILENUM,TAG,ROUTINE,TEXTLINE,FLDNUMS,XPDIDTOT,DIERR,DISYS,%1
+1 SET FILENUM=8925.1
+2 SET U="^"
SET ROUTINE=""
+3 SET XPDIDTOT=1
+4 FOR TAG=1:1:1
Begin DoDot:1
+5 NEW FLD,IDX,IEN,RECORD,DATA,FIELD,TIUFPRIV,ADDCMD
+6 SET IDX=0
SET TIUFPRIV=1
+7 FOR
Begin DoDot:2
+8 SET IDX=IDX+1
+9 SET TEXTLINE="EN"_TAG_"+"_IDX_U_"TIUO70"
+10 IF $LENGTH($TEXT(@(TEXTLINE_ROUTINE)))'>0
Begin DoDot:3
+11 IF ROUTINE=""
SET ROUTINE="A"
+12 IF '$TEST
SET ROUTINE=$CHAR($ASCII(ROUTINE)+1)
End DoDot:3
+13 SET RECORD=$PIECE($TEXT(@("EN"_TAG_"+"_IDX_U_"TIUO70"_ROUTINE)),";;",2)
+14 IF RECORD'=""
Begin DoDot:3
+15 SET FIELD=$PIECE(RECORD,U,1)
+16 SET DATA=$PIECE(RECORD,U,2,99)
+17 IF IDX=1
Begin DoDot:4
+18 SET IEN=$$FIND1^DIC(FILENUM,"","X",DATA,"B","I $P(^(0),U,4)=""O""")
+19 IF +IEN'>0
Begin DoDot:5
+20 NEW ADDCMD,IENLIST
+21 DO ADD("+1")
+22 DO UPDATE^DIE("",$NAME(ADDCMD),$NAME(IENLIST))
+23 SET IEN=IENLIST(1)
End DoDot:5
IF 1
+24 IF '$TEST
Begin DoDot:5
+25 NEW DELCMD
+26 KILL ^TMP("TIUOBJINS",$JOB)
+27 DO GETS^DIQ(FILENUM,IEN,"*","N",$NAME(^TMP("TIUOBJINS",$JOB)))
+28 SET FLD=0
+29 FOR
SET FLD=$ORDER(^TMP("TIUOBJINS",$JOB,FILENUM,IEN_",",FLD))
if 'FLD
QUIT
Begin DoDot:6
+30 IF FLD'=.01
Begin DoDot:7
+31 SET DELCMD(FILENUM,IEN_",",FLD)="@"
End DoDot:7
End DoDot:6
+32 DO FILE^DIE("",$NAME(DELCMD))
+33 KILL ^TMP("TIUOBJINS",$JOB)
End DoDot:5
End DoDot:4
+34 DO ADD(IEN)
End DoDot:3
End DoDot:2
if RECORD=""
QUIT
+35 DO FILE^DIE("E",$NAME(ADDCMD))
+36 DO UPDATE^XPDID(TAG)
End DoDot:1
+37 KILL ^TMP("DIERR",$JOB)
+38 QUIT
ADD(IEN) ;
+1 IF '$DATA(FLDNUMS(FIELD))
Begin DoDot:1
+2 SET FLDNUMS(FIELD)=$$FLDNUM^DILFD(FILENUM,FIELD)
End DoDot:1
+3 SET ADDCMD(FILENUM,IEN_",",FLDNUMS(FIELD))=DATA
+4 QUIT
EN1 ;TIU Object:PAIN
+1 ;;NAME^PAIN
+2 ;;ABBREVIATION^PAIN
+3 ;;PRINT NAME^PAIN
+4 ;;TYPE^OBJECT
+5 ;;CLASS OWNER^CLINICAL COORDINATOR
+6 ;;STATUS^ACTIVE
+7 ;;OBJECT METHOD^S X=$$PAIN^TIULO(+$G(DFN))
+8 ;;TIMESTAMP^57807,40699
