source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMXX1.m@ 1553

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

initial load of FOIAVistA 6/30/08 version

File size: 5.9 KB
Line 
1PXRMXX1 ; SLC/PJH - Build list of reminder findings;08/03/2005
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4 ;Called at REM, REPORT and PSMERG from PXRMXX
5 ;
6 ;Merge the patients found by the pharmacy API
7 ;--------------------------------------------
8PSMERG(TYP,NODE,SEARCH) ;
9 N DATA,DATE,DCNT,DFN,DRUG,DSUP,FCNT,FINDING,FIEN,FLD,FTYP,FREC,FUNIQ
10 N LAST,LDATE,NEXT,RDATE,SDATE,STOPDATE,TERM,TIEN,VTYP
11 ;
12 S DFN="",VTYP=$S(TYP="PXRMPSI":"I",1:"O")
13 F S DFN=$O(^TMP(TYP_NODE,$J,DFN)) Q:'DFN D
14 .;Get last entry for this patient created by reminder evaluation
15 .S LAST=$O(^TMP(NODE,$J,DFN,"FIND",""),-1),NEXT=LAST+1,DCNT=0
16 .;If this is a new patient update patient and finding count
17 .I NEXT=1 S PXRMFCNT=PXRMFCNT+1,PXRMCNT=PXRMCNT+1
18 .;Scan through medications found for this patient
19 .F S DCNT=$O(^TMP(TYP_NODE,$J,DFN,DCNT)) Q:'DCNT D
20 ..;Move data fields into FIEVAL format
21 ..S FINDING=$P($G(^TMP(TYP_NODE,$J,DFN,DCNT,0)),U) Q:FINDING=""
22 ..S DATA=$G(^TMP(TYP_NODE,$J,DFN,DCNT,1)),DATE=$P(DATA,U)
23 ..S RDATE=$P(DATA,U,2),DRUG=$P(DATA,U,3),DSUP=$P(DATA,U,4)
24 ..;Stop date
25 ..S STOPDATE=$P(DATA,U,5)
26 ..I +STOPDATE S DSUP=$$FMDIFF^XLFDT(STOPDATE,DATE,"")
27 ..;Determine finding item/type
28 ..S FTYPE=$P(FINDING,";",2),FIEN=$P(FINDING,";") Q:FIEN="" Q:FTYPE=""
29 ..;Create file entry for each term
30 ..S TIEN=""
31 ..F S TIEN=$O(SEARCH(FTYPE,FIEN,TIEN)) Q:TIEN="" D
32 ...F FLD="FINDING","DATE","RDATE","DRUG","DSUP","STOPDATE" D
33 ....S ^TMP(NODE,$J,DFN,"FIND",NEXT,FLD)=@FLD
34 ...;Get term name (no transforms)
35 ...S ^TMP(NODE,$J,DFN,"FIND",NEXT,"TERM")=$P($G(^PXRMD(811.5,TIEN,0)),U)
36 ...;Update header
37 ...S ^TMP(NODE,$J,DFN,"FIND",NEXT)=DATE_U_VTYP
38 ...;Update finding header
39 ...S LDATE=$P($G(^TMP(NODE,$J,DFN)),U)
40 ...I DATE>LDATE S ^TMP(NODE,$J,DFN)=DATE_U_VTYP
41 ...;Save count by finding for report
42 ...S FREC=$G(PXRMFIEN(FINDING)),FCNT=$P(FREC,U),FUNIQ=$P(FREC,U,2)
43 ...S FCNT=FCNT+1 I '$G(FUNIQ(FIEN)) S FUNIQ=FUNIQ+1
44 ...S PXRMFIEN(FINDING)=FCNT_U_FUNIQ,FUNIQ(FINDING)=1
45 ...;Update count
46 ...S NEXT=NEXT+1
47 Q
48 ;
49 ;Build list of related findings
50 ;------------------------------
51REM(PXRMITEM,OUTPUT,LAB) ;
52 N COHORT,FTYPE,FIEN,FNODE,TNAM,TIEN
53 S FTYPE=""
54 ;Check if terms findings exist on the reminder
55 F S FTYPE=$O(^PXD(811.9,PXRMITEM,20,"E",FTYPE)) Q:FTYPE="" D
56 .;Check terms ONLY
57 .I FTYPE="PXRMD(811.5," D Q
58 ..N FTYPE S TIEN=""
59 ..;Scan through terms in this reminder
60 ..F S TIEN=$O(^PXD(811.9,PXRMITEM,20,"E","PXRMD(811.5,",TIEN)) Q:'TIEN D
61 ...;Get the cohort flag
62 ...S FNODE=$O(^PXD(811.9,PXRMITEM,20,"E","PXRMD(811.5,",TIEN,""))
63 ...S COHORT="",FTYPE=""
64 ...I FNODE S COHORT=$P($G(^PXD(811.9,PXRMITEM,20,FNODE,0)),U,7)
65 ...;Scan through term looking for findings
66 ...F S FTYPE=$O(^PXRMD(811.5,TIEN,20,"E",FTYPE)) Q:FTYPE="" D
67 ....;Taxonomy findings
68 ....I FTYPE="PXD(811.2," D RTAX Q
69 ....;If Lab test and not in cohort ignore
70 ....I FTYPE="LAB(60,",COHORT="" D Q
71 .....;Only applies to lab extract reminder
72 .....I $G(REM(PXRMITEM))'="VA-NATIONAL EPI LAB EXTRACT" Q
73 .....;Get the term name for this lab test
74 .....S TNAM=$P($G(^PXRMD(811.5,TIEN,0)),U) Q:TNAM=""
75 .....S LAB(TNAM)=TIEN Q
76 ....;Other findings
77 ....D RSET
78 Q
79 ;
80 ;Save report details
81 ;-------------------
82REPORT(NODE) ;
83 N RDATE,CNT,CN1,COUNT,DATA,LAST,OLD,DESC
84 ;format rundate as MMDDYY
85 S RDATE=$$DT^XLFDT,RDATE=$E(RDATE,4,5)_$E(RDATE,6,7)_$E(RDATE,2,3)
86 ;Task Name
87 S DESC="LREPI "_$E(PXRMEDT,2,3)_"/"_$E(PXRMEDT,4,5)_" "_RDATE
88 S DATA=$G(^PXRMXT(810.3,0))
89 ;Find next entry in report file
90 S LAST=$P(DATA,U,3),COUNT=$P(DATA,U,4)+1,CNT=LAST+1
91 S $P(^PXRMXT(810.3,0),U,3)=CNT,$P(^PXRMXT(810.3,0),U,4)=COUNT
92 ;Save Task and extract parameters
93 S ^PXRMXT(810.3,CNT,0)=DESC_U_PXRMBDT_U_PXRMEDT_U_$G(ZTSK)_U_DUZ_U_$$NOW^XLFDT_U_PXRMCNT_U_PXRMFCNT
94 S $P(^PXRMXT(810.3,CNT,50),U)=1
95 S $P(^PXRMXT(810.3,CNT,100),U)="N"
96 ;Transfer findings into report file
97 N DATE,DFN,DRUG,DSUP,ENC,EREC,ETYP,IC,FINDING,RESULT
98 N TERM,ALTTRM,TIEN,TNDBID,VALUE,VIEN
99 S DFN=0,CN1=0
100 F S DFN=$O(^TMP(NODE,$J,DFN)) Q:'DFN Q:TSTOP=1 D
101 .;Check if stop task requested
102 .I $$S^%ZTLOAD S TSTOP=1 Q
103 .S ENC=0
104 .F S ENC=$O(^TMP(NODE,$J,DFN,"FIND",ENC)) Q:'ENC D
105 ..;DINUM
106 ..S CN1=CN1+1
107 ..;Encounter type
108 ..S ETYP=$P($G(^TMP(NODE,$J,DFN,"FIND",ENC)),U,2)
109 ..;Finding details
110 ..F IC="DATE","FINDING","RESULT","TERM","ALTTRM","VALUE","VIEN" D
111 ...S @IC=$P($G(^TMP(NODE,$J,DFN,"FIND",ENC,IC)),U)
112 ..;Drug details
113 ..F IC="DRUG","DSUP" D
114 ...S @IC=$P($G(^TMP(NODE,$J,DFN,"FIND",ENC,IC)),U)
115 ..;Get the term ien for the original term if a mapping occurred
116 ..S TIEN="",TNDBID=""
117 ..I TERM]"" S TIEN=$O(^PXRMD(811.5,"B",TERM,"")),TNDBID=ALTTRM
118 ..;Save value if the result is null
119 ..I RESULT="" S RESULT=VALUE
120 ..;Save data to file
121 ..S EREC=DFN_U_U_TIEN_U_FINDING_U_TNDBID_U_DATE_U_VIEN_U_ETYP
122 ..S ^PXRMXT(810.3,CNT,1,CN1,0)=EREC
123 ..S EREC=RESULT_U_VALUE_U_DRUG_U_DSUP
124 ..S ^PXRMXT(810.3,CNT,1,CN1,1)=EREC
125 ;
126 ;Set top node for ^DIK re-index
127 S ^PXRMXT(810.3,CNT,1,0)="^810.31A^"_CN1_U_CN1
128 ;
129 ;Write finding totals to report file
130 N FCNT,FUNIQ,FIEN,FFIEN
131 S FIEN="",CN1=0
132 F S FIEN=$O(PXRMFIEN(FIEN)) Q:FIEN="" D
133 .S FCNT=+$P(PXRMFIEN(FIEN),U),FUNIQ=+$P(PXRMFIEN(FIEN),U,2)
134 .S FFIEN=FIEN I FFIEN="NO FINDING" S FFIEN=""
135 .S CN1=CN1+1,^PXRMXT(810.3,CNT,2,CN1,0)=FFIEN_U_FCNT_U_FUNIQ
136 ;
137 ;Set top node for ^DIK re-index
138 S ^PXRMXT(810.3,CNT,2,0)="^810.32A^"_CN1_U_CN1
139 ;
140 ;Re-index the file for this batch
141 N DIK,DA
142 S DIK="^PXRMXT(810.3,",DA=CNT
143 D IX1^DIK
144 ;
145 Q
146 ;
147 ;Store finding for term
148 ;----------------------
149RSET N FIEN
150 S FIEN=""
151 F S FIEN=$O(^PXRMD(811.5,TIEN,20,"E",FTYPE,FIEN)) Q:'FIEN D
152 .S OUTPUT(FTYPE,FIEN,TIEN)=""
153 Q
154 ;
155 ;Store the taxonomy ICD9 codes
156 ;-----------------------------
157RTAX N FIEN,ISUB,TXIEN
158 S TXIEN=""
159 ;Scan taxonomy section of the term
160 F S TXIEN=$O(^PXRMD(811.5,TIEN,20,"E",FTYPE,TXIEN)) Q:'TXIEN D
161 .S ISUB=""
162 .;Extract ICD9 codes from expanded taxonomy file
163 .F S ISUB=$O(^PXD(811.3,TXIEN,80,ISUB)) Q:'ISUB D
164 ..S FIEN=$P($G(^PXD(811.3,TXIEN,80,ISUB,0)),U) Q:'FIEN
165 ..S OUTPUT("ICD9(",FIEN,TIEN)=""
166 Q
Note: See TracBrowser for help on using the repository browser.