PXRMENOD ;SLC/PKR - Clinical Reminders "E" node routines. ;06/26/2013
;;2.0;CLINICAL REMINDERS;**4,6,18,26**;Feb 04, 2005;Build 404
;
;========================================================
DEPLIST(IEN,DEP) ;Build the evaluation dependency list.
N BDT,EDT,FI1,FI2,TEMP
S FI1=0
F S FI1=+$O(^PXD(811.9,IEN,20,FI1)) Q:FI1=0 D
. S TEMP=^PXD(811.9,IEN,20,FI1,0)
. S BDT=$P(TEMP,U,8)
. S EDT=$P(TEMP,U,11)
. S DEP(FI1)=""
. I BDT["FIEVAL" S FI2=$E(BDT,8,$F(BDT,",")-2),DEP(FI1,FI2)="BDT"
. I EDT["FIEVAL" S FI2=$E(EDT,8,$F(EDT,",")-2),DEP(FI1,FI2)="EDT"
Q
;
;========================================================
EVORDER(IEN,DEP,EORDER,NODEP,ERROR) ;Determine the evaluation order for findings
;that depend of the date of other findings. The structure of EORDER
;is EORDER(N)=finding number, where N is the evaluation order.
N CLIST,DONE,IND,JND,KND,ONLIST,NUM,TEXT
S IND="",ERROR=0
F S IND=$O(DEP(IND)) Q:IND="" D
.;If finding IND has no dependencies, i.e., $D=1 quit. If there are
.;dependencies $D=10.
. I $D(DEP(IND))=1 Q
. S JND=IND-1
. F S JND=$O(DEP(IND,JND)) Q:JND="" D
..;Make sure dependent finding exists.
.. I '$D(^PXD(811.9,IEN,20,JND,0)) D
... K TEXT
... S TEXT(1)="Error: date of finding "_IND_" depends of date of finding "_JND_" and finding "_JND_" does"
... S TEXT(2)=" not exist."
... D EN^DDIOL(.TEXT)
... S ERROR=1
..;Check for reflective dependencies.
.. I $D(DEP(JND,IND)) D
... K TEXT
... S TEXT(1)="Error: date of finding "_IND_" depends of date of finding "_JND_" and"
... S TEXT(2)=" date of finding "_JND_" depends on date of finding "_IND
... D EN^DDIOL(.TEXT)
... S ERROR=1
I ERROR Q
;No errors found, build evaluation order lists.
;First check for findings with no dependencies.
S IND=""
F S IND=$O(DEP(IND)) Q:IND="" I $D(DEP(IND))=1 S NODEP(IND)=""
;Build the dependency list.
S IND="",NUM=0
F S IND=$O(DEP(IND)) Q:IND="" D
. I $D(NODEP(IND)) Q
. S JND=""
. F S JND=$O(DEP(IND,JND)) Q:JND="" D
.. I $D(NODEP(JND)) Q
.. S KND="",ONLIST=0
.. F S KND=$O(EORDER(KND)) Q:KND="" I EORDER(KND)=JND S ONLIST=1
.. I 'ONLIST S NUM=NUM+1,EORDER(NUM)=JND
. S KND="",ONLIST=0
. F S KND=$O(EORDER(KND)) Q:KND="" I EORDER(KND)=IND S ONLIST=1
. I 'ONLIST S NUM=NUM+1,EORDER(NUM)=IND
I '$D(EORDER) Q
;Check for circular dependencies.
S DONE=0
S IND=EORDER(1),CLIST(IND)=""
F Q:DONE D
. S JND=$O(DEP(IND,""))
. I JND="" S DONE=1 Q
. I $D(CLIST(JND)) S (DONE,ERROR)=1 Q
. S CLIST(JND)=""
. S IND=JND
I ERROR D
. S TEXT="Error: found circular redundancy."
. D EN^DDIOL(TEXT)
. S IND=""
. F S IND=$O(CLIST(IND)) Q:IND="" D
.. S JND=$O(DEP(IND,""))
.. S TEXT=" Finding "_IND_" depends on finding "_JND
.. D EN^DDIOL(TEXT)
Q
;
;========================================================
KENODE(X,DA) ;Kill the "E" node in the finding multiple for terms.
;Do not execute as part of a verify fields.
I $G(DIUTIL)="VERIFY FIELDS" Q
N DAS,GLOBAL,IEN
S IEN=$P(X,";",1)
S GLOBAL=$P(X,";",2)
I GLOBAL="LAB(60," S IEN=$$LABDAS(IEN)
S DAS=IEN
I DAS="" Q
K ^PXRMD(811.5,DA(1),20,"E",GLOBAL,DAS,DA)
Q
;
;========================================================
KENODES(XX,DA) ;Kill the "E" and "EDEP" nodes in the finding multiple for
;definitions
;Do not execute as part of a verify fields.
I $G(DIUTIL)="VERIFY FIELDS" Q
N DAS,GLOBAL,IEN,IND
S IEN=$P(XX,";",1)
S GLOBAL=$P(XX,";",2)
I GLOBAL="LAB(60," S IEN=$$LABDAS(IEN)
S DAS=IEN
I DAS="" Q
K ^PXD(811.9,DA(1),20,"E",GLOBAL,DAS,DA)
S IND=0
F S IND=$O(^PXD(811.9,DA(1),20,"EDEP",IND)) Q:IND="" D
. I '$D(^PXD(811.9,DA(1),20,"EDEP",IND,GLOBAL)) Q
. K ^PXD(811.9,DA(1),20,"EDEP",IND,GLOBAL,DAS,DA)
Q
;
;========================================================
LABDAS(IEN) ;Determine the DAS for lab findings.
N SUB
;DBIA #91-A
S SUB=$P(^LAB(60,IEN,0),U,4)
I SUB="CH" Q IEN
I (SUB="BB")!(SUB="WK") Q ""
I SUB="MI" Q "M;T;"_IEN
;All other SUB values: AU, CY, EM, SP
Q "A;T;"_IEN
;
;========================================================
SENODE(X,DA) ;Set the "E" node in the finding multiple for terms.
;Do not execute as part of a verify fields.
I $G(DIUTIL)="VERIFY FIELDS" Q
N DAS,GLOBAL,IEN
S IEN=$P(X,";",1)
S GLOBAL=$P(X,";",2)
I GLOBAL="LAB(60," S IEN=$$LABDAS(IEN)
S DAS=IEN
I DAS="" Q
S ^PXRMD(811.5,DA(1),20,"E",GLOBAL,DAS,DA)=""
Q
;
;========================================================
SENODES(X,DA) ;Set the "E" and "EDEP" node in the finding multiple for
;definitions. X(1)=.01, X(2)=BEGINNING DATE/TIME, X(3)=ENDING DATE/TIME
;Do not execute as part of a verify fields.
I $G(DIUTIL)="VERIFY FIELDS" Q
N DAS,DEP,EORDER,ERROR,FBDT,FEDT,FI,GLOBAL,IEN,IND,JND,NODEP,PT01
;Build dependency list.
D DEPLIST(DA(1),.DEP)
D EVORDER(DA(1),.DEP,.EORDER,.NODEP,.ERROR)
;If EVORDER returns an error quit.
I ERROR Q
K ^PXD(811.9,DA(1),20,"E"),^PXD(811.9,DA(1),20,"EDEP")
;Build the "E" index.
S IND=""
F S IND=$O(NODEP(IND)) Q:IND="" D
. S PT01=$P(^PXD(811.9,DA(1),20,IND,0),U,1)
. S IEN=$P(PT01,";",1)
. S GLOBAL=$P(PT01,";",2)
. I GLOBAL="LAB(60," S IEN=$$LABDAS(IEN)
. S DAS=IEN
. I DAS="" Q
. S ^PXD(811.9,DA(1),20,"E",GLOBAL,DAS,IND)=""
;Build the "EDEP" index.
S IND=0
F S IND=$O(EORDER(IND)) Q:IND="" D
. S FI=EORDER(IND)
. S JND=0,(FBDT,FEDT)=""
. F S JND=$O(DEP(FI,JND)) Q:JND="" D
.. I DEP(FI,JND)="BDT" S FBDT=JND
.. I DEP(FI,JND)="EDT" S FEDT=JND
. S PT01=$P(^PXD(811.9,DA(1),20,FI,0),U,1)
. S IEN=$P(PT01,";",1)
. S GLOBAL=$P(PT01,";",2)
. I GLOBAL="LAB(60," S IEN=$$LABDAS(IEN)
. S DAS=IEN
. I DAS="" Q
. S ^PXD(811.9,DA(1),20,"EDEP",IND,GLOBAL,DAS,FI)=FBDT_U_FEDT
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMENOD 5815 printed Sep 15, 2024@21:08:45 Page 2
PXRMENOD ;SLC/PKR - Clinical Reminders "E" node routines. ;06/26/2013
+1 ;;2.0;CLINICAL REMINDERS;**4,6,18,26**;Feb 04, 2005;Build 404
+2 ;
+3 ;========================================================
DEPLIST(IEN,DEP) ;Build the evaluation dependency list.
+1 NEW BDT,EDT,FI1,FI2,TEMP
+2 SET FI1=0
+3 FOR
SET FI1=+$ORDER(^PXD(811.9,IEN,20,FI1))
if FI1=0
QUIT
Begin DoDot:1
+4 SET TEMP=^PXD(811.9,IEN,20,FI1,0)
+5 SET BDT=$PIECE(TEMP,U,8)
+6 SET EDT=$PIECE(TEMP,U,11)
+7 SET DEP(FI1)=""
+8 IF BDT["FIEVAL"
SET FI2=$EXTRACT(BDT,8,$FIND(BDT,",")-2)
SET DEP(FI1,FI2)="BDT"
+9 IF EDT["FIEVAL"
SET FI2=$EXTRACT(EDT,8,$FIND(EDT,",")-2)
SET DEP(FI1,FI2)="EDT"
End DoDot:1
+10 QUIT
+11 ;
+12 ;========================================================
EVORDER(IEN,DEP,EORDER,NODEP,ERROR) ;Determine the evaluation order for findings
+1 ;that depend of the date of other findings. The structure of EORDER
+2 ;is EORDER(N)=finding number, where N is the evaluation order.
+3 NEW CLIST,DONE,IND,JND,KND,ONLIST,NUM,TEXT
+4 SET IND=""
SET ERROR=0
+5 FOR
SET IND=$ORDER(DEP(IND))
if IND=""
QUIT
Begin DoDot:1
+6 ;If finding IND has no dependencies, i.e., $D=1 quit. If there are
+7 ;dependencies $D=10.
+8 IF $DATA(DEP(IND))=1
QUIT
+9 SET JND=IND-1
+10 FOR
SET JND=$ORDER(DEP(IND,JND))
if JND=""
QUIT
Begin DoDot:2
+11 ;Make sure dependent finding exists.
+12 IF '$DATA(^PXD(811.9,IEN,20,JND,0))
Begin DoDot:3
+13 KILL TEXT
+14 SET TEXT(1)="Error: date of finding "_IND_" depends of date of finding "_JND_" and finding "_JND_" does"
+15 SET TEXT(2)=" not exist."
+16 DO EN^DDIOL(.TEXT)
+17 SET ERROR=1
End DoDot:3
+18 ;Check for reflective dependencies.
+19 IF $DATA(DEP(JND,IND))
Begin DoDot:3
+20 KILL TEXT
+21 SET TEXT(1)="Error: date of finding "_IND_" depends of date of finding "_JND_" and"
+22 SET TEXT(2)=" date of finding "_JND_" depends on date of finding "_IND
+23 DO EN^DDIOL(.TEXT)
+24 SET ERROR=1
End DoDot:3
End DoDot:2
End DoDot:1
+25 IF ERROR
QUIT
+26 ;No errors found, build evaluation order lists.
+27 ;First check for findings with no dependencies.
+28 SET IND=""
+29 FOR
SET IND=$ORDER(DEP(IND))
if IND=""
QUIT
IF $DATA(DEP(IND))=1
SET NODEP(IND)=""
+30 ;Build the dependency list.
+31 SET IND=""
SET NUM=0
+32 FOR
SET IND=$ORDER(DEP(IND))
if IND=""
QUIT
Begin DoDot:1
+33 IF $DATA(NODEP(IND))
QUIT
+34 SET JND=""
+35 FOR
SET JND=$ORDER(DEP(IND,JND))
if JND=""
QUIT
Begin DoDot:2
+36 IF $DATA(NODEP(JND))
QUIT
+37 SET KND=""
SET ONLIST=0
+38 FOR
SET KND=$ORDER(EORDER(KND))
if KND=""
QUIT
IF EORDER(KND)=JND
SET ONLIST=1
+39 IF 'ONLIST
SET NUM=NUM+1
SET EORDER(NUM)=JND
End DoDot:2
+40 SET KND=""
SET ONLIST=0
+41 FOR
SET KND=$ORDER(EORDER(KND))
if KND=""
QUIT
IF EORDER(KND)=IND
SET ONLIST=1
+42 IF 'ONLIST
SET NUM=NUM+1
SET EORDER(NUM)=IND
End DoDot:1
+43 IF '$DATA(EORDER)
QUIT
+44 ;Check for circular dependencies.
+45 SET DONE=0
+46 SET IND=EORDER(1)
SET CLIST(IND)=""
+47 FOR
if DONE
QUIT
Begin DoDot:1
+48 SET JND=$ORDER(DEP(IND,""))
+49 IF JND=""
SET DONE=1
QUIT
+50 IF $DATA(CLIST(JND))
SET (DONE,ERROR)=1
QUIT
+51 SET CLIST(JND)=""
+52 SET IND=JND
End DoDot:1
+53 IF ERROR
Begin DoDot:1
+54 SET TEXT="Error: found circular redundancy."
+55 DO EN^DDIOL(TEXT)
+56 SET IND=""
+57 FOR
SET IND=$ORDER(CLIST(IND))
if IND=""
QUIT
Begin DoDot:2
+58 SET JND=$ORDER(DEP(IND,""))
+59 SET TEXT=" Finding "_IND_" depends on finding "_JND
+60 DO EN^DDIOL(TEXT)
End DoDot:2
End DoDot:1
+61 QUIT
+62 ;
+63 ;========================================================
KENODE(X,DA) ;Kill the "E" node in the finding multiple for terms.
+1 ;Do not execute as part of a verify fields.
+2 IF $GET(DIUTIL)="VERIFY FIELDS"
QUIT
+3 NEW DAS,GLOBAL,IEN
+4 SET IEN=$PIECE(X,";",1)
+5 SET GLOBAL=$PIECE(X,";",2)
+6 IF GLOBAL="LAB(60,"
SET IEN=$$LABDAS(IEN)
+7 SET DAS=IEN
+8 IF DAS=""
QUIT
+9 KILL ^PXRMD(811.5,DA(1),20,"E",GLOBAL,DAS,DA)
+10 QUIT
+11 ;
+12 ;========================================================
KENODES(XX,DA) ;Kill the "E" and "EDEP" nodes in the finding multiple for
+1 ;definitions
+2 ;Do not execute as part of a verify fields.
+3 IF $GET(DIUTIL)="VERIFY FIELDS"
QUIT
+4 NEW DAS,GLOBAL,IEN,IND
+5 SET IEN=$PIECE(XX,";",1)
+6 SET GLOBAL=$PIECE(XX,";",2)
+7 IF GLOBAL="LAB(60,"
SET IEN=$$LABDAS(IEN)
+8 SET DAS=IEN
+9 IF DAS=""
QUIT
+10 KILL ^PXD(811.9,DA(1),20,"E",GLOBAL,DAS,DA)
+11 SET IND=0
+12 FOR
SET IND=$ORDER(^PXD(811.9,DA(1),20,"EDEP",IND))
if IND=""
QUIT
Begin DoDot:1
+13 IF '$DATA(^PXD(811.9,DA(1),20,"EDEP",IND,GLOBAL))
QUIT
+14 KILL ^PXD(811.9,DA(1),20,"EDEP",IND,GLOBAL,DAS,DA)
End DoDot:1
+15 QUIT
+16 ;
+17 ;========================================================
LABDAS(IEN) ;Determine the DAS for lab findings.
+1 NEW SUB
+2 ;DBIA #91-A
+3 SET SUB=$PIECE(^LAB(60,IEN,0),U,4)
+4 IF SUB="CH"
QUIT IEN
+5 IF (SUB="BB")!(SUB="WK")
QUIT ""
+6 IF SUB="MI"
QUIT "M;T;"_IEN
+7 ;All other SUB values: AU, CY, EM, SP
+8 QUIT "A;T;"_IEN
+9 ;
+10 ;========================================================
SENODE(X,DA) ;Set the "E" node in the finding multiple for terms.
+1 ;Do not execute as part of a verify fields.
+2 IF $GET(DIUTIL)="VERIFY FIELDS"
QUIT
+3 NEW DAS,GLOBAL,IEN
+4 SET IEN=$PIECE(X,";",1)
+5 SET GLOBAL=$PIECE(X,";",2)
+6 IF GLOBAL="LAB(60,"
SET IEN=$$LABDAS(IEN)
+7 SET DAS=IEN
+8 IF DAS=""
QUIT
+9 SET ^PXRMD(811.5,DA(1),20,"E",GLOBAL,DAS,DA)=""
+10 QUIT
+11 ;
+12 ;========================================================
SENODES(X,DA) ;Set the "E" and "EDEP" node in the finding multiple for
+1 ;definitions. X(1)=.01, X(2)=BEGINNING DATE/TIME, X(3)=ENDING DATE/TIME
+2 ;Do not execute as part of a verify fields.
+3 IF $GET(DIUTIL)="VERIFY FIELDS"
QUIT
+4 NEW DAS,DEP,EORDER,ERROR,FBDT,FEDT,FI,GLOBAL,IEN,IND,JND,NODEP,PT01
+5 ;Build dependency list.
+6 DO DEPLIST(DA(1),.DEP)
+7 DO EVORDER(DA(1),.DEP,.EORDER,.NODEP,.ERROR)
+8 ;If EVORDER returns an error quit.
+9 IF ERROR
QUIT
+10 KILL ^PXD(811.9,DA(1),20,"E"),^PXD(811.9,DA(1),20,"EDEP")
+11 ;Build the "E" index.
+12 SET IND=""
+13 FOR
SET IND=$ORDER(NODEP(IND))
if IND=""
QUIT
Begin DoDot:1
+14 SET PT01=$PIECE(^PXD(811.9,DA(1),20,IND,0),U,1)
+15 SET IEN=$PIECE(PT01,";",1)
+16 SET GLOBAL=$PIECE(PT01,";",2)
+17 IF GLOBAL="LAB(60,"
SET IEN=$$LABDAS(IEN)
+18 SET DAS=IEN
+19 IF DAS=""
QUIT
+20 SET ^PXD(811.9,DA(1),20,"E",GLOBAL,DAS,IND)=""
End DoDot:1
+21 ;Build the "EDEP" index.
+22 SET IND=0
+23 FOR
SET IND=$ORDER(EORDER(IND))
if IND=""
QUIT
Begin DoDot:1
+24 SET FI=EORDER(IND)
+25 SET JND=0
SET (FBDT,FEDT)=""
+26 FOR
SET JND=$ORDER(DEP(FI,JND))
if JND=""
QUIT
Begin DoDot:2
+27 IF DEP(FI,JND)="BDT"
SET FBDT=JND
+28 IF DEP(FI,JND)="EDT"
SET FEDT=JND
End DoDot:2
+29 SET PT01=$PIECE(^PXD(811.9,DA(1),20,FI,0),U,1)
+30 SET IEN=$PIECE(PT01,";",1)
+31 SET GLOBAL=$PIECE(PT01,";",2)
+32 IF GLOBAL="LAB(60,"
SET IEN=$$LABDAS(IEN)
+33 SET DAS=IEN
+34 IF DAS=""
QUIT
+35 SET ^PXD(811.9,DA(1),20,"EDEP",IND,GLOBAL,DAS,FI)=FBDT_U_FEDT
End DoDot:1
+36 QUIT
+37 ;
