| [1595] | 1 | C0PALGY3 ; ERX/GPL - eRx Allergy utilities ; 5/8/12 9:11pm
|
|---|
| 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
|
|---|
| 21 | ;
|
|---|
| 22 | ADDALGY(RTNXML,ZDUZ,ZDFN,ZFILE) ; ADDS PATIENT ALLERGIES TO NCSCRIPT
|
|---|
| 23 | ; CLICK-THROUGH HTLM FILE FOR
|
|---|
| 24 | ; MAPPING ALLERGIES , XML IS RETURNED IN RTN,PASSED BY NAME
|
|---|
| 25 | ; IF ZFILE IS 1, THE FILE IS WRITTEN TO AN XML FILE
|
|---|
| 26 | ;D EN^C0PMAIN("G1","G2",ZDUZ,ZDFN) ; GET THE NCSCRIPT
|
|---|
| 27 | ;S @RTNURL=G2
|
|---|
| 28 | ;D GETXML^C0PWS1("G3",14) ; GET BEGINNING OF FILE
|
|---|
| 29 | ;D GETXML^C0PWS1("G4",15) ; GET END OF FILE
|
|---|
| 30 | N G1,G2,G3,G4,G5,G6,GBLD
|
|---|
| 31 | D GETALGY("G6",ZDFN) ;GET ALLERGIES
|
|---|
| 32 | ;D QUEUE^C0CXPATH("GBLD","G3",1,$O(G3(""),-1)) ;BUILD LIST BEGINNING OF FILE
|
|---|
| 33 | ;;D QUEUE^C0CXPATH("GBLD","G1",1,$O(G1(""),-1)) ; NCSCRIPT
|
|---|
| 34 | M G1=@RTNXML
|
|---|
| 35 | S GEND=$O(G1(""),-1)-2
|
|---|
| 36 | D QUEUE^C0CXPATH("GBLD","G1",1,GEND) ; NCSCRIPT.. UP TO </Patient>
|
|---|
| 37 | D QUEUE^C0CXPATH("GBLD","G6",1,$O(G6(""),-1)) ; ADD THE ALLERGIES
|
|---|
| 38 | D QUEUE^C0CXPATH("GBLD","G1",GEND+1,$O(G1(""),-1)) ;END OF NCSCRIPT
|
|---|
| 39 | D QUEUE^C0CXPATH("GBLD","G4",1,$O(G4(""),-1)) ; END OF FILE
|
|---|
| 40 | D BUILD^C0CXPATH("GBLD","G5") ; BUILD THE CONTENTS FROM THE BUILD LIST
|
|---|
| 41 | K @RTNXML
|
|---|
| 42 | M @RTNXML=G5 ;
|
|---|
| 43 | I $G(ZFILE)=1 W $$OUTPUT^C0CXPATH("G5(1)","ALLERGY-"_ZDFN_".html","/home/dev/CCR/")
|
|---|
| 44 | Q
|
|---|
| 45 | ;
|
|---|
| 46 | GENTEST(RTNXML,RTNURL,ZDUZ,ZDFN,ZFILE) ; GENERATE A TEST
|
|---|
| 47 | ; CLICK-THROUGH HTLM FILE FOR
|
|---|
| 48 | ; MAPPING ALLERGIES , XML IS RETURNED IN RTN,PASSED BY NAME
|
|---|
| 49 | ; IF ZFILE IS 1, THE FILE IS WRITTEN TO HOST FILE
|
|---|
| 50 | D EN^C0PMAIN("G1","G2",ZDUZ,ZDFN) ; GET THE NCSCRIPT
|
|---|
| 51 | ;S @RTNURL=G2
|
|---|
| 52 | D GETXML^C0PWS1("G3",14) ; GET BEGINNING OF FILE
|
|---|
| 53 | D GETXML^C0PWS1("G4",15) ; GET END OF FILE
|
|---|
| 54 | D GETALGY("G6",ZDFN) ;GET ALLERGIES
|
|---|
| 55 | D QUEUE^C0CXPATH("GBLD","G3",1,$O(G3(""),-1)) ;BUILD LIST BEGINNING OF FILE
|
|---|
| 56 | ;D QUEUE^C0CXPATH("GBLD","G1",1,$O(G1(""),-1)) ; NCSCRIPT
|
|---|
| 57 | D QUEUE^C0CXPATH("GBLD","G1",1,76) ; NCSCRIPT.. UP TO </Patient>
|
|---|
| 58 | D QUEUE^C0CXPATH("GBLD","G6",1,$O(G6(""),-1)) ; ADD THE ALLERGIES
|
|---|
| 59 | D QUEUE^C0CXPATH("GBLD","G1",77,$O(G1(""),-1)) ;END OF NCSCRIPT
|
|---|
| 60 | D QUEUE^C0CXPATH("GBLD","G4",1,$O(G4(""),-1)) ; END OF FILE
|
|---|
| 61 | D BUILD^C0CXPATH("GBLD","G5") ; BUILD THE CONTENTS FROM THE BUILD LIST
|
|---|
| 62 | M @RTNXML=G5 ;
|
|---|
| 63 | I $G(ZFILE)=1 W $$OUTPUT^C0CXPATH("G5(1)","ALLERGY-"_ZDFN_".html","/home/dev/CCR/")
|
|---|
| 64 | Q
|
|---|
| 65 | ;
|
|---|
| 66 | GETALGY(OUTARY,ZDFN) ;
|
|---|
| 67 | ;
|
|---|
| 68 | N ZG,ZG2,ZB,ZN
|
|---|
| 69 | S DEBUG=0
|
|---|
| 70 | D GETTEMP^C0PWS1("ZG",16) ;GET THE ALLERGY TEMPLATE
|
|---|
| 71 | D EXTRACT^C0CALERT("ZG",ZDFN,"ZG2","ALGYCBK^C0PALGY3(ALTVMAP,A1)")
|
|---|
| 72 | S ZN=$O(ZG2(""),-1) ;NUMBER OF LINES IN OUTPUT
|
|---|
| 73 | D QUEUE^C0CXPATH("ZB","ZG2",2,ZN-1)
|
|---|
| 74 | D BUILD^C0CXPATH("ZB",OUTARY)
|
|---|
| 75 | Q
|
|---|
| 76 | ;
|
|---|
| 77 | ALGYCBK(ZRTN,ZIN) ;CALLBACK ROUTINE FOR C0CALERT USED TO SET FDB CONCEPT
|
|---|
| 78 | ; ID IF FOUND. ZIN IS PASSED BY NAME AND IS ONE ALLERGY
|
|---|
| 79 | N ZI,ZJ
|
|---|
| 80 | S ZI=$P(ZIN,"^",9) ;THIS IS THE VARIABLE POINTER OF THE GMR ALLERGY
|
|---|
| 81 | I ZI="" Q
|
|---|
| 82 | S ZJ=$O(^C0PALGY("VA",ZI,""))
|
|---|
| 83 | I ZJ'="" D ; CONCEPT WAS FOUND
|
|---|
| 84 | . S ZK=$$GET1^DIQ(113059005,ZJ_",",.05) ;COMPOSIT ALLERGY ID (NOT CONCEPT)
|
|---|
| 85 | . S @ZRTN@("ALERTFDBCONCEPTID")=ZK
|
|---|
| 86 | . S @ZRTN@("ALERTFDB")="FDB"
|
|---|
| 87 | E D ;
|
|---|
| 88 | . S @ZRTN@("ALERTFDBCONCEPTID")=""
|
|---|
| 89 | . S @ZRTN@("ALERTFDB")=""
|
|---|
| 90 | Q
|
|---|
| 91 | ;
|
|---|
| 92 | UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
|
|---|
| 93 | K ZERR
|
|---|
| 94 | D CLEAN^DILF
|
|---|
| 95 | D UPDATE^DIE("","C0PFDA","","ZERR")
|
|---|
| 96 | I $D(ZERR) D ERROR^C0PMAIN(",U113059008,",$ST($ST,"PLACE"),"ERX-UPDIE-FAIL","Fileman Data Update Failure") QUIT
|
|---|
| 97 | K C0PFDA
|
|---|
| 98 | Q
|
|---|
