TIUFD1 ; SLC/MAM - LM Template DSUPLOAD(LASTLIN), DSEMBED(LASTLIN) ;03-Jan-2006 11:20;MGH
;;1.0;TEXT INTEGRATION UTILITIES;**1003**;Jun 20, 1997
;IHS/CIA/MGH Added line to call routine to display the description
;
DSEMBED(LASTLIN) ; Set/Update Display Array TIUF3 starting with Object Embedded in Titles
; See DSBASICS for required variables, etc.
; Called by subtemplate D when OBJECTDA is object
; Sets ^TMP("TIUFEMBED",$J,OBJECTDA,SUBSCPT,"ANY",FILEDA), for SUBSCPTs
;TIUFTL,TIUFCO,TIUFORPHAN.
N LINENO,TITLEDA,OBJECTDA,TIUREC,NODE0,IFN,TYPE,HASIT,OLDLNO,INFO
N ORPHANDA
S LINENO=LASTLIN,OBJECTDA=TIUFINFO("FILEDA"),TYPE=$P(TIUFNOD0,U,4)
S TIUFELIN=LASTLIN
I TYPE'="O" G DSEMX
K ^TMP("TIUFEMBED",$J,OBJECTDA) D EMBED^TIUFLJ(OBJECTDA,TIUFNOD0,"ANY",1)
TITLE I '$O(^TMP("TIUFEMBED",$J,OBJECTDA,"TIUFTL","ANY",0)) G ORPHAN
S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)="",IFN=$S("NM"[TIUFWHO:"IFN",1:" ")
S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=" Object is Embedded in Title(s) Status Owner "_IFN
S TITLEDA=0,OLDLNO=LINENO
F S TITLEDA=$O(^TMP("TIUFEMBED",$J,OBJECTDA,"TIUFTL","ANY",TITLEDA)) Q:'TITLEDA D G:$D(DTOUT) DSEMX
. S LINENO=LINENO+1 D NINFO^TIUFLLM(LINENO,TITLEDA,.INFO),PARSE^TIUFLLM(.INFO),NODE0ARR^TIUFLF(TITLEDA,.NODE0) Q:$D(DTOUT)
. D BUFENTRY^TIUFLLM2(.INFO,.NODE0,"O")
D UPDATE^TIUFLLM1("O",LINENO-OLDLNO,OLDLNO) K ^TMP("TIUFB",$J)
ORPHAN I '$O(^TMP("TIUFEMBED",$J,OBJECTDA,"TIUFORPHAN","ANY",0)) G DSEMX
S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)="",IFN=$S("NM"[TIUFWHO:"IFN",1:" ")
S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=" Object is Embedded in Orphan Component(s) Status Owner "_IFN
S ORPHANDA=0,OLDLNO=LINENO
F S ORPHANDA=$O(^TMP("TIUFEMBED",$J,OBJECTDA,"TIUFORPHAN","ANY",ORPHANDA)) Q:'ORPHANDA D G:$D(DTOUT) DSEMX
. S LINENO=LINENO+1 D NINFO^TIUFLLM(LINENO,ORPHANDA,.INFO),PARSE^TIUFLLM(.INFO),NODE0ARR^TIUFLF(ORPHANDA,.NODE0) Q:$D(DTOUT)
. D BUFENTRY^TIUFLLM2(.INFO,.NODE0,"O")
D UPDATE^TIUFLLM1("O",LINENO-OLDLNO,OLDLNO) K ^TMP("TIUFB",$J)
DSEMX S LASTLIN=LINENO Q:$D(DTOUT) D DSUPLOAD(.LASTLIN)
Q
;
DSUPLOAD(LASTLIN) ; Set/Update Display Array TIUF3 starting with Upload.
; See DSBASICS for required variables, etc.
; CAlled by subtemp D and T
N LINENO,CNT,TIUI,FILEDA,FLDNO,HEADFLG,ITEMFLG,TIUM,CAPDEL
N DIC,DR,DIQ,DA,TARGET,AFILEDA,TYPE,SUBFLDNO
S (TIUFULIN,LINENO)=LASTLIN,TYPE=$P(TIUFNOD0,U,4)
I "NM"'[TIUFWHO G DSUPX
I TYPE'="CL",TYPE'="DC",TYPE'="DOC" G DSUPX
;If called to redisplay edited screen rather than by Init, kill array starting with Upload before resetting array.
S CNT=$O(^TMP("TIUF3",$J,1000000),-1)
F TIUI=LASTLIN+1:1:CNT K ^TMP("TIUF3",$J,TIUI),^TMP("TIUF3IDX",$J,TIUI)
S FILEDA=TIUFINFO("FILEDA")
S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=""
S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=" Upload"
I $G(^TIU(8925.1,FILEDA,1))="",'$D(^TIU(8925.1,FILEDA,"HEAD",0)),'$D(^TIU(8925.1,FILEDA,"ITEM",0)) G DSUPX
K TIUFQ
S DIC=8925.1,DR="1.01:1.03;4;4.5;4.8",DIQ(0)="I,E",DA=FILEDA,DIQ="TIUFQ" D EN^DIQ1
F FLDNO=1.01,1.02,1.03,4,4.5,4.8 D
. D SETFLD^TIUFLD(FILEDA,.LINENO,FLDNO)
. Q
K TIUFQ
UPHEAD ;
S (HEADFLG,ITEMFLG)=0
S:$O(^TIU(8925.1,FILEDA,"HEAD",0)) HEADFLG=1
S:$O(^TIU(8925.1,FILEDA,"ITEM",0)) ITEMFLG=1
F TIUM="HEAD","ITEM" D G:$D(VALMQUIT) DSUPX
. Q:'@(TIUM_"FLG")
. N TIUJ
. I TIUM="HEAD" S CAPDEL=" Captioned",FLDNO=2
. E S CAPDEL=" Delimited",FLDNO=1
. S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=""
. S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=CAPDEL_" ASCII Record Header"
. S TIUJ=0 K TIUFQ
. F S TIUJ=$O(^TIU(8925.1,FILEDA,TIUM,TIUJ)) Q:'TIUJ D Q:$D(VALMQUIT)
. . S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=""
. . S DIC=8925.1,DR=FLDNO,DA=FILEDA,DR(8925.1_FLDNO)=".01:1"
. . S DA(8925.1_FLDNO)=TIUJ,DIQ(0)="I,E",DIQ="TIUFQ" D EN^DIQ1
. . F SUBFLDNO=.01:.01:.04,1,.05:.01:.07 D
. . . D SETFLD^TIUFLD(FILEDA,.LINENO,FLDNO,TIUJ,SUBFLDNO)
. . K TIUFQ
. . Q
. Q
DSUPX ; IHS/CIA/MGH ADDED LINES FOR DESCRIPTION MGH
;S LASTLIN=LINENO
K TIUFQ S LASTLIN=LINENO Q:$D(DTOUT) D DESC^BTIUFD(.LASTLIN)
Q
;
TIUFD1 ; SLC/MAM - LM Template DSUPLOAD(LASTLIN), DSEMBED(LASTLIN) ;03-Jan-2006 11:20;MGH
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**1003**;Jun 20, 1997
+2 ;IHS/CIA/MGH Added line to call routine to display the description
+3 ;
DSEMBED(LASTLIN) ; Set/Update Display Array TIUF3 starting with Object Embedded in Titles
+1 ; See DSBASICS for required variables, etc.
+2 ; Called by subtemplate D when OBJECTDA is object
+3 ; Sets ^TMP("TIUFEMBED",$J,OBJECTDA,SUBSCPT,"ANY",FILEDA), for SUBSCPTs
+4 ;TIUFTL,TIUFCO,TIUFORPHAN.
+5 NEW LINENO,TITLEDA,OBJECTDA,TIUREC,NODE0,IFN,TYPE,HASIT,OLDLNO,INFO
+6 NEW ORPHANDA
+7 SET LINENO=LASTLIN
SET OBJECTDA=TIUFINFO("FILEDA")
SET TYPE=$PIECE(TIUFNOD0,U,4)
+8 SET TIUFELIN=LASTLIN
+9 IF TYPE'="O"
GOTO DSEMX
+10 KILL ^TMP("TIUFEMBED",$JOB,OBJECTDA)
DO EMBED^TIUFLJ(OBJECTDA,TIUFNOD0,"ANY",1)
TITLE IF '$ORDER(^TMP("TIUFEMBED",$JOB,OBJECTDA,"TIUFTL","ANY",0))
GOTO ORPHAN
+1 SET LINENO=LINENO+1
SET ^TMP("TIUF3",$JOB,LINENO,0)=""
SET IFN=$SELECT("NM"[TIUFWHO:"IFN",1:" ")
+2 SET LINENO=LINENO+1
SET ^TMP("TIUF3",$JOB,LINENO,0)=" Object is Embedded in Title(s) Status Owner "_IFN
+3 SET TITLEDA=0
SET OLDLNO=LINENO
+4 FOR
SET TITLEDA=$ORDER(^TMP("TIUFEMBED",$JOB,OBJECTDA,"TIUFTL","ANY",TITLEDA))
IF 'TITLEDA
QUIT
Begin DoDot:1
+5 SET LINENO=LINENO+1
DO NINFO^TIUFLLM(LINENO,TITLEDA,.INFO)
DO PARSE^TIUFLLM(.INFO)
DO NODE0ARR^TIUFLF(TITLEDA,.NODE0)
IF $DATA(DTOUT)
QUIT
+6 DO BUFENTRY^TIUFLLM2(.INFO,.NODE0,"O")
End DoDot:1
IF $DATA(DTOUT)
GOTO DSEMX
+7 DO UPDATE^TIUFLLM1("O",LINENO-OLDLNO,OLDLNO)
KILL ^TMP("TIUFB",$JOB)
ORPHAN IF '$ORDER(^TMP("TIUFEMBED",$JOB,OBJECTDA,"TIUFORPHAN","ANY",0))
GOTO DSEMX
+1 SET LINENO=LINENO+1
SET ^TMP("TIUF3",$JOB,LINENO,0)=""
SET IFN=$SELECT("NM"[TIUFWHO:"IFN",1:" ")
+2 SET LINENO=LINENO+1
SET ^TMP("TIUF3",$JOB,LINENO,0)=" Object is Embedded in Orphan Component(s) Status Owner "_IFN
+3 SET ORPHANDA=0
SET OLDLNO=LINENO
+4 FOR
SET ORPHANDA=$ORDER(^TMP("TIUFEMBED",$JOB,OBJECTDA,"TIUFORPHAN","ANY",ORPHANDA))
IF 'ORPHANDA
QUIT
Begin DoDot:1
+5 SET LINENO=LINENO+1
DO NINFO^TIUFLLM(LINENO,ORPHANDA,.INFO)
DO PARSE^TIUFLLM(.INFO)
DO NODE0ARR^TIUFLF(ORPHANDA,.NODE0)
IF $DATA(DTOUT)
QUIT
+6 DO BUFENTRY^TIUFLLM2(.INFO,.NODE0,"O")
End DoDot:1
IF $DATA(DTOUT)
GOTO DSEMX
+7 DO UPDATE^TIUFLLM1("O",LINENO-OLDLNO,OLDLNO)
KILL ^TMP("TIUFB",$JOB)
DSEMX SET LASTLIN=LINENO
IF $DATA(DTOUT)
QUIT
DO DSUPLOAD(.LASTLIN)
+1 QUIT
+2 ;
DSUPLOAD(LASTLIN) ; Set/Update Display Array TIUF3 starting with Upload.
+1 ; See DSBASICS for required variables, etc.
+2 ; CAlled by subtemp D and T
+3 NEW LINENO,CNT,TIUI,FILEDA,FLDNO,HEADFLG,ITEMFLG,TIUM,CAPDEL
+4 NEW DIC,DR,DIQ,DA,TARGET,AFILEDA,TYPE,SUBFLDNO
+5 SET (TIUFULIN,LINENO)=LASTLIN
SET TYPE=$PIECE(TIUFNOD0,U,4)
+6 IF "NM"'[TIUFWHO
GOTO DSUPX
+7 IF TYPE'="CL"
IF TYPE'="DC"
IF TYPE'="DOC"
GOTO DSUPX
+8 ;If called to redisplay edited screen rather than by Init, kill array starting with Upload before resetting array.
+9 SET CNT=$ORDER(^TMP("TIUF3",$JOB,1000000),-1)
+10 FOR TIUI=LASTLIN+1:1:CNT
KILL ^TMP("TIUF3",$JOB,TIUI),^TMP("TIUF3IDX",$JOB,TIUI)
+11 SET FILEDA=TIUFINFO("FILEDA")
+12 SET LINENO=LINENO+1
SET ^TMP("TIUF3",$JOB,LINENO,0)=""
+13 SET LINENO=LINENO+1
SET ^TMP("TIUF3",$JOB,LINENO,0)=" Upload"
+14 IF $GET(^TIU(8925.1,FILEDA,1))=""
IF '$DATA(^TIU(8925.1,FILEDA,"HEAD",0))
IF '$DATA(^TIU(8925.1,FILEDA,"ITEM",0))
GOTO DSUPX
+15 KILL TIUFQ
+16 SET DIC=8925.1
SET DR="1.01:1.03;4;4.5;4.8"
SET DIQ(0)="I,E"
SET DA=FILEDA
SET DIQ="TIUFQ"
DO EN^DIQ1
+17 FOR FLDNO=1.01,1.02,1.03,4,4.5,4.8
Begin DoDot:1
+18 DO SETFLD^TIUFLD(FILEDA,.LINENO,FLDNO)
+19 QUIT
End DoDot:1
+20 KILL TIUFQ
UPHEAD ;
+1 SET (HEADFLG,ITEMFLG)=0
+2 IF $ORDER(^TIU(8925.1,FILEDA,"HEAD",0))
SET HEADFLG=1
+3 IF $ORDER(^TIU(8925.1,FILEDA,"ITEM",0))
SET ITEMFLG=1
+4 FOR TIUM="HEAD","ITEM"
Begin DoDot:1
+5 IF '@(TIUM_"FLG")
QUIT
+6 NEW TIUJ
+7 IF TIUM="HEAD"
SET CAPDEL=" Captioned"
SET FLDNO=2
+8 IF '$TEST
SET CAPDEL=" Delimited"
SET FLDNO=1
+9 SET LINENO=LINENO+1
SET ^TMP("TIUF3",$JOB,LINENO,0)=""
+10 SET LINENO=LINENO+1
SET ^TMP("TIUF3",$JOB,LINENO,0)=CAPDEL_" ASCII Record Header"
+11 SET TIUJ=0
KILL TIUFQ
+12 FOR
SET TIUJ=$ORDER(^TIU(8925.1,FILEDA,TIUM,TIUJ))
IF 'TIUJ
QUIT
Begin DoDot:2
+13 SET LINENO=LINENO+1
SET ^TMP("TIUF3",$JOB,LINENO,0)=""
+14 SET DIC=8925.1
SET DR=FLDNO
SET DA=FILEDA
SET DR(8925.1_FLDNO)=".01:1"
+15 SET DA(8925.1_FLDNO)=TIUJ
SET DIQ(0)="I,E"
SET DIQ="TIUFQ"
DO EN^DIQ1
+16 FOR SUBFLDNO=.01:.01:.04,1,.05:.01:.07
Begin DoDot:3
+17 DO SETFLD^TIUFLD(FILEDA,.LINENO,FLDNO,TIUJ,SUBFLDNO)
End DoDot:3
+18 KILL TIUFQ
+19 QUIT
End DoDot:2
IF $DATA(VALMQUIT)
QUIT
+20 QUIT
End DoDot:1
IF $DATA(VALMQUIT)
GOTO DSUPX
DSUPX ; IHS/CIA/MGH ADDED LINES FOR DESCRIPTION MGH
+1 ;S LASTLIN=LINENO
+2 KILL TIUFQ
SET LASTLIN=LINENO
IF $DATA(DTOUT)
QUIT
DO DESC^BTIUFD(.LASTLIN)
+3 QUIT
+4 ;
