PXRMRCUR ;SLC/PKR - Reminder definition computing finding recursion check. ;02/20/2020
;;2.0;CLINICAL REMINDERS;**47,42**;Feb 04, 2005;Build 245
;
;==========================================
DEFCHK(RDCFIEN,DEFIEN,NPAIR,RPAIR) ;Check a definition for recursion.
N CFPARAM,FI,NDEFIEN,RECUR
I '$D(^PXD(811.9,DEFIEN,20,"E","PXRMD(811.4,",RDCFIEN)) Q 0
S RECUR=0,FI=""
F S FI=$O(^PXD(811.9,DEFIEN,20,"E","PXRMD(811.4,",RDCFIEN,FI)) Q:(RECUR)!(FI="") D
. S NPAIR=NPAIR+1
. S RPAIR(NPAIR,1)=DEFIEN
. S RPAIR(NPAIR,1,"SRC")=811.9_";"_DEFIEN_";"_FI
. S CFPARAM=$G(^PXD(811.9,DEFIEN,20,FI,15))
. I CFPARAM="" Q
. I CFPARAM=+CFPARAM S NDEFIEN=+CFPARAM
. E S NDEFIEN=$O(^PXD(811.9,"B",CFPARAM,""))
. I NDEFIEN="" Q
. S RPAIR(NPAIR,2)=NDEFIEN
. S RPAIR(NPAIR,2,"SRC")=811.9_";"_NDEFIEN_";"_FI
. I NDEFIEN=RPAIR(NPAIR,1) S RECUR=1_U_RPAIR(NPAIR,1,"SRC") Q
. I NPAIR>1 S RECUR=$$PAIRCHK(NPAIR,.RPAIR)
. I RECUR Q
. S RECUR=$$DEFCHK(RDCFIEN,NDEFIEN,.NPAIR,.RPAIR)
Q RECUR
;
;==========================================
PAIRCHK(NPAIR,RPAIR) ;Check reminder pairs for recursion.
N IND,RECUR
S IND=1,RECUR=0
F Q:(RECUR)!(IND=NPAIR) D
. I (RPAIR(NPAIR,2)=RPAIR(IND,1))&(RPAIR(NPAIR,1)=RPAIR(IND,2)) S RECUR=1_U_RPAIR(IND,1,"SRC")_U_RPAIR(IND,2,"SRC")
. S IND=IND+1
Q RECUR
;
;==========================================
RECCHK(DEFIEN) ;When using the computed finding VA-REMINDER DEFINITION it is
;possible for recursion to occur if a reminder definition calls itself
;somewhere in the chain. These routines are used to scan a reminder
;definition and reminder terms used by the definition to check for
;recursion. If recursion is found the return value is:
;1^file #;IEN^file #;IEN where file # and IEN specify the source of
;the recursion. If no recursion is found the return value is 0.
;The alogrithm finds all reminder pairs and checks for the same pair
;twice. Here are some examples:
;The simplest case where reminder A calls itself is represented by
;the pairs (A,A) and (A,A). If A calls B and B calls A this is
;represented by the pairs (A,B) and (B,A).
N NPAIR,RDCFIEN,RECUR,RPAIR
S RDCFIEN=$O(^PXRMD(811.4,"B","VA-REMINDER DEFINITION",""))
S NPAIR=0
;Check the definition first.
S RECUR=$$DEFCHK(RDCFIEN,DEFIEN,.NPAIR,.RPAIR)
;Check terms.
I 'RECUR S RECUR=$$TERMCHK(RDCFIEN,DEFIEN,.NPAIR,.RPAIR)
Q RECUR
;
;==========================================
TERMCHK(RDCFIEN,DEFIEN,NPAIR,RPAIR) ;Check terms used by a reminder definition.
N CFPARAM,DEF,FI,FINDING,NDEFIEN,RECUR,TERMIEN
I '$D(^PXD(811.9,DEFIEN,20,"E","PXRMD(811.5,")) Q 0
S DEF=$P(^PXD(811.9,DEFIEN,0),U,1)
S RECUR=0,TERMIEN=""
F S TERMIEN=$O(^PXD(811.9,DEFIEN,20,"E","PXRMD(811.5,",TERMIEN)) Q:(RECUR)!(TERMIEN="") D
. I '$D(^PXRMD(811.5,TERMIEN,20,"E","PXRMD(811.4,",RDCFIEN)) Q
. S FINDING=$O(^PXD(811.9,DEFIEN,20,"E","PXRMD(811.5,",TERMIEN,""))
. S FI=""
. F S FI=$O(^PXRMD(811.5,TERMIEN,20,"E","PXRMD(811.4,",RDCFIEN,FI)) Q:(RECUR)!(FI="") D
.. S NPAIR=NPAIR+1
.. S RPAIR(NPAIR,1)=DEF
.. S RPAIR(NPAIR,1,"SRC")=811.9_";"_DEFIEN_";"_FINDING
.. S CFPARAM=$G(^PXRMD(811.5,TERMIEN,20,FI,15))
.. S RPAIR(NPAIR,2)=CFPARAM
.. S RPAIR(NPAIR,2,"SRC")=811.5_";"_TERMIEN_";"_FI
.. I CFPARAM=RPAIR(NPAIR,1) S RECUR=1_U_RPAIR(NPAIR,1,"SRC")_U_RPAIR(NPAIR,2,"SRC") Q
.. I CFPARAM="" Q
.. I NPAIR>1 S RECUR=$$PAIRCHK(NPAIR,.RPAIR)
.. I RECUR Q
.. S NDEFIEN=$O(^PXD(811.9,"B",CFPARAM,""))
.. I NDEFIEN="" Q
.. S RECUR=$$DEFCHK(RDCFIEN,NDEFIEN,.NPAIR,.RPAIR)
Q RECUR
;
;==========================================
TRECCHK(TERMIEN) ;Starting with a term check for recursion.
N CFPARAM,IND,NPAIR,RDCFIEN,RECUR,RPAIR
I '$D(^PXRMD(811.5,TERMIEN,20,"E","PXRMD(811.4,",35)) Q 0
S RDCFIEN=$O(^PXRMD(811.4,"B","VA-REMINDER DEFINITION",""))
S RECUR=0
S NPAIR=0
S IND=0
F S IND=$O(^PXRMD(811.5,TERMIEN,20,"E","PXRMD(811.4,",35,IND)) Q:IND="" D
. S CFPARAM=$G(^PXRMD(811.5,TERMIEN,20,IND,15))
. I CFPARAM="" Q
. S DEFIEN=$O(^PXD(811.9,"B",CFPARAM,""))
. I DEFIEN="" Q
. S RECUR=$$DEFCHK(RDCFIEN,DEFIEN,.NPAIR,.RPAIR)
. I 'RECUR S RECUR=$$TERMCHK(RDCFIEN,DEFIEN,.NPAIR,.RPAIR)
Q RECUR
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMRCUR 4214 printed Nov 22, 2024@16:58:57 Page 2
PXRMRCUR ;SLC/PKR - Reminder definition computing finding recursion check. ;02/20/2020
+1 ;;2.0;CLINICAL REMINDERS;**47,42**;Feb 04, 2005;Build 245
+2 ;
+3 ;==========================================
DEFCHK(RDCFIEN,DEFIEN,NPAIR,RPAIR) ;Check a definition for recursion.
+1 NEW CFPARAM,FI,NDEFIEN,RECUR
+2 IF '$DATA(^PXD(811.9,DEFIEN,20,"E","PXRMD(811.4,",RDCFIEN))
QUIT 0
+3 SET RECUR=0
SET FI=""
+4 FOR
SET FI=$ORDER(^PXD(811.9,DEFIEN,20,"E","PXRMD(811.4,",RDCFIEN,FI))
if (RECUR)!(FI="")
QUIT
Begin DoDot:1
+5 SET NPAIR=NPAIR+1
+6 SET RPAIR(NPAIR,1)=DEFIEN
+7 SET RPAIR(NPAIR,1,"SRC")=811.9_";"_DEFIEN_";"_FI
+8 SET CFPARAM=$GET(^PXD(811.9,DEFIEN,20,FI,15))
+9 IF CFPARAM=""
QUIT
+10 IF CFPARAM=+CFPARAM
SET NDEFIEN=+CFPARAM
+11 IF '$TEST
SET NDEFIEN=$ORDER(^PXD(811.9,"B",CFPARAM,""))
+12 IF NDEFIEN=""
QUIT
+13 SET RPAIR(NPAIR,2)=NDEFIEN
+14 SET RPAIR(NPAIR,2,"SRC")=811.9_";"_NDEFIEN_";"_FI
+15 IF NDEFIEN=RPAIR(NPAIR,1)
SET RECUR=1_U_RPAIR(NPAIR,1,"SRC")
QUIT
+16 IF NPAIR>1
SET RECUR=$$PAIRCHK(NPAIR,.RPAIR)
+17 IF RECUR
QUIT
+18 SET RECUR=$$DEFCHK(RDCFIEN,NDEFIEN,.NPAIR,.RPAIR)
End DoDot:1
+19 QUIT RECUR
+20 ;
+21 ;==========================================
PAIRCHK(NPAIR,RPAIR) ;Check reminder pairs for recursion.
+1 NEW IND,RECUR
+2 SET IND=1
SET RECUR=0
+3 FOR
if (RECUR)!(IND=NPAIR)
QUIT
Begin DoDot:1
+4 IF (RPAIR(NPAIR,2)=RPAIR(IND,1))&(RPAIR(NPAIR,1)=RPAIR(IND,2))
SET RECUR=1_U_RPAIR(IND,1,"SRC")_U_RPAIR(IND,2,"SRC")
+5 SET IND=IND+1
End DoDot:1
+6 QUIT RECUR
+7 ;
+8 ;==========================================
RECCHK(DEFIEN) ;When using the computed finding VA-REMINDER DEFINITION it is
+1 ;possible for recursion to occur if a reminder definition calls itself
+2 ;somewhere in the chain. These routines are used to scan a reminder
+3 ;definition and reminder terms used by the definition to check for
+4 ;recursion. If recursion is found the return value is:
+5 ;1^file #;IEN^file #;IEN where file # and IEN specify the source of
+6 ;the recursion. If no recursion is found the return value is 0.
+7 ;The alogrithm finds all reminder pairs and checks for the same pair
+8 ;twice. Here are some examples:
+9 ;The simplest case where reminder A calls itself is represented by
+10 ;the pairs (A,A) and (A,A). If A calls B and B calls A this is
+11 ;represented by the pairs (A,B) and (B,A).
+12 NEW NPAIR,RDCFIEN,RECUR,RPAIR
+13 SET RDCFIEN=$ORDER(^PXRMD(811.4,"B","VA-REMINDER DEFINITION",""))
+14 SET NPAIR=0
+15 ;Check the definition first.
+16 SET RECUR=$$DEFCHK(RDCFIEN,DEFIEN,.NPAIR,.RPAIR)
+17 ;Check terms.
+18 IF 'RECUR
SET RECUR=$$TERMCHK(RDCFIEN,DEFIEN,.NPAIR,.RPAIR)
+19 QUIT RECUR
+20 ;
+21 ;==========================================
TERMCHK(RDCFIEN,DEFIEN,NPAIR,RPAIR) ;Check terms used by a reminder definition.
+1 NEW CFPARAM,DEF,FI,FINDING,NDEFIEN,RECUR,TERMIEN
+2 IF '$DATA(^PXD(811.9,DEFIEN,20,"E","PXRMD(811.5,"))
QUIT 0
+3 SET DEF=$PIECE(^PXD(811.9,DEFIEN,0),U,1)
+4 SET RECUR=0
SET TERMIEN=""
+5 FOR
SET TERMIEN=$ORDER(^PXD(811.9,DEFIEN,20,"E","PXRMD(811.5,",TERMIEN))
if (RECUR)!(TERMIEN="")
QUIT
Begin DoDot:1
+6 IF '$DATA(^PXRMD(811.5,TERMIEN,20,"E","PXRMD(811.4,",RDCFIEN))
QUIT
+7 SET FINDING=$ORDER(^PXD(811.9,DEFIEN,20,"E","PXRMD(811.5,",TERMIEN,""))
+8 SET FI=""
+9 FOR
SET FI=$ORDER(^PXRMD(811.5,TERMIEN,20,"E","PXRMD(811.4,",RDCFIEN,FI))
if (RECUR)!(FI="")
QUIT
Begin DoDot:2
+10 SET NPAIR=NPAIR+1
+11 SET RPAIR(NPAIR,1)=DEF
+12 SET RPAIR(NPAIR,1,"SRC")=811.9_";"_DEFIEN_";"_FINDING
+13 SET CFPARAM=$GET(^PXRMD(811.5,TERMIEN,20,FI,15))
+14 SET RPAIR(NPAIR,2)=CFPARAM
+15 SET RPAIR(NPAIR,2,"SRC")=811.5_";"_TERMIEN_";"_FI
+16 IF CFPARAM=RPAIR(NPAIR,1)
SET RECUR=1_U_RPAIR(NPAIR,1,"SRC")_U_RPAIR(NPAIR,2,"SRC")
QUIT
+17 IF CFPARAM=""
QUIT
+18 IF NPAIR>1
SET RECUR=$$PAIRCHK(NPAIR,.RPAIR)
+19 IF RECUR
QUIT
+20 SET NDEFIEN=$ORDER(^PXD(811.9,"B",CFPARAM,""))
+21 IF NDEFIEN=""
QUIT
+22 SET RECUR=$$DEFCHK(RDCFIEN,NDEFIEN,.NPAIR,.RPAIR)
End DoDot:2
End DoDot:1
+23 QUIT RECUR
+24 ;
+25 ;==========================================
TRECCHK(TERMIEN) ;Starting with a term check for recursion.
+1 NEW CFPARAM,IND,NPAIR,RDCFIEN,RECUR,RPAIR
+2 IF '$DATA(^PXRMD(811.5,TERMIEN,20,"E","PXRMD(811.4,",35))
QUIT 0
+3 SET RDCFIEN=$ORDER(^PXRMD(811.4,"B","VA-REMINDER DEFINITION",""))
+4 SET RECUR=0
+5 SET NPAIR=0
+6 SET IND=0
+7 FOR
SET IND=$ORDER(^PXRMD(811.5,TERMIEN,20,"E","PXRMD(811.4,",35,IND))
if IND=""
QUIT
Begin DoDot:1
+8 SET CFPARAM=$GET(^PXRMD(811.5,TERMIEN,20,IND,15))
+9 IF CFPARAM=""
QUIT
+10 SET DEFIEN=$ORDER(^PXD(811.9,"B",CFPARAM,""))
+11 IF DEFIEN=""
QUIT
+12 SET RECUR=$$DEFCHK(RDCFIEN,DEFIEN,.NPAIR,.RPAIR)
+13 IF 'RECUR
SET RECUR=$$TERMCHK(RDCFIEN,DEFIEN,.NPAIR,.RPAIR)
End DoDot:1
+14 QUIT RECUR
+15 ;
