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 Apr 09, 2024@20:48:38 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 ;
