- PXRMEXED ; SLC/PKR - Special code for education topics. ;02/25/2004
- ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
- ;
- ;=========================================================
- EXISTS(FLIST,IEN) ;Return true if IEN exists anywhere on the list.
- N EXISTS,IND
- S EXISTS=0,IND=""
- F S IND=$O(FLIST("EDUCATION TOPICS",IND)) Q:(EXISTS)!(IND="") D
- . I $D(FLIST("EDUCATION TOPICS",IND,IEN)) S EXISTS=1
- Q EXISTS
- ;
- ;=========================================================
- SUB(FLIST) ;Add a finding to the list of findings.
- I '$D(FLIST("EDUCATION TOPICS")) Q
- N IEN,IND,JND,LEVEL,NEXT,SUB,SUBIEN
- S IEN="",LEVEL=1
- F S IEN=$O(FLIST("EDUCATION TOPICS","F",IEN)) Q:IEN="" D
- . S JND=0
- . F S JND=+$O(^AUTTEDT(IEN,10,JND)) Q:JND=0 D
- .. S SUBIEN=$P(^AUTTEDT(IEN,10,JND,0),U,1)
- .. S SUB(LEVEL,SUBIEN)=""
- F Q:'$D(SUB(LEVEL)) D
- . S IND=LEVEL-1,NEXT=LEVEL+1
- . F S IND=$O(SUB(IND)) Q:IND="" D
- .. S IEN=""
- .. F S IEN=$O(SUB(IND,IEN)) Q:IEN="" D
- ... S JND=0
- ...;DBIA #3085
- ... F S JND=+$O(^AUTTEDT(IEN,10,JND)) Q:JND=0 D
- .... S SUBIEN=$P(^AUTTEDT(IEN,10,JND,0),U,1)
- .... S SUB(NEXT,SUBIEN)=""
- . S LEVEL=NEXT
- M SUB(0)=FLIST("EDUCATION TOPICS","F")
- K FLIST("EDUCATION TOPICS","F")
- S LEVEL=LEVEL-1,JND=0
- F IND=LEVEL:-1:0 D
- . S JND=JND+1,SUBIEN="F"_JND
- . S IEN=""
- . F S IEN=$O(SUB(IND,IEN)) Q:IEN="" D
- .. I '$$EXISTS(.FLIST,IEN) S FLIST("EDUCATION TOPICS",SUBIEN,IEN)=""
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMEXED 1432 printed Feb 18, 2025@23:11:17 Page 2
- PXRMEXED ; SLC/PKR - Special code for education topics. ;02/25/2004
- +1 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
- +2 ;
- +3 ;=========================================================
- EXISTS(FLIST,IEN) ;Return true if IEN exists anywhere on the list.
- +1 NEW EXISTS,IND
- +2 SET EXISTS=0
- SET IND=""
- +3 FOR
- SET IND=$ORDER(FLIST("EDUCATION TOPICS",IND))
- if (EXISTS)!(IND="")
- QUIT
- Begin DoDot:1
- +4 IF $DATA(FLIST("EDUCATION TOPICS",IND,IEN))
- SET EXISTS=1
- End DoDot:1
- +5 QUIT EXISTS
- +6 ;
- +7 ;=========================================================
- SUB(FLIST) ;Add a finding to the list of findings.
- +1 IF '$DATA(FLIST("EDUCATION TOPICS"))
- QUIT
- +2 NEW IEN,IND,JND,LEVEL,NEXT,SUB,SUBIEN
- +3 SET IEN=""
- SET LEVEL=1
- +4 FOR
- SET IEN=$ORDER(FLIST("EDUCATION TOPICS","F",IEN))
- if IEN=""
- QUIT
- Begin DoDot:1
- +5 SET JND=0
- +6 FOR
- SET JND=+$ORDER(^AUTTEDT(IEN,10,JND))
- if JND=0
- QUIT
- Begin DoDot:2
- +7 SET SUBIEN=$PIECE(^AUTTEDT(IEN,10,JND,0),U,1)
- +8 SET SUB(LEVEL,SUBIEN)=""
- End DoDot:2
- End DoDot:1
- +9 FOR
- if '$DATA(SUB(LEVEL))
- QUIT
- Begin DoDot:1
- +10 SET IND=LEVEL-1
- SET NEXT=LEVEL+1
- +11 FOR
- SET IND=$ORDER(SUB(IND))
- if IND=""
- QUIT
- Begin DoDot:2
- +12 SET IEN=""
- +13 FOR
- SET IEN=$ORDER(SUB(IND,IEN))
- if IEN=""
- QUIT
- Begin DoDot:3
- +14 SET JND=0
- +15 ;DBIA #3085
- +16 FOR
- SET JND=+$ORDER(^AUTTEDT(IEN,10,JND))
- if JND=0
- QUIT
- Begin DoDot:4
- +17 SET SUBIEN=$PIECE(^AUTTEDT(IEN,10,JND,0),U,1)
- +18 SET SUB(NEXT,SUBIEN)=""
- End DoDot:4
- End DoDot:3
- End DoDot:2
- +19 SET LEVEL=NEXT
- End DoDot:1
- +20 MERGE SUB(0)=FLIST("EDUCATION TOPICS","F")
- +21 KILL FLIST("EDUCATION TOPICS","F")
- +22 SET LEVEL=LEVEL-1
- SET JND=0
- +23 FOR IND=LEVEL:-1:0
- Begin DoDot:1
- +24 SET JND=JND+1
- SET SUBIEN="F"_JND
- +25 SET IEN=""
- +26 FOR
- SET IEN=$ORDER(SUB(IND,IEN))
- if IEN=""
- QUIT
- Begin DoDot:2
- +27 IF '$$EXISTS(.FLIST,IEN)
- SET FLIST("EDUCATION TOPICS",SUBIEN,IEN)=""
- End DoDot:2
- End DoDot:1
- +28 QUIT
- +29 ;
