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

PXRMDLLB.m

Go to the documentation of this file.
  1. PXRMDLLB ;SLC/PJH - REMINDER DIALOG LOADER ;01/02/2014
  1. ;;2.0;CLINICAL REMINDERS;**6,12,16,26**;Feb 04, 2005;Build 404
  1. ;
  1. ;
  1. CODES(TXIEN,CODESYS,ARRAY) ;
  1. N CNT,CODE,DATES,END,IEN,NODE,START,TEXT,TYPE
  1. S CNT=0
  1. S TYPE="" F S TYPE=$O(CODESYS(TYPE)) Q:TYPE="" D
  1. .S CODE="" F S CODE=$O(^PXD(811.2,TXIEN,20,"AUID",TYPE,CODE)) Q:CODE="" D
  1. ..S START="" F S START=$O(^PXD(811.2,TXIEN,20,"AUID",TYPE,CODE,START)) Q:START="" D
  1. ...S END="" F S END=$O(^PXD(811.2,TXIEN,20,"AUID",TYPE,CODE,START,END)) Q:END="" D
  1. ....S NODE=$G(^PXD(811.2,TXIEN,20,"AUID",TYPE,CODE,START,END)) I NODE="" Q
  1. ....S IEN=$P(NODE,U),TEXT=$P(NODE,U,2)
  1. ....S DATES=START_":"_$S(END>0:END,1:"")
  1. ....S CNT=CNT+1,ARRAY(CNT)=IEN_U_$G(CODE)_":"_$G(DATES)_U_$G(TEXT)
  1. Q
  1. ;
  1. EXPTAX(DITEM,TIEN,DCUR) ;
  1. ;this function handles taxonomy that are set to not display.
  1. N CAT,DTTYP,FIND,FILE,NODE,TSEL
  1. S NODE=$G(^PXRMD(801.41,DITEM,"TAX"))
  1. S TSEL=$P(NODE,U)
  1. I "ND"[TSEL D EXP(DITEM,TIEN,DCUR,"CPT",3)
  1. I "NP"[TSEL D EXP(DITEM,TIEN,DCUR,"POV",3)
  1. Q
  1. ;
  1. ;
  1. EXP(DITEM,TIEN,DCUR,DTTYP,TYPE) ;Expand taxonomy codes
  1. N CAT,CODES,CODETYPE,CNT,ENC,FILE,LIT
  1. I DTTYP="" Q
  1. ;S FILE=$S(DTTYP="POV":80,DTTYP="CPT":81,1:"") Q:'FILE
  1. S LIT="Selectable "_$S(DTTYP="POV":"Diagnoses:",1:"Procedures:")
  1. S CAT=$P($G(^PXD(811.2,TIEN,0)),U)
  1. ;
  1. D BLDCODE^PXRMDTAX(DTTYP,.CODETYPE)
  1. ;I FILE=80 S CODETYPE("ICD")="",CODETYPE("10D")=""
  1. ;I FILE=81 S CODETYPE("CPT")=""
  1. S OCNT=OCNT+1
  1. I TYPE=5 S ORY(OCNT)=3_U_DITEM_U_U_DTTYP_U_1_U_U_U_U_CAT_U_LIT
  1. ;Get selectable codes
  1. D CODES(TIEN,.CODETYPE,.CODES)
  1. S CNT=0
  1. ;Save selectable codes as type 5 or 3 records
  1. F S CNT=$O(CODES(CNT)) Q:'CNT D
  1. .S OCNT=OCNT+1,ORY(OCNT)=TYPE_U_DITEM_U_U_DTTYP_U_U_CODES(CNT)
  1. Q
  1. ;
  1. ;Pass MST code as a forced value
  1. MST(DFTYP,DFIEN) ;
  1. ;Validate finding ien
  1. Q:DFIEN=""
  1. ;For each MST term check if finding is mapped
  1. N FOUND,TCOND,TIEN,TNAM,TSUB
  1. S FOUND=0
  1. F TNAM="POSITIVE","NEGATIVE","DECLINES" D Q:FOUND
  1. .;Get term IEN
  1. .S TIEN=$O(^PXRMD(811.5,"B","MST "_TNAM_" REPORT","")) Q:'TIEN
  1. .;Check if finding is mapped to term
  1. .Q:'$D(^PXRMD(811.5,TIEN,20,"E",DFTYP,DFIEN))
  1. .;If exam and term condition logic is null ignore
  1. .I DFTYP="AUTTEXAM(" D Q:TCOND=""
  1. ..S TCOND="",TSUB=$O(^PXRMD(811.5,TIEN,20,"E",DFTYP,DFIEN,"")) Q:'TSUB
  1. ..S TCOND=$P($G(^PXRMD(811.5,TIEN,20,TSUB,3)),U)
  1. .;If it is then create additional prompt for MST
  1. .N DSEQ,DEXC,DDEF,DGUI,DTYP,DTEXT,DSNL,DREQ
  1. .;Add to end of array
  1. .S DSEQ=$O(ARRAY(""),-1)+1
  1. .;Null fields
  1. .S DDEF="",DEXC="",DTEXT="",DSNL="",DREQ=""
  1. .;MST status (exept for exams)
  1. .I DFTYP'="AUTTEXAM(" S DDEF=$$STCODE^PXRMMST("MST "_TNAM_" REPORT")
  1. .;GUI process and forced value
  1. .S DGUI="MST",DTYP="F"
  1. .;Save in array
  1. .S ARRAY(DSEQ)=DGUI_U_DEXC_U_DDEF_U_DTYP_U_DTEXT_U_DSNL_U_DREQ
  1. .;Quit after the first term is found
  1. .S FOUND=1
  1. Q
  1. ;
  1. REPLACE(DFN,TERMNODE,DITEM,DATA,TERMSTAT) ;
  1. ;this section is use to compare the term evalution result against
  1. ;the value store in the Reminder Term Status field.
  1. ;If the value match and the replacement item is active then the orginal
  1. ;item will be replace with the new item.
  1. N TERMOUT
  1. S TERMSTAT=1 I +$P(TERMNODE,U),$P($G(TERMNODE),U,2)'="" D Q:+TERMSTAT=0
  1. .N DITEMO
  1. .S TERMOUT=$$TERM($P(TERMNODE,U),DFN,$G(DITEM),"D")
  1. .I TERMOUT'=$P(TERMNODE,U,2) Q
  1. .I +$P(TERMNODE,U,3)'>0 S TERMSTAT=0 Q
  1. .S DITEMO=DITEM,DITEM=$P(TERMNODE,U,3),DATA=$G(^PXRMD(801.41,DITEM,0))
  1. .I $G(DATA)=""!($$ISDISAB^PXRMDLL(DITEM)=1) S DITEM=$O(^PXRMD(801.41,"B","VA-DISABLE BRANCHING LOGIC REPLACEMENT ELEMENT","")) Q
  1. Q
  1. ;
  1. RESGROUP(DIEN) ;
  1. N CNT,RESULT,TEMP
  1. S RESULT=""
  1. I $$PATCH^XPDUTL("OR*3.0*243")=0 D Q RESULT
  1. .S RESULT=$P($G(^PXRMD(801.41,DIEN,51,1,0)),U) I RESULT="" Q
  1. .I $$ISDISAB^PXRMDLL(RESULT)=1 S RESULT="" Q
  1. S CNT=0 F S CNT=$O(^PXRMD(801.41,DIEN,51,CNT)) Q:CNT'>0 D
  1. .S TEMP=$P($G(^PXRMD(801.41,DIEN,51,CNT,0)),U) I TEMP="" Q
  1. .I $$ISDISAB^PXRMDLL(TEMP)=1 S TEMP="" Q
  1. .S RESULT=$S(RESULT="":TEMP,1:RESULT_"~"_TEMP)
  1. Q RESULT
  1. ;
  1. TERM(TERMIEN,DFN,IEN,TYPE) ;
  1. ;this section is use to for the term evaluation
  1. N ARRAY,CNT,NODE,RESULT,STR,TERMARR
  1. N DATEORDR,ESUB,FINDPA,FIEVAL,TFIEVAL,NOCC,BDT,EDT,SDIR,SUB,WVIEN
  1. S (TERMARR,TFIEVAL,DATEORDR,FIEVAL)=""
  1. ;build term array
  1. D TERM^PXRMLDR(TERMIEN,.TERMARR)
  1. ;term evaulation
  1. D IEVALTER^PXRMTERM(DFN,.TERMARR,.TERMARR,1,.FIEVAL)
  1. S RESULT=$G(FIEVAL(1))
  1. I TYPE="O" Q +RESULT
  1. ;if the item is one of the WH review reminders build finding item and
  1. ;text from the the WVALERTS API in PXRMCWH
  1. I RESULT=1,$P($G(^PXRMD(801.41,IEN,0)),U,16)["WHR" D
  1. .N IDENT,DATE
  1. .S IDENT=$P($G(^PXRMD(801.41,IEN,0)),U,16)
  1. .I $G(FIEVAL(1,"LINK"))=1,$G(FIEVAL(1,"STATUS"))="OPEN",$G(FIEVAL(1,"VALUE"))="Pending" D
  1. ..S WVIEN=$G(FIEVAL(1,"WVIEN"))
  1. ..;DBIA #4102
  1. ..D RESULTS^WVALERTS(.ARRAY,WVIEN) D
  1. ...K WHFIND,WHNAME
  1. ...S NODE=$G(ARRAY(0)) I +$P(NODE,U)'>0 Q
  1. ...S WHFIND=WVIEN_";WV(790.1,",WHNAME=$P($G(NODE),U,3)
  1. ...S (ESUB,SUB)=0 F S SUB=$O(DTXT(SUB)) Q:SUB'>0 S ESUB=SUB
  1. ...S ESUB=ESUB+1
  1. ...I IDENT="WHRP" D
  1. ....N MOD
  1. ....S DATE=""
  1. ....S DTXT(ESUB)=$P($G(NODE),U,3),ESUB=ESUB+1
  1. ....S DATE=$P($G(NODE),U,4),STR=$$RJ^XLFSTR("Collected: ",20)
  1. ....S STR=STR_$P($G(NODE),U,8)
  1. ....S DTXT(ESUB)=STR,ESUB=ESUB+1
  1. ....S STR=$$RJ^XLFSTR("Lab Accession #: ",20),STR=STR_$P($G(NODE),U,9)
  1. ....S DTXT(ESUB)=STR,ESUB=ESUB+1
  1. ....S STR=$$RJ^XLFSTR("Specimen: ",20),STR=STR_$P($G(NODE),U,10)
  1. ....S DTXT(ESUB)=STR
  1. ...I IDENT="WHRM" D
  1. ....S STR=$$RJ^XLFSTR("Procedure: ",20),STR=STR_$P($G(NODE),U,5)
  1. ....S DTXT(ESUB)=STR,ESUB=ESUB+1
  1. ....S STR=$$RJ^XLFSTR("Primary Diagnosis: ",20),STR=STR_$P($G(NODE),U,6)
  1. ....S DTXT(ESUB)=STR,ESUB=ESUB+1
  1. ....S STR=$$RJ^XLFSTR("Modifiers: ",20),MOD=$P($G(NODE),U,7)
  1. ....I $G(MOD)="" S STR=STR_"<none>"
  1. ....E S STR=STR_$P($G(MOD),"~",1)
  1. ....S DTXT(ESUB)=STR,ESUB=ESUB+1
  1. ....I $P($G(MOD),"~",2)'="" S DTXT(ESUB)=$$LJ^XLFSTR($P(MOD,"~",2),23)
  1. Q +RESULT
  1. ;