VistA-FOIAVistA/r/TEXT_INTEGRATION_UTILITIES-.../TIUFD1.m

79 lines
3.8 KiB
Mathematica

TIUFD1 ; SLC/MAM - LM Template DSUPLOAD(LASTLIN), DSEMBED(LASTLIN) ;4/28/97 21:36
;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
;
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 S LASTLIN=LINENO
Q
;