source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDLLB.m@ 1006

Last change on this file since 1006 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version

File size: 5.6 KB
Line 
1PXRMDLLB ;SLC/PJH - REMINDER DIALOG LOADER ;07/29/2004
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4CODE(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 ;
16CODES(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 ;
47EXP(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
64MST(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 ;
95REPLACE(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 ;
110TERM(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 TracBrowser for help on using the repository browser.