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

PXRMLOGX.m

Go to the documentation of this file.
  1. PXRMLOGX ;SLC/PKR - Clinical Reminders logic cross-reference routines. ;03/29/2022
  1. ;;2.0;CLINICAL REMINDERS;**4,18,65**;Feb 04, 2005;Build 438
  1. ;
  1. ;==================
  1. BLDAFL(IEN,KI,NODEP) ;Build a list of findings that can change the
  1. ;frequency age range set. This is called by FileMan whenever the
  1. ;minimum age, maximum age, or frequency fields of the findings
  1. ;multiple are edited.
  1. ;Do not execute as part of a verify fields.
  1. I $G(DIUTIL)="VERIFY FIELDS" Q
  1. ;Do not execute as part of exchange.
  1. I $G(PXRMEXCH) Q
  1. N FREQ,FLIST,FTYPE,IND,OK,NODE,NUM,STARTCHK
  1. S STARTCHK=$S($D(^PXD(811.9,IEN,25)):100,1:150)
  1. S FLIST="",OK=1,NUM=0
  1. F NODE=20,25 D
  1. . S FTYPE=$S(NODE=25:"FF",1:"")
  1. . S IND=0
  1. . F S IND=$O(^PXD(811.9,IEN,NODE,IND)) Q:+IND=0 D
  1. ..;If an entry is being deleted skip it.
  1. .. I IND=$G(KI),NODE=NODEP Q
  1. .. S FREQ=$P(^PXD(811.9,IEN,NODE,IND,0),U,4)
  1. .. I FREQ'="" D
  1. ... S NUM=NUM+1
  1. ... I NUM>STARTCHK S OK=$$CHKSLEN(FLIST,";"_IND)
  1. ... I NUM>1 S FLIST=FLIST_";"
  1. ... I OK S FLIST=FLIST_FTYPE_IND
  1. S OK=$$CHKSLEN(FLIST,NUM_U)
  1. I OK S ^PXD(811.9,IEN,40)=NUM_U_FLIST
  1. E D
  1. . S ^PXD(811.9,IEN,40)=-1
  1. . D ERRMSG("age")
  1. Q
  1. ;
  1. ;==================
  1. BLDALL(IEN,KI,NODEP) ;Build all the findings lists.
  1. ;Do not execute as part of a verify fields.
  1. I $G(DIUTIL)="VERIFY FIELDS" Q
  1. ;Do not execute as part of exchange.
  1. I $G(PXRMEXCH) Q
  1. I '$D(^PXD(811.9,IEN)) Q
  1. D BLDPCLS^PXRMLOGX(IEN,KI,NODEP)
  1. D BLDRESLS^PXRMLOGX(IEN,KI,NODEP)
  1. D BLDAFL^PXRMLOGX(IEN,KI,NODEP)
  1. D BLDINFL^PXRMLOGX(IEN,KI,NODEP)
  1. Q
  1. ;
  1. ;==================
  1. BLDCONTRALD(IEN,X1,X2) ;Build the CONTRAINDICATED LOGIC data.
  1. ;Do not execute as part of a verify fields.
  1. I $G(DIUTIL)="VERIFY FIELDS" Q
  1. ;Do not execute as part of exchange.
  1. I $G(PXRMEXCH) Q
  1. I X2="" S ^PXD(811.9,IEN,81)=0 Q
  1. ;Get the list of findings.
  1. N FLIST,IND,NUM,OK,OPER,STACK,STARTCHK,T1,T2
  1. S STARTCHK=$S($D(^PXD(811.9,IEN,25)):100,1:150)
  1. S OPER="'U!&",OK=1,NUM=0,FLIST=""
  1. D POSTFIX^PXRMSTAC(X2,OPER,.STACK)
  1. F IND=1:1:STACK(0) D
  1. . S T1=STACK(IND)
  1. . I OPER[T1 Q
  1. . I (T1="FF")!(T1="FI") D
  1. .. S IND=IND+1
  1. .. S T2=STACK(IND)
  1. .. I NUM>0 S FLIST=FLIST_";"
  1. .. S NUM=NUM+1
  1. .. I NUM>STARTCHK S OK=$$CHKSLEN(FLIST,";"_IND)
  1. .. I OK S FLIST=FLIST_$S(T1="FF":"FF"_T2,1:T2)
  1. S OK=$$CHKSLEN(FLIST,NUM_U)
  1. I OK S ^PXD(811.9,IEN,81)=NUM_U_FLIST
  1. E D
  1. . S ^PXD(811.9,IEN,81)=-1
  1. . D ERRMSG("contraindicated")
  1. Q
  1. ;
  1. ;==================
  1. BLDINFL(IEN,KI,NODEP) ;Build the list of findings that are information only.
  1. ;This is called by the routines that build the resolution findings
  1. ;list, the patient cohort findings list, and the age finding list.
  1. ;Do not execute as part of a verify fields.
  1. I $G(DIUTIL)="VERIFY FIELDS" Q
  1. ;Do not execute as part of exchange.
  1. I $G(PXRMEXCH) Q
  1. N FIA,FLIST,FTYPE,IND,NODE,NUM,OK,SUB,STARTCHK,TEMP
  1. S STARTCHK=$S($D(^PXD(811.9,IEN,25)):100,1:150)
  1. F NODE=20,25 D
  1. . S FTYPE=$S(NODE=25:"FF",1:"")
  1. . S IND=0
  1. . F S IND=$O(^PXD(811.9,IEN,NODE,IND)) Q:+IND=0 D
  1. ..;If an entry is being deleted skip it.
  1. .. I IND=$G(KI),NODE=NODEP Q
  1. .. S SUB=FTYPE_IND
  1. .. S FIA(SUB)=""
  1. ;Remove the patient cohort logic findings.
  1. S TEMP=$G(^PXD(811.9,IEN,32))
  1. S NUM=+$P(TEMP,U,1)
  1. S FLIST=$P(TEMP,U,2)
  1. F IND=1:1:NUM D
  1. . S TEMP=$P(FLIST,";",IND)
  1. . I $D(FIA(TEMP)) K FIA(TEMP)
  1. ;Remove the resolution logic findings.
  1. S TEMP=$G(^PXD(811.9,IEN,36))
  1. S NUM=+$P(TEMP,U,1)
  1. S FLIST=$P(TEMP,U,2)
  1. F IND=1:1:NUM D
  1. . S TEMP=$P(FLIST,";",IND)
  1. . I $D(FIA(TEMP)) K FIA(TEMP)
  1. ;Remove the age findings.
  1. S TEMP=$G(^PXD(811.9,IEN,40))
  1. S NUM=+$P(TEMP,U,1)
  1. S FLIST=$P(TEMP,U,2)
  1. F IND=1:1:NUM D
  1. . S TEMP=$P(FLIST,";",IND)
  1. . I $D(FIA(TEMP)) K FIA(TEMP)
  1. ;Remove the contraindicated logic findings.
  1. S TEMP=$G(^PXD(811.9,IEN,81))
  1. S NUM=+$P(TEMP,U,1)
  1. S FLIST=$P(TEMP,U,2)
  1. F IND=1:1:NUM D
  1. . S TEMP=$P(FLIST,";",IND)
  1. . I $D(FIA(TEMP)) K FIA(TEMP)
  1. ;Remove the resolution logic findings.
  1. S TEMP=$G(^PXD(811.9,IEN,91))
  1. S NUM=+$P(TEMP,U,1)
  1. S FLIST=$P(TEMP,U,2)
  1. F IND=1:1:NUM D
  1. . S TEMP=$P(FLIST,";",IND)
  1. . I $D(FIA(TEMP)) K FIA(TEMP)
  1. ;
  1. ;What is left is the information findings.
  1. S FLIST="",OK=1
  1. S (IND,NUM)=0
  1. F S IND=$O(FIA(IND)) Q:IND="" D
  1. . S NUM=NUM+1
  1. . I NUM>STARTCHK S OK=$$CHKSLEN(FLIST,";"_IND)
  1. . I NUM>1 S FLIST=FLIST_";"
  1. . I OK S FLIST=FLIST_IND
  1. S OK=$$CHKSLEN(FLIST,NUM_U)
  1. I OK S ^PXD(811.9,IEN,42)=NUM_U_FLIST
  1. E D
  1. . S ^PXD(811.9,IEN,42)=-1
  1. . D ERRMSG("information")
  1. Q
  1. ;
  1. ;==================
  1. BLDPCLS(IEN,KI,NODEP) ;Build the Internal Patient Cohort Logic string for a
  1. ;reminder. This is called by FileMan whenever the USE IN PATIENT COHORT
  1. ;LOGIC field is edited or the user defined Patient Cohort Logic is
  1. ;killed. Also builds the patient cohort logic list.
  1. ;If there is a user defined PATIENT COHORT LOGIC then don't do anything.
  1. ;Do not execute as part of a verify fields.
  1. I $G(DIUTIL)="VERIFY FIELDS" Q
  1. ;Do not execute as part of exchange.
  1. I $G(PXRMEXCH) Q
  1. I $L($G(^PXD(811.9,IEN,30)))>0 Q
  1. N FLIST,FTYPE,IND,NODE,NUM,OK,PCLOG,STARTCHK,TEMP,UPCLOG
  1. S STARTCHK=$S($D(^PXD(811.9,IEN,25)):100,1:150)
  1. S OK=1
  1. S PCLOG="(SEX)&(AGE)"
  1. S FLIST="SEX;AGE",NUM=2
  1. F NODE=20,25 D
  1. . S FTYPE=$S(NODE=20:"FI",NODE=25:"FF")
  1. . S IND=0
  1. . F S IND=$O(^PXD(811.9,IEN,NODE,IND)) Q:+IND=0 D
  1. ..;If an entry is being deleted skip it.
  1. .. I IND=$G(KI),NODE=NODEP Q
  1. .. S TEMP=^PXD(811.9,IEN,NODE,IND,0)
  1. .. S UPCLOG=$P(TEMP,U,7)
  1. .. I UPCLOG'="" D
  1. ... S PCLOG=PCLOG_UPCLOG_FTYPE_"("_IND_")"
  1. ... S NUM=NUM+1
  1. ... I NUM>STARTCHK S OK=$$CHKSLEN(FLIST,";"_IND)
  1. ... I OK S FLIST=FLIST_";"_$S(NODE=25:"FF"_IND,1:IND)
  1. ;Save the internal string and the findings list.
  1. S OK=$$CHKSLEN(FLIST,NUM_U)
  1. I OK D
  1. . S ^PXD(811.9,IEN,31)=PCLOG
  1. . S ^PXD(811.9,IEN,32)=NUM_U_FLIST
  1. E D
  1. . S ^PXD(811.9,IEN,32)=-1
  1. . D ERRMSG("cohort")
  1. Q
  1. ;
  1. ;==================
  1. BLDREFLD(IEN,X1,X2) ;Build the REFUSED LOGIC data.
  1. ;Do not execute as part of a verify fields.
  1. I $G(DIUTIL)="VERIFY FIELDS" Q
  1. ;Do not execute as part of exchange.
  1. I $G(PXRMEXCH) Q
  1. I X2="" S ^PXD(811.9,IEN,91)=0 Q
  1. ;Get the list of findings.
  1. N FLIST,IND,NUM,OK,OPER,STACK,STARTCHK,T1,T2
  1. S STARTCHK=$S($D(^PXD(811.9,IEN,25)):100,1:150)
  1. S OPER="'U!&",OK=1,NUM=0,FLIST=""
  1. D POSTFIX^PXRMSTAC(X2,OPER,.STACK)
  1. F IND=1:1:STACK(0) D
  1. . S T1=STACK(IND)
  1. . I OPER[T1 Q
  1. . I (T1="FF")!(T1="FI") D
  1. .. S IND=IND+1
  1. .. S T2=STACK(IND)
  1. .. I NUM>0 S FLIST=FLIST_";"
  1. .. S NUM=NUM+1
  1. .. I NUM>STARTCHK S OK=$$CHKSLEN(FLIST,";"_IND)
  1. .. I OK S FLIST=FLIST_$S(T1="FF":"FF"_T2,1:T2)
  1. S OK=$$CHKSLEN(FLIST,NUM_U)
  1. I OK S ^PXD(811.9,IEN,91)=NUM_U_FLIST
  1. E D
  1. . S ^PXD(811.9,IEN,91)=-1
  1. . D ERRMSG("contraindicated")
  1. Q
  1. ;
  1. ;==================
  1. BLDRESLS(IEN,KI,NODEP) ;Build the Internal Resolution Logic string for a
  1. ;reminder. This is called by FileMan whenever the USE IN RESOLUTION
  1. ;LOGIC field is edited or the user defined Resolution Logic is killed.
  1. ;If there is a user defined RESOLUTION LOGIC then don't do
  1. ;anything.
  1. ;Do not execute as part of a verify fields.
  1. I $G(DIUTIL)="VERIFY FIELDS" Q
  1. ;Do not execute as part of exchange.
  1. I $G(PXRMEXCH) Q
  1. I $L($G(^PXD(811.9,IEN,34)))>0 Q
  1. N FLIST,FTYPE,IND,NODE,NUM,OK,RESLOG,STARTCHK,TEMP,URESLOG
  1. S STARTCHK=$S($D(^PXD(811.9,IEN,25)):100,1:150)
  1. S OK=1
  1. S (FLIST,RESLOG)="",NUM=0
  1. F NODE=20,25 D
  1. . S FTYPE=$S(NODE=20:"FI",NODE=25:"FF")
  1. . S IND=0
  1. . F S IND=$O(^PXD(811.9,IEN,NODE,IND)) Q:+IND=0 D
  1. ..;If an entry is being deleted skip it.
  1. .. I IND=$G(KI),NODE=NODEP Q
  1. .. S TEMP=^PXD(811.9,IEN,NODE,IND,0)
  1. .. S URESLOG=$P(TEMP,U,6)
  1. .. I URESLOG'="" D
  1. ... S RESLOG=RESLOG_URESLOG_FTYPE_"("_IND_")"
  1. ... S NUM=NUM+1
  1. ... I NUM>STARTCHK S OK=$$CHKSLEN(FLIST,";"_IND)
  1. ... I NUM>1 S FLIST=FLIST_";"
  1. ... I OK S FLIST=FLIST_$S(NODE=25:"FF"_IND,1:IND)
  1. ;Save as the internal string and the findings list.
  1. I RESLOG="" S ^PXD(811.9,IEN,35)=""
  1. E D
  1. . S TEMP=$E(RESLOG,1,1)
  1. . S RESLOG=$S(TEMP="&":"(1)",TEMP="!":"(0)",1:"")_RESLOG
  1. . S ^PXD(811.9,IEN,35)=RESLOG
  1. S OK=$$CHKSLEN(FLIST,NUM_U)
  1. I OK S ^PXD(811.9,IEN,36)=NUM_U_FLIST
  1. I 'OK D
  1. . S ^PXD(811.9,IEN,36)=-1
  1. . D ERRMSG("resolution")
  1. ;Check the resolution logic to see if it can be satisfied solely
  1. ;by function findings.
  1. I NUM>0,FLIST["FF",RESLOG'="" D CRESLOG^PXRMFFDB(NUM,FLIST,RESLOG)
  1. Q
  1. ;
  1. ;==================
  1. CHKSLEN(STRING,WORD) ;Determine if appending WORD to STRING will cause
  1. ;string to exceed the maximum string length.
  1. N MAXSLEN S MAXSLEN=512
  1. I ($L(STRING)+$L(WORD))>MAXSLEN Q 0
  1. Q 1
  1. ;
  1. ;==================
  1. CPPCLS(IEN,X) ;Copy the user input Patient Cohort Logic string to the
  1. ;Internal Patient Cohort Logic string.
  1. ;Do not execute as part of a verify fields.
  1. I $G(DIUTIL)="VERIFY FIELDS" Q
  1. ;Do not execute as part of exchange.
  1. I $G(PXRMEXCH) Q
  1. S ^PXD(811.9,IEN,31)=X
  1. ;Get the list of findings.
  1. N FLIST,IND,NUM,OK,OPER,STACK,STARTCHK,T1,T2
  1. S STARTCHK=$S($D(^PXD(811.9,IEN,25)):100,1:150)
  1. S OPER="'U!&",OK=1,NUM=0,FLIST=""
  1. D POSTFIX^PXRMSTAC(X,OPER,.STACK)
  1. F IND=1:1:STACK(0) D
  1. . S T1=STACK(IND)
  1. . I OPER[T1 Q
  1. . I (T1="AGE")!(T1="SEX") D Q
  1. .. I NUM>0 S FLIST=FLIST_";"
  1. .. S NUM=NUM+1,FLIST=FLIST_T1
  1. . I (T1="FF")!(T1="FI") D
  1. .. S IND=IND+1
  1. .. S T2=STACK(IND)
  1. .. I NUM>0 S FLIST=FLIST_";"
  1. .. S NUM=NUM+1
  1. .. I NUM>STARTCHK S OK=$$CHKSLEN(FLIST,";"_IND)
  1. .. I OK S FLIST=FLIST_$S(T1="FF":"FF"_T2,1:T2)
  1. S OK=$$CHKSLEN(FLIST,NUM_U)
  1. I OK S ^PXD(811.9,IEN,32)=NUM_U_FLIST
  1. E D
  1. . S ^PXD(811.9,IEN,32)=-1
  1. . D ERRMSG("cohort")
  1. Q
  1. ;
  1. ;==================
  1. CPRESLS(IEN,X) ;Copy the user input Resolution Logic string to the
  1. ;Internal Resolution Logic string.
  1. ;Do not execute as part of a verify fields.
  1. I $G(DIUTIL)="VERIFY FIELDS" Q
  1. ;Do not execute as part of exchange.
  1. I $G(PXRMEXCH) Q
  1. S ^PXD(811.9,IEN,35)=X
  1. ;Build the list of findings
  1. ;Get the list of findings.
  1. N FLIST,IND,NUM,OK,OPER,STACK,STARTCHK,T1,T2
  1. S STARTCHK=$S($D(^PXD(811.9,IEN,25)):100,1:150)
  1. ;The unary NOT operator is stored as 'U in the stack.
  1. S OPER="'U!&",OK=1,NUM=0,FLIST=""
  1. D POSTFIX^PXRMSTAC(X,OPER,.STACK)
  1. F IND=1:1:STACK(0) D
  1. . S T1=STACK(IND)
  1. . I OPER[T1 Q
  1. . S IND=IND+1
  1. . S T2=STACK(IND)
  1. . S NUM=NUM+1
  1. . I NUM>STARTCHK S OK=$$CHKSLEN(FLIST,";"_IND)
  1. . I NUM>1 S FLIST=FLIST_";"
  1. . I OK S FLIST=FLIST_$S(T1="FF":"FF"_T2,1:T2)
  1. S OK=$$CHKSLEN(FLIST,NUM_U)
  1. I OK D
  1. . S ^PXD(811.9,IEN,36)=NUM_U_FLIST
  1. .;Check the resolution logic to see if it can be satisfied solely
  1. .;by function findings.
  1. . I NUM>0,FLIST["FF",X'="" D CRESLOG^PXRMFFDB(NUM,FLIST,X)
  1. I 'OK D
  1. . S ^PXD(811.9,IEN,40)=-1
  1. . D ERRMSG("resolution")
  1. Q
  1. ;
  1. ;==================
  1. DELNXR(X2) ;For a new style cross-reference check X2 to determine
  1. ;if a delete is being done. If it is a delete all the X2 elements will
  1. ;be null.
  1. N IND,X2NULL
  1. S X2NULL=1
  1. S IND=0
  1. F S IND=$O(X2(IND)) Q:(+IND=0)!('X2NULL) D
  1. . I X2(IND)'="" S X2NULL=0
  1. Q X2NULL
  1. ;
  1. ;==================
  1. EDITNXR(X1,X2) ;For a new style cross-reference check X1 and X2 to determine
  1. ;if an edit is being done.
  1. N ADD,AREDIFF,EDIT,IND,X1NULL,X2NULL
  1. S AREDIFF=0
  1. S (X1NULL,X2NULL)=1
  1. S IND=0
  1. F S IND=$O(X1(IND)) Q:+IND=0 D
  1. . I X1(IND)'="" S X1NULL=0
  1. . I X2(IND)'="" S X2NULL=0
  1. . I X1(IND)'=X2(IND) S AREDIFF=1
  1. I X1NULL&'X2NULL S ADD=1
  1. E S ADD=0
  1. I 'X1NULL&'X2NULL&AREDIFF S EDIT=1
  1. E S EDIT=0
  1. Q (ADD!EDIT)
  1. ;
  1. ;==================
  1. ERRMSG(FTYPE) ;Display too many findings error message.
  1. N TEXT
  1. S TEXT(1)=" "
  1. S TEXT(2)="Error - The number of "_FTYPE_" findings exceeds the maximum allowed!"
  1. S TEXT(3)="The reminder will not function properly until some are removed."
  1. S TEXT(4)=" "
  1. D EN^DDIOL(.TEXT)
  1. Q
  1. ;