| [613] | 1 | PXRMDLLB ;SLC/PJH - REMINDER DIALOG LOADER ;05/01/2007
|
|---|
| 2 | ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
|
|---|
| 3 | ;
|
|---|
| 4 | CODE(DFIEN,DFTYP,ARRAY) ;
|
|---|
| 5 | N ARY,CNT,CNT1
|
|---|
| 6 | I DFTYP["ICD9" S CODE=$P($G(^ICD9(DFIEN,0)),U) D PERIOD^ICDAPIU(CODE,.ARY)
|
|---|
| 7 | I DFTYP["ICPT" S CODE=$P($$CPT^ICPTCOD(DFIEN),U,2) D PERIOD^ICPTAPIU(CODE,.ARY)
|
|---|
| 8 | I $D(ARY)'>0 Q
|
|---|
| 9 | I $P($G(ARY(0)),U,2)'>0 Q
|
|---|
| 10 | S (CNT,CNT1)=0
|
|---|
| 11 | F S CNT=$O(ARY(CNT)) Q:CNT="" D
|
|---|
| 12 | . S ARRAY(CNT1)=CODE_":"_CNT_":"_$P($G(ARY(CNT)),U)
|
|---|
| 13 | . S CNT1=CNT1+1
|
|---|
| 14 | Q
|
|---|
| 15 | ;
|
|---|
| 16 | CODES(FILE,TXIEN,ARRAY) ;Return selectable codes from taxonomy file
|
|---|
| 17 | N CNT,CODE,CSCNT,DATA,DATES,DISPLAY,IEN,INSTALL,TEMP,TEXT,NODE,SUB
|
|---|
| 18 | S SUB=0,CNT=0,NODE=$S(FILE=80:"SDX",FILE=81:"SPR")
|
|---|
| 19 | F S SUB=$O(^PXD(811.2,TXIEN,NODE,SUB)) Q:'SUB D
|
|---|
| 20 | .S DATA=$G(^PXD(811.2,TXIEN,NODE,SUB,0)) Q:DATA=""
|
|---|
| 21 | .;Ignore if disabled
|
|---|
| 22 | .S DISPLAY=""
|
|---|
| 23 | .I $P(DATA,U,3)=1 Q
|
|---|
| 24 | .;Get ien of code
|
|---|
| 25 | .S IEN=$P(DATA,U) Q:IEN=""
|
|---|
| 26 | .;get date ranges and text from period api
|
|---|
| 27 | .K ARY
|
|---|
| 28 | .I FILE=80 S CODE=$P($G(^ICD9(IEN,0)),U)
|
|---|
| 29 | .I FILE=81 S CODE=$P($$CPT^ICPTCOD(IEN),U,2)
|
|---|
| 30 | .S DISPLAY=$P($G(DATA),U,2)
|
|---|
| 31 | .S TEMP=$$CODE^PXRMVAL(CODE,FILE) Q:'$P(TEMP,U) Q:$P(TEMP,U,9)=1
|
|---|
| 32 | .;Set display text from taxonomy selectable code text
|
|---|
| 33 | .S TEXT=$P(DATA,U,2)
|
|---|
| 34 | .;otherwise use icd9/cpt description
|
|---|
| 35 | .I TEXT="",FILE=80 S TEXT=$P($$ICDDX^ICDCODE(IEN),U,3)
|
|---|
| 36 | .I TEXT="",FILE=81 S TEXT=$P($$CPT^ICPTCOD(IEN),U,3)
|
|---|
| 37 | .I FILE=80 D PERIOD^ICDAPIU(CODE,.ARY)
|
|---|
| 38 | .I FILE=81 D PERIOD^ICPTAPIU(CODE,.ARY)
|
|---|
| 39 | .I $D(ARY)'>0 Q
|
|---|
| 40 | .I $P($G(ARY(0)),U,2)'>0 Q
|
|---|
| 41 | .S CSCNT=0 F S CSCNT=$O(ARY(CSCNT)) Q:CSCNT="" D
|
|---|
| 42 | ..S DATES=":"_CSCNT_":"_$P($G(ARY(CSCNT)),U)
|
|---|
| 43 | ..S TEXT=$P($G(ARY(CSCNT)),U,2) I $G(DISPLAY)'="" S TEXT=DISPLAY
|
|---|
| 44 | ..S CNT=CNT+1,ARRAY(CNT)=IEN_U_$G(CODE)_$G(DATES)_U_$G(TEXT)
|
|---|
| 45 | Q
|
|---|
| 46 | ;
|
|---|
| 47 | EXP(TIEN,DCUR,DTTYP) ;Expand taxonomy codes
|
|---|
| 48 | N CODES,CNT,FILE,LIT,CAT
|
|---|
| 49 | S FILE=$S(DTTYP="POV":80,DTTYP="CPT":81,1:"") Q:'FILE
|
|---|
| 50 | S LIT="Selectable "_$S(FILE=80:"Diagnoses:",1:"Procedures:")
|
|---|
| 51 | S CAT=$P($G(^PXD(811.2,TIEN,0)),U)
|
|---|
| 52 | ;
|
|---|
| 53 | S OCNT=OCNT+1
|
|---|
| 54 | S ORY(OCNT)=3_U_DITEM_U_U_DTTYP_U_U_U_U_U_CAT_U_LIT
|
|---|
| 55 | ;Get selectable codes
|
|---|
| 56 | D CODES(FILE,TIEN,.CODES)
|
|---|
| 57 | S CNT=0
|
|---|
| 58 | ;Save selectable codes as type 5 records
|
|---|
| 59 | F S CNT=$O(CODES(CNT)) Q:'CNT D
|
|---|
| 60 | .S OCNT=OCNT+1,ORY(OCNT)=5_U_DITEM_U_U_DTTYP_U_U_CODES(CNT)
|
|---|
| 61 | Q
|
|---|
| 62 | ;
|
|---|
| 63 | ;Pass MST code as a forced value
|
|---|
| 64 | MST(DFTYP,DFIEN) ;
|
|---|
| 65 | ;Validate finding ien
|
|---|
| 66 | Q:DFIEN=""
|
|---|
| 67 | ;For each MST term check if finding is mapped
|
|---|
| 68 | N FOUND,TCOND,TIEN,TNAM,TSUB
|
|---|
| 69 | S FOUND=0
|
|---|
| 70 | F TNAM="POSITIVE","NEGATIVE","DECLINES" D Q:FOUND
|
|---|
| 71 | .;Get term IEN
|
|---|
| 72 | .S TIEN=$O(^PXRMD(811.5,"B","MST "_TNAM_" REPORT","")) Q:'TIEN
|
|---|
| 73 | .;Check if finding is mapped to term
|
|---|
| 74 | .Q:'$D(^PXRMD(811.5,TIEN,20,"E",DFTYP,DFIEN))
|
|---|
| 75 | .;If exam and term condition logic is null ignore
|
|---|
| 76 | .I DFTYP="AUTTEXAM(" D Q:TCOND=""
|
|---|
| 77 | ..S TCOND="",TSUB=$O(^PXRMD(811.5,TIEN,20,"E",DFTYP,DFIEN,"")) Q:'TSUB
|
|---|
| 78 | ..S TCOND=$P($G(^PXRMD(811.5,TIEN,20,TSUB,3)),U)
|
|---|
| 79 | .;If it is then create additional prompt for MST
|
|---|
| 80 | .N DSEQ,DEXC,DDEF,DGUI,DTYP,DTEXT,DSNL,DREQ
|
|---|
| 81 | .;Add to end of array
|
|---|
| 82 | .S DSEQ=$O(ARRAY(""),-1)+1
|
|---|
| 83 | .;Null fields
|
|---|
| 84 | .S DDEF="",DEXC="",DTEXT="",DSNL="",DREQ=""
|
|---|
| 85 | .;MST status (exept for exams)
|
|---|
| 86 | .I DFTYP'="AUTTEXAM(" S DDEF=$$STCODE^PXRMMST("MST "_TNAM_" REPORT")
|
|---|
| 87 | .;GUI process and forced value
|
|---|
| 88 | .S DGUI="MST",DTYP="F"
|
|---|
| 89 | .;Save in array
|
|---|
| 90 | .S ARRAY(DSEQ)=DGUI_U_DEXC_U_DDEF_U_DTYP_U_DTEXT_U_DSNL_U_DREQ
|
|---|
| 91 | .;Quit after the first term is found
|
|---|
| 92 | .S FOUND=1
|
|---|
| 93 | Q
|
|---|
| 94 | ;
|
|---|
| 95 | REPLACE(DFN,TERMNODE,DITEM,DATA,TERMSTAT) ;
|
|---|
| 96 | ;this section is use to compare the term evalution result against
|
|---|
| 97 | ;the value store in the Reminder Term Status field.
|
|---|
| 98 | ;If the value match and the replacement item is active then the orginal
|
|---|
| 99 | ;item will be replace with the new item.
|
|---|
| 100 | N TERMOUT
|
|---|
| 101 | S TERMSTAT=1 I +$P(TERMNODE,U),$P($G(TERMNODE),U,2)'="" D Q:+TERMSTAT=0
|
|---|
| 102 | .N DITEMO
|
|---|
| 103 | .S TERMOUT=$$TERM($P(TERMNODE,U),DFN,$G(DITEM))
|
|---|
| 104 | .I TERMOUT'=$P(TERMNODE,U,2) Q
|
|---|
| 105 | .I +$P(TERMNODE,U,3)'>0 S TERMSTAT=0 Q
|
|---|
| 106 | .S DITEMO=DITEM,DITEM=$P(TERMNODE,U,3),DATA=$G(^PXRMD(801.41,DITEM,0))
|
|---|
| 107 | .I $G(DATA)=""!($P(DATA,U,3)]"") S DITEM=DITEMO Q
|
|---|
| 108 | Q
|
|---|
| 109 | ;
|
|---|
| 110 | RESGROUP(DIEN) ;
|
|---|
| 111 | N CNT,RESULT,TEMP
|
|---|
| 112 | S RESULT=""
|
|---|
| 113 | I $$PATCH^XPDUTL("OR*3.0*243")=0 D Q RESULT
|
|---|
| 114 | .S RESULT=$P($G(^PXRMD(801.41,DIEN,51,1,0)),U) I RESULT="" Q
|
|---|
| 115 | .I $P($G(^PXRMD(801.41,RESULT,0)),U,3)'="" S RESULT="" Q
|
|---|
| 116 | S CNT=0 F S CNT=$O(^PXRMD(801.41,DIEN,51,CNT)) Q:CNT'>0 D
|
|---|
| 117 | .S TEMP=$P($G(^PXRMD(801.41,DIEN,51,CNT,0)),U) I TEMP="" Q
|
|---|
| 118 | .I $P($G(^PXRMD(801.41,TEMP,0)),U,3)'="" S TEMP="" Q
|
|---|
| 119 | .S RESULT=$S(RESULT="":TEMP,1:RESULT_"~"_TEMP)
|
|---|
| 120 | Q RESULT
|
|---|
| 121 | ;
|
|---|
| 122 | TERM(TERMIEN,DFN,IEN) ;
|
|---|
| 123 | ;this section is use to for the term evaluation
|
|---|
| 124 | N ARRAY,CNT,NODE,RESULT,TERMARR
|
|---|
| 125 | N DATEORDR,ESUB,FINDPA,FIEVAL,TFIEVAL,NOCC,BDT,EDT,SDIR,SUB,WVIEN
|
|---|
| 126 | S (TERMARR,TFIEVAL,DATEORDR,FIEVAL)=""
|
|---|
| 127 | ;build term array
|
|---|
| 128 | D TERM^PXRMLDR(TERMIEN,.TERMARR)
|
|---|
| 129 | ;term evaulation
|
|---|
| 130 | D IEVALTER^PXRMTERM(DFN,.TERMARR,.TERMARR,1,.FIEVAL)
|
|---|
| 131 | S RESULT=$G(FIEVAL(1))
|
|---|
| 132 | ;if the item is one of the WH review reminders build finding item and
|
|---|
| 133 | ;text from the the WVALERTS API in PXRMCWH
|
|---|
| 134 | I RESULT=1,$P($G(^PXRMD(801.41,IEN,0)),U,16)["WHR" D
|
|---|
| 135 | .N IDENT
|
|---|
| 136 | .S IDENT=$P($G(^PXRMD(801.41,IEN,0)),U,16)
|
|---|
| 137 | .I $G(FIEVAL(1,"LINK"))=1,$G(FIEVAL(1,"STATUS"))="OPEN",$G(FIEVAL(1,"VALUE"))="Pending" D
|
|---|
| 138 | ..S WVIEN=$G(FIEVAL(1,"WVIEN"))
|
|---|
| 139 | ..;DBIA #4102
|
|---|
| 140 | ..D RESULTS^WVALERTS(.ARRAY,WVIEN) D
|
|---|
| 141 | ...K WHFIND,WHNAME
|
|---|
| 142 | ...S NODE=$G(ARRAY(0)) I +$P(NODE,U)'>0 Q
|
|---|
| 143 | ...S WHFIND=WVIEN_";WV(790.1,",WHNAME=$P($G(NODE),U,3)
|
|---|
| 144 | ...S (ESUB,SUB)=0 F S SUB=$O(DTXT(SUB)) Q:SUB'>0 S ESUB=SUB
|
|---|
| 145 | ...S ESUB=ESUB+1
|
|---|
| 146 | ...I IDENT="WHRP" D
|
|---|
| 147 | ....N MOD
|
|---|
| 148 | ....S DATE=""
|
|---|
| 149 | ....S DTXT(ESUB)=$P($G(NODE),U,3),ESUB=ESUB+1
|
|---|
| 150 | ....S DATE=$P($G(NODE),U,4),STR=$$RJ^XLFSTR("Collected: ",20)
|
|---|
| 151 | ....S STR=STR_$P($G(NODE),U,8)
|
|---|
| 152 | ....S DTXT(ESUB)=STR,ESUB=ESUB+1
|
|---|
| 153 | ....S STR=$$RJ^XLFSTR("Lab Accession #: ",20),STR=STR_$P($G(NODE),U,9)
|
|---|
| 154 | ....S DTXT(ESUB)=STR,ESUB=ESUB+1
|
|---|
| 155 | ....S STR=$$RJ^XLFSTR("Specimen: ",20),STR=STR_$P($G(NODE),U,10)
|
|---|
| 156 | ....S DTXT(ESUB)=STR
|
|---|
| 157 | ...I IDENT="WHRM" D
|
|---|
| 158 | ....S STR=$$RJ^XLFSTR("Procedure: ",20),STR=STR_$P($G(NODE),U,5)
|
|---|
| 159 | ....S DTXT(ESUB)=STR,ESUB=ESUB+1
|
|---|
| 160 | ....S STR=$$RJ^XLFSTR("Primary Diagnosis: ",20),STR=STR_$P($G(NODE),U,6)
|
|---|
| 161 | ....S DTXT(ESUB)=STR,ESUB=ESUB+1
|
|---|
| 162 | ....S STR=$$RJ^XLFSTR("Modifiers: ",20),MOD=$P($G(NODE),U,7)
|
|---|
| 163 | ....I $G(MOD)="" S STR=STR_"<none>"
|
|---|
| 164 | ....E S STR=STR_$P($G(MOD),"~",1)
|
|---|
| 165 | ....S DTXT(ESUB)=STR,ESUB=ESUB+1
|
|---|
| 166 | ....I $P($G(MOD),"~",2)'="" S DTXT(ESUB)=$$LJ^XLFSTR($P(MOD,"~",2),23)
|
|---|
| 167 | Q +RESULT
|
|---|
| 168 | ;
|
|---|
