Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMENOD

PXRMENOD.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;========================================================
  1. DEPLIST(IEN,DEP) ;Build the evaluation dependency list.
  1.  N BDT,EDT,FI1,FI2,TEMP
  1.  S FI1=0
  1.  F  S FI1=+$O(^PXD(811.9,IEN,20,FI1)) Q:FI1=0  D
  1.  . S TEMP=^PXD(811.9,IEN,20,FI1,0)
  1.  . S BDT=$P(TEMP,U,8)
  1.  . S EDT=$P(TEMP,U,11)
  1.  . S DEP(FI1)=""
  1.  . I BDT["FIEVAL" S FI2=$E(BDT,8,$F(BDT,",")-2),DEP(FI1,FI2)="BDT"
  1.  . I EDT["FIEVAL" S FI2=$E(EDT,8,$F(EDT,",")-2),DEP(FI1,FI2)="EDT"
  1.  Q
  1.  ;
  1.  ;========================================================
  1. 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
  1.  ;is EORDER(N)=finding number, where N is the evaluation order.
  1.  N CLIST,DONE,IND,JND,KND,ONLIST,NUM,TEXT
  1.  S IND="",ERROR=0
  1.  F  S IND=$O(DEP(IND)) Q:IND=""  D
  1.  .;If finding IND has no dependencies, i.e., $D=1 quit. If there are
  1.  .;dependencies $D=10.
  1.  . I $D(DEP(IND))=1 Q
  1.  . S JND=IND-1
  1.  . F  S JND=$O(DEP(IND,JND)) Q:JND=""  D
  1.  ..;Make sure dependent finding exists.
  1.  .. I '$D(^PXD(811.9,IEN,20,JND,0)) D
  1.  ... K TEXT
  1.  ... S TEXT(1)="Error: date of finding "_IND_" depends of date of finding "_JND_" and finding "_JND_" does"
  1.  ... S TEXT(2)="       not exist."
  1.  ... D EN^DDIOL(.TEXT)
  1.  ... S ERROR=1
  1.  ..;Check for reflective dependencies.
  1.  .. I $D(DEP(JND,IND)) D
  1.  ... K TEXT
  1.  ... S TEXT(1)="Error: date of finding "_IND_" depends of date of finding "_JND_" and"
  1.  ... S TEXT(2)="       date of finding "_JND_" depends on date of finding "_IND
  1.  ... D EN^DDIOL(.TEXT)
  1.  ... S ERROR=1
  1.  I ERROR Q
  1.  ;No errors found, build evaluation order lists.
  1.  ;First check for findings with no dependencies.
  1.  S IND=""
  1.  F  S IND=$O(DEP(IND)) Q:IND=""  I $D(DEP(IND))=1 S NODEP(IND)=""
  1.  ;Build the dependency list.
  1.  S IND="",NUM=0
  1.  F  S IND=$O(DEP(IND)) Q:IND=""  D
  1.  . I $D(NODEP(IND)) Q
  1.  . S JND=""
  1.  . F  S JND=$O(DEP(IND,JND)) Q:JND=""  D
  1.  .. I $D(NODEP(JND)) Q
  1.  .. S KND="",ONLIST=0
  1.  .. F  S KND=$O(EORDER(KND)) Q:KND=""  I EORDER(KND)=JND S ONLIST=1
  1.  .. I 'ONLIST S NUM=NUM+1,EORDER(NUM)=JND
  1.  . S KND="",ONLIST=0
  1.  . F  S KND=$O(EORDER(KND)) Q:KND=""  I EORDER(KND)=IND S ONLIST=1
  1.  . I 'ONLIST S NUM=NUM+1,EORDER(NUM)=IND
  1.  I '$D(EORDER) Q
  1.  ;Check for circular dependencies.
  1.  S DONE=0
  1.  S IND=EORDER(1),CLIST(IND)=""
  1.  F  Q:DONE  D
  1.  . S JND=$O(DEP(IND,""))
  1.  . I JND="" S DONE=1 Q
  1.  . I $D(CLIST(JND)) S (DONE,ERROR)=1 Q
  1.  . S CLIST(JND)=""
  1.  . S IND=JND
  1.  I ERROR D
  1.  . S TEXT="Error: found circular redundancy."
  1.  . D EN^DDIOL(TEXT)
  1.  . S IND=""
  1.  . F  S IND=$O(CLIST(IND)) Q:IND=""  D
  1.  .. S JND=$O(DEP(IND,""))
  1.  .. S TEXT=" Finding "_IND_" depends on finding "_JND
  1.  .. D EN^DDIOL(TEXT)
  1.  Q
  1.  ;
  1.  ;========================================================
  1. KENODE(X,DA) ;Kill the "E" node in the finding multiple for terms.
  1.  ;Do not execute as part of a verify fields.
  1.  I $G(DIUTIL)="VERIFY FIELDS" Q
  1.  N DAS,GLOBAL,IEN
  1.  S IEN=$P(X,";",1)
  1.  S GLOBAL=$P(X,";",2)
  1.  I GLOBAL="LAB(60," S IEN=$$LABDAS(IEN)
  1.  S DAS=IEN
  1.  I DAS="" Q
  1.  K ^PXRMD(811.5,DA(1),20,"E",GLOBAL,DAS,DA)
  1.  Q
  1.  ;
  1.  ;========================================================
  1. KENODES(XX,DA) ;Kill the "E" and "EDEP" nodes in the finding multiple for
  1.  ;definitions
  1.  ;Do not execute as part of a verify fields.
  1.  I $G(DIUTIL)="VERIFY FIELDS" Q
  1.  N DAS,GLOBAL,IEN,IND
  1.  S IEN=$P(XX,";",1)
  1.  S GLOBAL=$P(XX,";",2)
  1.  I GLOBAL="LAB(60," S IEN=$$LABDAS(IEN)
  1.  S DAS=IEN
  1.  I DAS="" Q
  1.  K ^PXD(811.9,DA(1),20,"E",GLOBAL,DAS,DA)
  1.  S IND=0
  1.  F  S IND=$O(^PXD(811.9,DA(1),20,"EDEP",IND)) Q:IND=""  D
  1.  . I '$D(^PXD(811.9,DA(1),20,"EDEP",IND,GLOBAL)) Q
  1.  . K ^PXD(811.9,DA(1),20,"EDEP",IND,GLOBAL,DAS,DA)
  1.  Q
  1.  ;
  1.  ;========================================================
  1. LABDAS(IEN) ;Determine the DAS for lab findings.
  1.  N SUB
  1.  ;DBIA #91-A
  1.  S SUB=$P(^LAB(60,IEN,0),U,4)
  1.  I SUB="CH" Q IEN
  1.  I (SUB="BB")!(SUB="WK") Q ""
  1.  I SUB="MI" Q "M;T;"_IEN
  1.  ;All other SUB values: AU, CY, EM, SP
  1.  Q "A;T;"_IEN
  1.  ;
  1.  ;========================================================
  1. SENODE(X,DA) ;Set the "E" node in the finding multiple for terms.
  1.  ;Do not execute as part of a verify fields.
  1.  I $G(DIUTIL)="VERIFY FIELDS" Q
  1.  N DAS,GLOBAL,IEN
  1.  S IEN=$P(X,";",1)
  1.  S GLOBAL=$P(X,";",2)
  1.  I GLOBAL="LAB(60," S IEN=$$LABDAS(IEN)
  1.  S DAS=IEN
  1.  I DAS="" Q
  1.  S ^PXRMD(811.5,DA(1),20,"E",GLOBAL,DAS,DA)=""
  1.  Q
  1.  ;
  1.  ;========================================================
  1. 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
  1.  ;Do not execute as part of a verify fields.
  1.  I $G(DIUTIL)="VERIFY FIELDS" Q
  1.  N DAS,DEP,EORDER,ERROR,FBDT,FEDT,FI,GLOBAL,IEN,IND,JND,NODEP,PT01
  1.  ;Build dependency list.
  1.  D DEPLIST(DA(1),.DEP)
  1.  D EVORDER(DA(1),.DEP,.EORDER,.NODEP,.ERROR)
  1.  ;If EVORDER returns an error quit.
  1.  I ERROR Q
  1.  K ^PXD(811.9,DA(1),20,"E"),^PXD(811.9,DA(1),20,"EDEP")
  1.  ;Build the "E" index.
  1.  S IND=""
  1.  F  S IND=$O(NODEP(IND)) Q:IND=""  D
  1.  . S PT01=$P(^PXD(811.9,DA(1),20,IND,0),U,1)
  1.  . S IEN=$P(PT01,";",1)
  1.  . S GLOBAL=$P(PT01,";",2)
  1.  . I GLOBAL="LAB(60," S IEN=$$LABDAS(IEN)
  1.  . S DAS=IEN
  1.  . I DAS="" Q
  1.  . S ^PXD(811.9,DA(1),20,"E",GLOBAL,DAS,IND)=""
  1.  ;Build the "EDEP" index.
  1.  S IND=0
  1.  F  S IND=$O(EORDER(IND)) Q:IND=""  D
  1.  . S FI=EORDER(IND)
  1.  . S JND=0,(FBDT,FEDT)=""
  1.  . F  S JND=$O(DEP(FI,JND)) Q:JND=""  D
  1.  .. I DEP(FI,JND)="BDT" S FBDT=JND
  1.  .. I DEP(FI,JND)="EDT" S FEDT=JND
  1.  . S PT01=$P(^PXD(811.9,DA(1),20,FI,0),U,1)
  1.  . S IEN=$P(PT01,";",1)
  1.  . S GLOBAL=$P(PT01,";",2)
  1.  . I GLOBAL="LAB(60," S IEN=$$LABDAS(IEN)
  1.  . S DAS=IEN
  1.  . I DAS="" Q
  1.  . S ^PXD(811.9,DA(1),20,"EDEP",IND,GLOBAL,DAS,FI)=FBDT_U_FEDT
  1.  Q
  1.  ;