source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXED.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.4 KB
RevLine 
[613]1PXRMEXED ; SLC/PKR - Special code for education topics. ;02/25/2004
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4 ;=========================================================
5EXISTS(FLIST,IEN) ;Return true if IEN exists anywhere on the list.
6 N EXISTS,IND
7 S EXISTS=0,IND=""
8 F S IND=$O(FLIST("EDUCATION TOPICS",IND)) Q:(EXISTS)!(IND="") D
9 . I $D(FLIST("EDUCATION TOPICS",IND,IEN)) S EXISTS=1
10 Q EXISTS
11 ;
12 ;=========================================================
13SUB(FLIST) ;Add a finding to the list of findings.
14 I '$D(FLIST("EDUCATION TOPICS")) Q
15 N IEN,IND,JND,LEVEL,NEXT,SUB,SUBIEN
16 S IEN="",LEVEL=1
17 F S IEN=$O(FLIST("EDUCATION TOPICS","F",IEN)) Q:IEN="" D
18 . S JND=0
19 . F S JND=+$O(^AUTTEDT(IEN,10,JND)) Q:JND=0 D
20 .. S SUBIEN=$P(^AUTTEDT(IEN,10,JND,0),U,1)
21 .. S SUB(LEVEL,SUBIEN)=""
22 F Q:'$D(SUB(LEVEL)) D
23 . S IND=LEVEL-1,NEXT=LEVEL+1
24 . F S IND=$O(SUB(IND)) Q:IND="" D
25 .. S IEN=""
26 .. F S IEN=$O(SUB(IND,IEN)) Q:IEN="" D
27 ... S JND=0
28 ...;DBIA #3085
29 ... F S JND=+$O(^AUTTEDT(IEN,10,JND)) Q:JND=0 D
30 .... S SUBIEN=$P(^AUTTEDT(IEN,10,JND,0),U,1)
31 .... S SUB(NEXT,SUBIEN)=""
32 . S LEVEL=NEXT
33 M SUB(0)=FLIST("EDUCATION TOPICS","F")
34 K FLIST("EDUCATION TOPICS","F")
35 S LEVEL=LEVEL-1,JND=0
36 F IND=LEVEL:-1:0 D
37 . S JND=JND+1,SUBIEN="F"_JND
38 . S IEN=""
39 . F S IEN=$O(SUB(IND,IEN)) Q:IEN="" D
40 .. I '$$EXISTS(.FLIST,IEN) S FLIST("EDUCATION TOPICS",SUBIEN,IEN)=""
41 Q
42 ;
Note: See TracBrowser for help on using the repository browser.