Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDLLB.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDLLB.m
r613 r623 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 ; 1 PXRMDLLB ;SLC/PJH - REMINDER DIALOG LOADER ;07/29/2004 2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005 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 TERM(TERMIEN,DFN,IEN) ; 111 ;this section is use to for the term evaluation 112 N ARRAY,CNT,NODE,RESULT,TERMARR 113 N DATEORDR,ESUB,FINDPA,FIEVAL,TFIEVAL,NOCC,BDT,EDT,SDIR,SUB,WVIEN 114 S (TERMARR,TFIEVAL,DATEORDR,FIEVAL)="" 115 ;build term array 116 D TERM^PXRMLDR(TERMIEN,.TERMARR) 117 ;term evaulation 118 D IEVALTER^PXRMTERM(DFN,.TERMARR,.TERMARR,1,.FIEVAL) 119 S RESULT=$G(FIEVAL(1)) 120 ;if the item is one of the WH review reminders build finding item and 121 ;text from the the WVALERTS API in PXRMCWH 122 I RESULT=1,$P($G(^PXRMD(801.41,IEN,0)),U,16)["WHR" D 123 .N IDENT 124 .S IDENT=$P($G(^PXRMD(801.41,IEN,0)),U,16) 125 .I $G(FIEVAL(1,"LINK"))=1,$G(FIEVAL(1,"STATUS"))="OPEN",$G(FIEVAL(1,"VALUE"))="Pending" D 126 ..S WVIEN=$G(FIEVAL(1,"WVIEN")) 127 ..;DBIA #4102 128 ..D RESULTS^WVALERTS(.ARRAY,WVIEN) D 129 ...K WHFIND,WHNAME 130 ...S NODE=$G(ARRAY(0)) I +$P(NODE,U)'>0 Q 131 ...S WHFIND=WVIEN_";WV(790.1,",WHNAME=$P($G(NODE),U,3) 132 ...S (ESUB,SUB)=0 F S SUB=$O(DTXT(SUB)) Q:SUB'>0 S ESUB=SUB 133 ...S ESUB=ESUB+1 134 ...I IDENT="WHRP" D 135 ....N MOD 136 ....S DATE="" 137 ....S DTXT(ESUB)=$P($G(NODE),U,3),ESUB=ESUB+1 138 ....S DATE=$P($G(NODE),U,4),STR=$$RJ^XLFSTR("Collected: ",20) 139 ....S STR=STR_$P($G(NODE),U,8) 140 ....S DTXT(ESUB)=STR,ESUB=ESUB+1 141 ....S STR=$$RJ^XLFSTR("Lab Accession #: ",20),STR=STR_$P($G(NODE),U,9) 142 ....S DTXT(ESUB)=STR,ESUB=ESUB+1 143 ....S STR=$$RJ^XLFSTR("Specimen: ",20),STR=STR_$P($G(NODE),U,10) 144 ....S DTXT(ESUB)=STR 145 ...I IDENT="WHRM" D 146 ....S STR=$$RJ^XLFSTR("Procedure: ",20),STR=STR_$P($G(NODE),U,5) 147 ....S DTXT(ESUB)=STR,ESUB=ESUB+1 148 ....S STR=$$RJ^XLFSTR("Primary Diagnosis: ",20),STR=STR_$P($G(NODE),U,6) 149 ....S DTXT(ESUB)=STR,ESUB=ESUB+1 150 ....S STR=$$RJ^XLFSTR("Modifiers: ",20),MOD=$P($G(NODE),U,7) 151 ....I $G(MOD)="" S STR=STR_"<none>" 152 ....E S STR=STR_$P($G(MOD),"~",1) 153 ....S DTXT(ESUB)=STR,ESUB=ESUB+1 154 ....I $P($G(MOD),"~",2)'="" S DTXT(ESUB)=$$LJ^XLFSTR($P(MOD,"~",2),23) 155 Q +RESULT 156 ;
Note:
See TracChangeset
for help on using the changeset viewer.
