source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUFA.m@ 1766

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

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1TIUFA ; SLC/MAM - LM Template A (DDEFs By Attribute) INIT ;10/26/95 15:33
2 ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
3 ;
4EN ; -- main entry point for Options TIUFA SORT DDEFS CLIN/MGR/NATL
5 ; Requires TIUFWHO, set in above options
6 N TIUF,TIUFTMPL,TIUFATTR,TIUFAVAL,TIUFSTRT,TIUFVCN1,TIUFXNOD
7 N TIUFREDO,X,XQORM,TIUFLFT
8 S TIUFTMPL="A",TIUFREDO=0
9 N TIUFPRIV D SETUP^TIUFL S:$D(DTOUT) VALMQUIT=1 G:$G(VALMQUIT) ENX
10 S TIUFXNOD="^^Sort^"
11 S X=^TMP("TIUF",$J,"SORT")_";ORD(101," D EN^XQOR
12 G:$D(DTOUT)!'$D(TIUFSTRT) ENX
13 I TIUFWHO="C" D EN^VALM("TIUFA SORT DDEFS CLIN")
14 I "MN"[TIUFWHO D EN^VALM("TIUFA SORT DDEFS MGR")
15ENX Q
16 ;
17HDR ; -- header code
18 ; Requires Attribute TIUFATTR as set in protocols TIUF SORT BY (ALL,
19 ;TYPE, OWNER, STATUS, WAY USED, PARENTAGE):
20 ; TIUFATTR = A^ALL, T^TYPE, O^OWNER, S^STATUS, U^WAY USED, P^PARENTAGE;
21 ; Requires Attribute Value TIUFAVAL as set in TIUF SORT BY ALL;
22 ;TIUF TYPE /CLASS,DOCUMENT CLASS,MULTIAUTHOR DC,DOCUMENT,COMPONENT,NONE;
23 ;TIUF OWNER /CLASS,INDIVIDUAL,PERSONAL,NONE; TIUF STATUS /INACTIVE,
24 ;TEST,ACTIVE,NONE; TIUF USED BY DOCMTS/YES,NO,NA,UNKNOWN; TIUF PARENTAGE/ORPHAN,NONORPHAN.
25 ; e.g. TIUFAVAL =
26 ; ALL^ALL if attribute is ALL;
27 ; CL^CLASS if attribute is Type and Type is Class;
28 ; NONE^NONE if attr is Type and attr value is NONE.
29 ; 546^PROVIDER^C if attr is Owner, Kind of Owner is Class Owner,
30 ; and Class Owner is Provider Class (IFN 546).
31 ; 0^NONE if attr is Owner, attr value is NONE.
32 ; 13^INACTIVE if attr is Status and Status is Inactive (IFN 13).
33 ; 0^NONE if attr is Owner and Owner is NONE.
34 ; YES if attr is Way Used and Way Used is YES:
35 ; YES/NO/NA
36 ; O^ORPHAN if attr is ORPHAN and attr value is Orphan.
37 ; N^NONORPHAN if attr is ORPHAN and attr value is Nonorphan.
38 ; Requires TIUFSTRT = e.g. " ^ZZZZZZZZ" as set in SELSTART^TIUFLA.
39 N ATTR1,HDR2,MODE,OWN,FROM,TO,HDR3,VHDR1,VHDR2
40 S ATTR1=$P(TIUFATTR,U)
41 I ATTR1="T" S HDR2=$S($P(TIUFAVAL,U)'="NONE":" of Type "_$P(TIUFAVAL,U,2),1:" with NO Type")
42 I ATTR1="O" S MODE=$P(TIUFAVAL,U,3),OWN=$P(TIUFAVAL,U,2) D
43 . S HDR2=$S(MODE="P":" Personally Owned by "_OWN,MODE="C":" Owned by Class "_OWN,MODE="I":" Owned by Individual "_OWN,1:" with No Owner")
44 I ATTR1="S" S HDR2=$S($P(TIUFAVAL,U)'="N":" of Status "_$P(TIUFAVAL,U,2),1:" with NO Status")
45 S FROM=$S($P(TIUFSTRT,U)=" ":"FIRST",1:$P(TIUFSTRT,U))
46 S TO=$S($P(TIUFSTRT,U)=" ":"LAST",$P(TIUFSTRT,U,2)="ZZZZZZZZ":"LAST",1:$P(TIUFSTRT,U,2))
47 S HDR3=$S(TIUFSTRT'=" ^ZZZZZZZZ":" from "_FROM_" to "_TO,1:"")
48 I ATTR1="U" S MODE=TIUFAVAL D
49 . S HDR2=$S(MODE="YES":" In Use",1:" NOT In Use")
50 . I HDR3'="" S HDR2=HDR2_","
51 I ATTR1="P" S HDR2=$S($P(TIUFAVAL,U)="O":" which are ORPHANS",1:" which are NOT ORPHANS")
52 I "TOSUP"[ATTR1 S VALMHDR(1)=$$CENTER^TIUFL("Entries"_HDR2_HDR3,79)
53 I ATTR1="A" S VALMHDR(1)=$$CENTER^TIUFL("ALL Entries"_$S(HDR3'="":", "_HDR3,1:""),79)
54HDRX ;
55 Q
56 ;
57INIT ; -- init variables and list array. Called by Templates A and J AND by Subtemplates.
58 ; Requires TIUFATTR, TIUFAVAL, TIUFSTRT. See HDR^TIUFA
59 K ^TMP("TIUF1",$J),^TMP("TIUF1IDX",$J),^TMP("TIUFB",$J),^TMP("TIUFBIDX",$J)
60 I '$D(TIUFSTMP) D CLEAN^VALM10 ; Clean IF called from active Template.
61 N LINENO,STRTNM,ENDNM,FILEDA,NAME,PASTEND
62 I '$D(TIUFSTMP) S VALM("TITLE")=$S(TIUFTMPL="J":"Objects",$P(TIUFATTR,U)'="A":"Sort by "_$S($P(TIUFATTR,U,2)="WAY USED":"IN USE Value",1:$P(TIUFATTR,U,2)),1:"ALL Document Definitions")
63 S (TIUFVCN1,LINENO)=0,STRTNM=$P(TIUFSTRT,U),ENDNM=$P(TIUFSTRT,U,2)
64 I $O(^TIU(8925.1,"B",STRTNM,"")) D
65 . S FILEDA=""
66 . F S FILEDA=$O(^TIU(8925.1,"B",STRTNM,FILEDA)) Q:'FILEDA D INIT1
67 G:$D(DTOUT) INITX
68 S NAME=STRTNM
69 F S NAME=$O(^TIU(8925.1,"B",NAME)) Q:NAME="" D Q:$G(PASTEND) G:$D(DTOUT) INITX
70 . I NAME]ENDNM S PASTEND=1 Q
71 . S FILEDA=""
72 . F S FILEDA=$O(^TIU(8925.1,"B",NAME,FILEDA)) Q:'FILEDA D INIT1
73 . Q
74 I LINENO D UPDATE^TIUFLLM1("A",LINENO,0) S TIUFVCN1=TIUFVCN1+LINENO
75INITX ;
76 S:$D(DTOUT) VALMQUIT=1
77 S:'$D(TIUFSTMP) VALMCNT=TIUFVCN1
78 Q
79 ;
80INIT1 ; Puts FILEDA in Buffer array.
81 N NODE0,INFO
82 Q:'$D(^TIU(8925.1,FILEDA,0))
83 Q:'$$MATCH^TIUFLA(FILEDA)
84 S LINENO=LINENO+1 ; Needed for NINFO.
85 D NINFO^TIUFLLM(LINENO,FILEDA,.INFO),PARSE^TIUFLLM(.INFO),NODE0ARR^TIUFLF(FILEDA,.NODE0) Q:$D(DTOUT)
86 I NODE0="" W !!," Entry "_FILEDA_" in 'B' Cross Reference does not exist in the file; See IRM",! D PAUSE^TIUFXHLX S LINENO=LINENO-1 Q
87 D BUFENTRY^TIUFLLM2(.INFO,.NODE0,TIUFTMPL) W "."
88 Q
89 ;
90EXIT ; -- exit code
91 K ^TMP("TIUF1",$J),^TMP("TIUFB",$J),^TMP("TIUF1IDX",$J),^TMP("TIUFBIDX",$J),^TMP("TIUF",$J),IOELALL
92 D CLEAN^VALM10
93 Q
94 ;
Note: See TracBrowser for help on using the repository browser.