source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUFD1.m@ 1013

Last change on this file since 1013 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1TIUFD1 ; SLC/MAM - LM Template DSUPLOAD(LASTLIN), DSEMBED(LASTLIN) ;4/28/97 21:36
2 ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
3 ;
4DSEMBED(LASTLIN) ; Set/Update Display Array TIUF3 starting with Object Embedded in Titles
5 ; See DSBASICS for required variables, etc.
6 ; Called by subtemplate D when OBJECTDA is object
7 ; Sets ^TMP("TIUFEMBED",$J,OBJECTDA,SUBSCPT,"ANY",FILEDA), for SUBSCPTs
8 ;TIUFTL,TIUFCO,TIUFORPHAN.
9 N LINENO,TITLEDA,OBJECTDA,TIUREC,NODE0,IFN,TYPE,HASIT,OLDLNO,INFO
10 N ORPHANDA
11 S LINENO=LASTLIN,OBJECTDA=TIUFINFO("FILEDA"),TYPE=$P(TIUFNOD0,U,4)
12 S TIUFELIN=LASTLIN
13 I TYPE'="O" G DSEMX
14 K ^TMP("TIUFEMBED",$J,OBJECTDA) D EMBED^TIUFLJ(OBJECTDA,TIUFNOD0,"ANY",1)
15TITLE I '$O(^TMP("TIUFEMBED",$J,OBJECTDA,"TIUFTL","ANY",0)) G ORPHAN
16 S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)="",IFN=$S("NM"[TIUFWHO:"IFN",1:" ")
17 S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=" Object is Embedded in Title(s) Status Owner "_IFN
18 S TITLEDA=0,OLDLNO=LINENO
19 F S TITLEDA=$O(^TMP("TIUFEMBED",$J,OBJECTDA,"TIUFTL","ANY",TITLEDA)) Q:'TITLEDA D G:$D(DTOUT) DSEMX
20 . S LINENO=LINENO+1 D NINFO^TIUFLLM(LINENO,TITLEDA,.INFO),PARSE^TIUFLLM(.INFO),NODE0ARR^TIUFLF(TITLEDA,.NODE0) Q:$D(DTOUT)
21 . D BUFENTRY^TIUFLLM2(.INFO,.NODE0,"O")
22 D UPDATE^TIUFLLM1("O",LINENO-OLDLNO,OLDLNO) K ^TMP("TIUFB",$J)
23ORPHAN I '$O(^TMP("TIUFEMBED",$J,OBJECTDA,"TIUFORPHAN","ANY",0)) G DSEMX
24 S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)="",IFN=$S("NM"[TIUFWHO:"IFN",1:" ")
25 S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=" Object is Embedded in Orphan Component(s) Status Owner "_IFN
26 S ORPHANDA=0,OLDLNO=LINENO
27 F S ORPHANDA=$O(^TMP("TIUFEMBED",$J,OBJECTDA,"TIUFORPHAN","ANY",ORPHANDA)) Q:'ORPHANDA D G:$D(DTOUT) DSEMX
28 . S LINENO=LINENO+1 D NINFO^TIUFLLM(LINENO,ORPHANDA,.INFO),PARSE^TIUFLLM(.INFO),NODE0ARR^TIUFLF(ORPHANDA,.NODE0) Q:$D(DTOUT)
29 . D BUFENTRY^TIUFLLM2(.INFO,.NODE0,"O")
30 D UPDATE^TIUFLLM1("O",LINENO-OLDLNO,OLDLNO) K ^TMP("TIUFB",$J)
31DSEMX S LASTLIN=LINENO Q:$D(DTOUT) D DSUPLOAD(.LASTLIN)
32 Q
33 ;
34DSUPLOAD(LASTLIN) ; Set/Update Display Array TIUF3 starting with Upload.
35 ; See DSBASICS for required variables, etc.
36 ; CAlled by subtemp D and T
37 N LINENO,CNT,TIUI,FILEDA,FLDNO,HEADFLG,ITEMFLG,TIUM,CAPDEL
38 N DIC,DR,DIQ,DA,TARGET,AFILEDA,TYPE,SUBFLDNO
39 S (TIUFULIN,LINENO)=LASTLIN,TYPE=$P(TIUFNOD0,U,4)
40 I "NM"'[TIUFWHO G DSUPX
41 I TYPE'="CL",TYPE'="DC",TYPE'="DOC" G DSUPX
42 ;If called to redisplay edited screen rather than by Init, kill array starting with Upload before resetting array.
43 S CNT=$O(^TMP("TIUF3",$J,1000000),-1)
44 F TIUI=LASTLIN+1:1:CNT K ^TMP("TIUF3",$J,TIUI),^TMP("TIUF3IDX",$J,TIUI)
45 S FILEDA=TIUFINFO("FILEDA")
46 S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=""
47 S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=" Upload"
48 I $G(^TIU(8925.1,FILEDA,1))="",'$D(^TIU(8925.1,FILEDA,"HEAD",0)),'$D(^TIU(8925.1,FILEDA,"ITEM",0)) G DSUPX
49 K TIUFQ
50 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
51 F FLDNO=1.01,1.02,1.03,4,4.5,4.8 D
52 . D SETFLD^TIUFLD(FILEDA,.LINENO,FLDNO)
53 . Q
54 K TIUFQ
55UPHEAD ;
56 S (HEADFLG,ITEMFLG)=0
57 S:$O(^TIU(8925.1,FILEDA,"HEAD",0)) HEADFLG=1
58 S:$O(^TIU(8925.1,FILEDA,"ITEM",0)) ITEMFLG=1
59 F TIUM="HEAD","ITEM" D G:$D(VALMQUIT) DSUPX
60 . Q:'@(TIUM_"FLG")
61 . N TIUJ
62 . I TIUM="HEAD" S CAPDEL=" Captioned",FLDNO=2
63 . E S CAPDEL=" Delimited",FLDNO=1
64 . S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=""
65 . S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=CAPDEL_" ASCII Record Header"
66 . S TIUJ=0 K TIUFQ
67 . F S TIUJ=$O(^TIU(8925.1,FILEDA,TIUM,TIUJ)) Q:'TIUJ D Q:$D(VALMQUIT)
68 . . S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=""
69 . . S DIC=8925.1,DR=FLDNO,DA=FILEDA,DR(8925.1_FLDNO)=".01:1"
70 . . S DA(8925.1_FLDNO)=TIUJ,DIQ(0)="I,E",DIQ="TIUFQ" D EN^DIQ1
71 . . F SUBFLDNO=.01:.01:.04,1,.05:.01:.07 D
72 . . . D SETFLD^TIUFLD(FILEDA,.LINENO,FLDNO,TIUJ,SUBFLDNO)
73 . . K TIUFQ
74 . . Q
75 . Q
76DSUPX S LASTLIN=LINENO
77 Q
78 ;
Note: See TracBrowser for help on using the repository browser.