source: ePrescribing/trunk/p/C0PALGY1.m@ 1800

Last change on this file since 1800 was 1595, checked in by George Lilly, 12 years ago

initial release of ePrescribing
File size: 5.1 KB
Line 
1C0PALGY1 ; ERX/GPL/SMH - eRx Allergy utilities ; 5/8/12 11:52pm
2 ;;1.0;C0P;;Apr 25, 2012;Build 103
3 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU
4 ;General Public License See attached copy of the License.
5 ;
6 ;This program is free software; you can redistribute it and/or modify
7 ;it under the terms of the GNU General Public License as published by
8 ;the Free Software Foundation; either version 2 of the License, or
9 ;(at your option) any later version.
10 ;
11 ;This program is distributed in the hope that it will be useful,
12 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;GNU General Public License for more details.
15 ;
16 ;You should have received a copy of the GNU General Public License along
17 ;with this program; if not, write to the Free Software Foundation, Inc.,
18 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19 ;
20 Q
21GETRXNS(C0PDUZ,C0PDFN,ZRTN) ; Public Procedure
22 ; Retrieve allergies from WebService, and store in VistA
23 ; ART APIs will automatically not file an allergy if it is a duplicate
24 ; Also, marking pt as NKA won't work if pt already has allergy in VistA
25 ; That's why there is no check for duplicates in this code
26 ; Input:
27 ; - C0PDUZ: DUZ, By Value
28 ; - C0PDFN: DFN, By Value
29 ;
30 N C0PWSRXNS
31 D SOAP^C0PWS1("C0PWSRXNS","GETALLERGIES",C0PDUZ,C0PDFN)
32 N C0PI
33 F C0PI=1:1:C0PWSRXNS(1,"RowCount") DO
34 . N RXN M RXN=C0PWSRXNS(C0PI)
35 . ; For certain food allergies, CompositeID is not returned
36 . I '$D(RXN("CompositeID")) S RXN("CompositeID")="" ; prevent undef crash
37 . I RXN("CompositeID")=11623 QUIT ; Code for 'No Allergy Information'
38 . I (RXN("CompositeID")=231)!(RXN("CompositeID")=232)!(RXN("CompositeID")=14278)!(RXN("CompositeID")=14279) D QUIT
39 . . N ORDFN S ORDFN=C0PDFN ; Apparently the 'API' uses CPRS variables
40 . . D NKA^GMRAGUI1 ; Codes for NKA
41 . D FILE(.RXN,C0PDUZ,C0PDFN)
42 QUIT ; /GETRXNS
43 ;
44FILE(RXN,C0PDUZ,C0PDFN) ; Private Proc - File Drug Reaction
45 ; Input:
46 ; - RXN: Merged WS ADR, by Reference
47 ; - C0PDUZ: DUZ, By Value
48 ; - C0PDFN: DFN, By Value
49 ; ConceptTypeIDs: 6 = Generic Name; 2 = Brand Name; 1 = Drug Class
50 N C0PRXN
51 S:RXN("ConceptTypeID")=6 C0PRXN("GMRAGNT")=$$BASE(RXN("ConceptID"))
52 S:RXN("ConceptTypeID")=2 C0PRXN("GMRAGNT")=$$NAME($$UP^XLFSTR(RXN("Name")))
53 S:RXN("ConceptTypeID")=1 C0PRXN("GMRAGNT")=$$GROUP(RXN("ConceptID"))
54 ; Try a free text match on 120.82 (GMRA ALLERGIES) to see if there is a
55 ; match on a food allergy (ConceptTypeID 9 [free txt] or 10 [other allergies])
56 IF $G(C0PRXN("GMRAGNT"))="" D ; need to handle type 9 or 10 .. gpl
57 . S C0PRXN("GMRAGNT")=$$GMRA($$UP^XLFSTR(RXN("Name")))
58 IF C0PRXN("GMRAGNT")="" DO QUIT ; Agent not found in VistA; TODO mail msg
59 . N ZT ; TEXT TO DISPLAY AS ERROR MESSAGE
60 . S ZT="Error Mapping Allergy ConceptID: "_$G(RXN("ConceptID"))
61 . D MAPERR^C0PRECON(.ZRTN,"Allergy",ZT) ;DISPLAY ERROR
62 S C0PRXN("GMRATYPE")=$$TYPE(C0PRXN("GMRAGNT"))
63 S C0PRXN("GMRANATR")="U^Unknown"
64 S C0PRXN("GMRAORIG")=C0PDUZ
65 S C0PRXN("GMRACHT",0)=1
66 S C0PRXN("GMRACHT",1)=$$NOW^XLFDT
67 S C0PRXN("GMRAORDT")=$$NOW^XLFDT
68 S C0PRXN("GMRAOBHX")="h^HISTORICAL"
69 I $D(RXN("Notes")) D
70 . S C0PRXN("GMRACMTS",0)=1
71 . S C0PRXN("GMRACMTS",1)=RXN("Notes")
72 D UPDATE^GMRAGUI1("",C0PDFN,"C0PRXN")
73 I $G(^TMP("C0PDEBUG"))="" Q ; ONLY SHOW ALLERGY MESSAGES IN DEBUG
74 I $P(ORY,U,1)<0 D MAPERR^C0PRECON(.ZRTN,"Allergies",ORY) ;ERROR MESSAGE
75 QUIT
76 ;
77BASE(ID) ; $$ Private - Retrieve GMRAGNT for Generic Name ConceptID
78 ; Input: ID, By Value
79 ; Output: Ingreident Name^IEN;File Root for IEN
80 ; First, match drug to VistA, Look in VA GENERIC first
81 N VAGEN S VAGEN=$$VAGEN2^C0PLKUP(ID)
82 ; if no match, look in DRUG INGREDIENT
83 N DRUGING S DRUGING=""
84 I '+VAGEN S DRUGING=$$DRUGING2^C0PLKUP(ID)
85 Q:+VAGEN $P(VAGEN,U,2)_U_$P(VAGEN,U)_";PSNDF(50.6,"
86 Q:+DRUGING $P(DRUGING,U,2)_U_$P(DRUGING,U)_";PS(50.416,"
87 QUIT "" ; TODO: Notify somebody that no match found
88 ;
89NAME(BRAND) ; $$ Private - Retrieve GMRAGNT for Brand Name
90 ; Input: Brand Name, By Value
91 ; Output: Ingreident Name^IEN;File Root for IEN
92 N C0POUT,C0PMATCH ; output variable, # of matches
93 S C0PMATCH=$$TGTOG2^PSNAPIS(BRAND,.C0POUT)
94 ; Output for C0POUT:
95 ; C0POUT(24)="24^VANCOMYCIN"
96 ; 24 is IEN of drug in VA GENERIC file
97 Q:C0PMATCH $P(@$Q(C0POUT),U,2)_U_$P(@$Q(C0POUT),U)_";PSNDF(50.6,"
98 Q "" ; otherwise quit with nothing
99 ;
100GROUP(ID) ; Private Proc - Store drug class allergy
101 QUIT "" ; not implemented
102GMRA(NAME) ; $$ Private - Retrieve GMRAGNT for food allergy from 120.82
103 ; Input: Brand Name, By Value
104 ; Output: Entry Name^IEN;File Root for IEN
105 N C0PIEN S C0PIEN=$$FIND1^DIC(120.82,"","O",NAME,"B")
106 Q:C0PIEN $$GET1^DIQ(120.82,C0PIEN,.01)_"^"_C0PIEN_";GMRD(120.82,"
107 QUIT "" ; no match otherwise
108TYPE(GMRAGNT) ; $$ Private - Get allergy Type (Drug, food, or other)
109 ; Input: Allergen, formatted as Allergen^IEN;File Root
110 ; Output: Type (internal)^Type (external) e.g. D^Drug
111 N C0PIEN S C0PIEN=+$P(GMRAGNT,U,2)
112 I GMRAGNT["GMRD(120.82," Q $$GET1^DIQ(120.82,C0PIEN,"ALLERGY TYPE","I")_U_$$GET1^DIQ(120.82,C0PIEN,"ALLERGY TYPE","E")
113 Q "D^Drug" ; otherwise, it's a drug
114ACCOUNTF() Q 113059002 ; file number for account file
115F200C0P() Q 200.113059 ; Subfile number of C0P Subscription Multiple
116 ;
Note: See TracBrowser for help on using the repository browser.