source: FOIAVistA/tag/r/NOIS-FSC/FSCLDU.m@ 1796

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

initial load of FOIAVistA 6/30/08 version

File size: 3.4 KB
Line 
1FSCLDU ;SLC/STAFF-NOIS List Definition Utility ;1/3/97 16:57
2 ;;1.1;NOIS;;Sep 06, 1998
3 ;
4BUILD(LISTNUM,OK) ; from FSCLDS, FSCLMPMS, FSCLMPS, FSCLP
5 ; lock and unlock ^XTMP("FSC LIST DEF",LISTNUM) before and after this call
6 S OK=1
7 I '$D(^FSC("LIST",LISTNUM)) S OK=0 Q
8 N COND,CONDVAL,DEF,DEFCNT,EXE,EXT,FCOND,FIELD,FIELDAB,LEVEL,NUM,OP,OPER,PAREN,TYPE,VALUE,XOP,ZERO K DEF
9 S (EXE,OP)="",(DEFCNT,LEVEL)=0,PAREN="closed"
10 K ^XTMP("FSC LIST DEF",LISTNUM)
11 S NUM=0 F S NUM=$O(^FSC("LIST",LISTNUM,1,NUM)) Q:NUM<1 S ZERO=^(NUM,0) D Q:'OK
12 .I $L($P(ZERO,U,2)) D STORE
13 .S DEFCNT=DEFCNT+1,DEF(DEFCNT)=ZERO
14 .S OP=$P(ZERO,U,2),EXT=$P(ZERO,U,3),FIELD=$P(ZERO,U,4),COND=$P(ZERO,U,5),VALUE=$P(ZERO,U,6)
15 .I $L(OP) S EXE=OP_U,OPER=OP
16 .I $L(EXE)>245 S OK=0,$P(EXE,U,2)=0 Q
17 .S EXE=EXE_$S(EXT="A":"&",EXT="O":"!",1:"")
18 .I EXT="O",$L($G(^FSC("LIST",LISTNUM,1,NUM+1,0))),$P(^(0),U,2)="",$P(^(0),U,3)="A" S EXE=EXE_"(",PAREN="open"
19 .S EXE=EXE_"Q("_NUM_")"
20 .I EXT="A",PAREN="open",$L($G(^FSC("LIST",LISTNUM,1,NUM+1,0))),$P(^(0),U,2)="",$P(^(0),U,3)="O" S EXE=EXE_")",PAREN="closed"
21 .S FIELDAB=$P(^FSC("FLD",+FIELD,0),U,7),TYPE=$P(^(0),U,3),CONDVAL=$P(^FSC("COND",+COND,0),U,2) S:VALUE'=+VALUE VALUE=""""_VALUE_""""
22 .D
23 ..I CONDVAL["exist" D Q
24 ...I CONDVAL["not" S FCOND="'$L(VALUE("""_FIELDAB_"""))" Q
25 ...S FCOND="$L(VALUE("""_FIELDAB_"""))"
26 ..I CONDVAL["range" D Q
27 ...I CONDVAL["not" S FCOND="VALUE("""_FIELDAB_""")<"_+VALUE_"!(VALUE("""_FIELDAB_""")>"_+$P(VALUE,"-",2)_")"
28 ...S FCOND="VALUE("""_FIELDAB_""")'<"_+VALUE_",VALUE("""_FIELDAB_""")'>"_+$P(VALUE,"-",2)
29 ..I TYPE="W",CONDVAL["[" D Q
30 ...I CONDVAL="'[" S FCOND="$$WPNC^FSCLDU("""_$S(FIELDAB="DESC":30,FIELDAB="SUM":80,FIELDAB="STATHIST":110,1:50)_""",CALLNUM,"_VALUE_")" Q
31 ...S FCOND="$$WPC^FSCLDU("""_$S(FIELDAB="DESC":30,FIELDAB="SUM":80,FIELDAB="STATHIST":110,1:50)_""",CALLNUM,"_VALUE_")" Q
32 ..S FCOND="$P(VALUE("""_FIELDAB_"""),U)"_CONDVAL_VALUE
33 .S ^XTMP("FSC LIST DEF",LISTNUM,"VAR",FIELD)=FIELDAB
34 .S ^XTMP("FSC LIST DEF",LISTNUM,"Q",NUM)=FCOND
35 D STORE
36 S XOP="0" I OK S LEVEL=0 F S LEVEL=$O(^XTMP("FSC LIST DEF",LISTNUM,"X",LEVEL)) Q:LEVEL<1 S OP=$P(^(LEVEL),U) D I $L(XOP)>245 S OK=0,XOP="0" Q
37 .S XOP=XOP_$S(OP="A":"!",OP="S":"&",1:"&'")_"X("_LEVEL_")"
38 S ^XTMP("FSC LIST DEF",LISTNUM,"XOP")=XOP
39 I OK D CHECK(LISTNUM,.OK)
40 Q
41 ;
42CHECK(LISTNUM,OK) ;
43 N LEVEL,X S OK=1
44 S X="I "_^XTMP("FSC LIST DEF",LISTNUM,"XOP") D ^DIM I '$D(X) S OK=0
45 S LEVEL=0 F S LEVEL=$O(^XTMP("FSC LIST DEF",LISTNUM,"X",LEVEL)) Q:LEVEL<1 S X="I "_$P(^(LEVEL),U,2) D ^DIM I '$D(X) S OK=0,$P(^XTMP("FSC LIST DEF",LISTNUM,"X",LEVEL),U,2)=0
46 I 'OK S ^XTMP("FSC LIST DEF",LISTNUM,"XOP")=0
47 Q
48 ;
49STORE ;
50 Q:'$L(EXE)
51 I PAREN="open" S EXE=EXE_")",PAREN="closed"
52 S LEVEL=LEVEL+1
53 S ^XTMP("FSC LIST DEF",LISTNUM,"X",LEVEL)=EXE
54 N CRITERIA K CRITERIA S FSCLNAME=$P(^FSC("LIST",LISTNUM,0),U) D QDESC^FSCLMPMQ(.DEF,,.CRITERIA)
55 M ^XTMP("FSC LIST DEF",LISTNUM,"CRITERIA",LEVEL)=CRITERIA
56 K DEF S DEFCNT=0
57 Q
58 ;
59WPC(SUB,CALLNUM,VALUE) ; $$(wp subscript,call,value) -> 1 if wp entry contains value, else 0
60 N CHECK,LINE S CHECK=0
61 S LINE=0 F S LINE=$O(^FSCD("CALL",CALLNUM,SUB,LINE)) Q:LINE<1 I ^(LINE,0)[VALUE S CHECK=1 Q
62 Q CHECK
63 ;
64WPNC(SUB,CALLNUM,VALUE) ; $$(wp subscript,call,value) -> 1 if wp entry exists but does not contain value, else 0
65 I '$O(^FSCD("CALL",CALLNUM,SUB,0)) Q 0
66 N CHECK,LINE S CHECK=1
67 S LINE=0 F S LINE=$O(^FSCD("CALL",CALLNUM,SUB,LINE)) Q:LINE<1 I ^(LINE,0)[VALUE S CHECK=0 Q
68 Q CHECK
Note: See TracBrowser for help on using the repository browser.