source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUFLA.m@ 1361

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

initial load of WorldVistAEHR

File size: 5.2 KB
RevLine 
[613]1TIUFLA ; SLC/MAM - Library; Template A Related: SELSTART, MATCH(FILEDA), TYPMATCH(FILEDA,ATYPE), OWNMATCH(FILEDA,AOWN), STTMATCH(FILEDA,ASTAT), USEMATCH(FILEDA,AUSE), STRMATCH(FILEDA,NODE0), PARMATCH(FILEDA,APARE) ;4/23/97 11:02
2 ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
3 ;
4SELSTART ; Select Docmt Def to Start with and to Go To
5 ; Sets TIUFSTRT = Start^Stop where Start and Stop are characters to
6 ;start and stop display with.
7 N DIR,X,Y,START,GOTO
8 W !! S DIR(0)="FO^1:60^S:$L($T(^TIULS)) X=$$UPPER^TIULS(X) K:'(X'?1P.E) X",(DIR("?"),DIR("??"))="^D HELP^TIUFLA(""start"")"
9 S DIR("A")="START WITH DOCUMENT DEFINITION",DIR("B")="FIRST"
10 I TIUFTMPL="J" S DIR("A")="START DISPLAY WITH OBJECT"
11 D ^DIR I $D(DIRUT),'$D(TIUFSTRT) G SELSX
12 S START=Y,START=$$UPPER^TIULS(START)
13 I START="FIRST" S TIUFSTRT=" ^ZZZZZZZZ" G SELSX
14 S DIR("A")="GO TO DOCUMENT DEFINITION",DIR("B")="LAST"
15 I TIUFTMPL="J" S DIR("A")="GO TO OBJECT"
16 S (DIR("?"),DIR("??"))="^D HELP^TIUFLA(""end"")"
17 D ^DIR I $D(DIRUT) G SELSX
18 S GOTO=$S(Y="LAST":"ZZZZZZZZ",1:Y),GOTO=$$UPPER^TIULS(GOTO)
19 S TIUFSTRT=START_U_GOTO
20SELSX Q
21 ;
22HELP(STRTEND) ; Writes help for SELSTART
23 N DDEFOBJ S DDEFOBJ=$S(TIUFTMPL'="J":"Document Definition",1:"Object")
24 W !,"What ",DDEFOBJ," would you like to ",STRTEND," the display with? Enter a",!,"partial/whole ",DDEFOBJ," name, or just enter some letters."
25 Q
26 ;
27MATCH(FILEDA) ; Function returns 1 if FILEDA matches Template A Sort
28 ;Attribute, and Sort Attribute Value.
29 ;Else Returns e.g. 0^TYPE if Type is where match fails.
30 ; Requires TIUFATTR, TIUFAVAL. See HDR^TIUFA
31 N ANS,ATTR1 S ANS=0
32 S ATTR1=$P(TIUFATTR,U)
33 I ATTR1="T" S ANS=$S($$TYPMATCH(FILEDA,TIUFAVAL):1,1:"0^TYPE")
34 I ATTR1="O" S ANS=$S($$OWNMATCH(FILEDA,TIUFAVAL):1,1:"0^OWNER")
35 I ATTR1="S" S ANS=$S($$STTMATCH(FILEDA,TIUFAVAL):1,1:"0^STATUS")
36 I ATTR1="U" S ANS=$S($$USEMATCH(FILEDA,TIUFAVAL):1,1:"0^WAY USED")
37 I ATTR1="P" S ANS=$S($$PARMATCH(FILEDA,TIUFAVAL):1,1:"0^PARENTAGE")
38 I ATTR1="A" S ANS=1
39 Q ANS
40 ;
41TYPMATCH(FILEDA,ATYPE) ; Function returns 1 if Type of FILEDA matches
42 ;Template A Type Value, else 0.
43 ; Requires FILEDA; Requires ATYPE=TIUFAVAL when TIUFATTR="T^TYPE".
44 ;See HDR^TIUFA. Requires TIUFATTR.
45 N MATCH
46 I '$G(FILEDA)!'$D(ATYPE)!(TIUFATTR'="T^TYPE") S MATCH="ERR" G TYPMX
47 S MATCH=0,ATYPE=$P(ATYPE,U) I ATYPE="TL" S ATYPE="DOC"
48 I ATYPE="NONE" S:($P(^TIU(8925.1,FILEDA,0),U,4)="") MATCH=1 G TYPMX
49 I '$D(^TIU(8925.1,"AT",ATYPE,FILEDA)) G TYPMX
50 S MATCH=1
51TYPMX Q MATCH
52 ;
53OWNMATCH(FILEDA,AOWN) ; Function returns 1 if FILEDA matches Template A Owner
54 ;Value, Else 0.
55 ; Requires FILEDA; Requires AOWN=TIUFAVAL when TIUFATTR="O^OWNER".
56 ;See HDR^TIUFA. Requires TIUFATTR.
57 N MATCH,PERSOWNS,NODE0
58 S MATCH=0
59 I '$G(FILEDA)!'$D(AOWN) G OWNMX
60 I $P(AOWN,U,3)="P"!($P(AOWN,U,3)="I")!(TIUFATTR'="O^OWNER") D G OWNMX
61 . S PERSOWNS=$$PERSOWNS^TIUFLF2(FILEDA,+AOWN)
62 . I $P(AOWN,U,3)="P",$P(PERSOWNS,U,2)'="P" Q
63 . I $P(AOWN,U,3)="I",'PERSOWNS Q
64 . S MATCH=1
65 . Q
66 I $P(AOWN,U,3)="C",'$D(^TIU(8925.1,"AC",+AOWN,FILEDA)) G OWNMX
67 I $P(AOWN,U,2)="NONE" S NODE0=^TIU(8925.1,FILEDA,0) I $L($P(NODE0,U,5))!$L($P(NODE0,U,6)) G OWNMX
68 S MATCH=1
69OWNMX Q MATCH
70 ;
71STTMATCH(FILEDA,ASTAT) ; Function returns 1 if Status of FILEDA matches
72 ;Template A STatus Value ASTAT, else 0.
73 ; Fudge: If ASTAT is A, I, or T, don't match a shared Component no matter what its .07 fld value is. However, if ASTAT=0 (NONE), match Shared Component no matter what its .07 fld value is.
74 ; Requires FILEDA; Requires ASTAT=TIUFAVAL when TIUFATTR="S^STATUS".
75 ;See HDR^TIUFA. Requires TIUFATTR.
76 N MATCH,NODE0
77 S MATCH=0,ASTAT=$P(ASTAT,U)
78 I '$G(FILEDA)!'$D(ASTAT)!(TIUFATTR'="S^STATUS") S MATCH="ERR" G STTMX
79 I $D(^TIU(8925.1,"AS",ASTAT,FILEDA)) S NODE0=^TIU(8925.1,FILEDA,0) I '$P(NODE0,U,10) S MATCH=1 G STTMX
80 I (ASTAT=0),'$P(^TIU(8925.1,FILEDA,0),U,7) S MATCH=1 G STTMX
81 I (ASTAT=0) S NODE0=^TIU(8925.1,FILEDA,0) I $P(NODE0,U,10) S MATCH=1
82STTMX Q MATCH
83 ;
84USEMATCH(FILEDA,AUSE) ; Function returns 1 if Way Used By Docmts of
85 ;FILEDA matches Template A Way Used Value, else 0.
86 ; Requires FILEDA; Requires AUSE=TIUFAVAL when TIUFATTR="U^WAY USED",
87 ;=YES,NO,NA or UNKNOWN.
88 ;See HDR^TIUFA. Requires TIUFATTR.
89 N MATCH,DDEFUSED
90 I '$G(FILEDA)!'$D(AUSE)!(TIUFATTR'="U^WAY USED") S MATCH="ERR" G USEMX
91 S MATCH=0,DDEFUSED=$$DDEFUSED^TIUFLF(FILEDA)
92 I DDEFUSED["UNKNOWN",AUSE="UNKNOWN" S MATCH=1 G USEMX ; UNKNOWN[NO!!!
93 I DDEFUSED=AUSE S MATCH=1 G USEMX
94USEMX Q MATCH
95 ;
96PARMATCH(FILEDA,APARE) ; Function returns 1 if Parentage of FILEDA matches
97 ;Template A Parentage Value, else 0.
98 ; Requires FILEDA; Requires APARE=TIUFAVAL when TIUFATTR="P^PARENTAGE".
99 ;See HDR^TIUFA. Requires TIUFATTR.
100 N MATCH,ORPHAN,NODE0
101 S MATCH=0,APARE=$P(APARE,U)
102 I '$G(FILEDA)!'$D(APARE)!(TIUFATTR'="P^PARENTAGE") S MATCH="ERR" G PARMX
103 S NODE0=^TIU(8925.1,FILEDA,0),ORPHAN=$$ORPHAN^TIUFLF4(FILEDA,NODE0)
104 I ORPHAN="YES",$P(APARE,U)="O" S MATCH=1
105 I ORPHAN="NO",$P(APARE,U)="N" S MATCH=1
106PARMX Q MATCH
107 ;
108STRMATCH(FILEDA,NODE0) ; Function returns 1 if FILEDA Name matches Template A
109 ;Start With/Go To Value, Else 0.
110 ; Requires FILEDA, NODE0= ^TIU(8925.1,FILEDA,0).
111 ; Requires TIUFSTRT as set in SELSTART^TIUFLA.
112 N NAME,ANS
113 S NAME=$P(NODE0,U)
114 I $P(TIUFSTRT,U)']NAME,NAME']$P(TIUFSTRT,U,2) S ANS=1 G STRMX
115 S ANS=0
116STRMX Q ANS
117 ;
Note: See TracBrowser for help on using the repository browser.