KIDS Distribution saved on Jun 13, 2012@23:30:36
Package name in build now rather than nmsp
**KIDS**:ORO ERX E-PRESCRIBING 1.0^

**INSTALL NAME**
ORO ERX E-PRESCRIBING 1.0
"BLD",7939,0)
ORO ERX E-PRESCRIBING 1.0^ORO ERX E-PRESCRIBING^0^3120613^n
"BLD",7939,1,0)
^^33^33^3120519^^^
"BLD",7939,1,1,0)
Written on April 25th 2012.
"BLD",7939,1,2,0)
 
"BLD",7939,1,3,0)
Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"BLD",7939,1,4,0)
General Public License See attached copy of the License.
"BLD",7939,1,5,0)
 
"BLD",7939,1,6,0)
This program is free software; you can redistribute it and/or modify
"BLD",7939,1,7,0)
it under the terms of the GNU General Public License as published by
"BLD",7939,1,8,0)
the Free Software Foundation; either version 2 of the License, or
"BLD",7939,1,9,0)
(at your option) any later version.
"BLD",7939,1,10,0)
 
"BLD",7939,1,11,0)
This program is distributed in the hope that it will be useful,
"BLD",7939,1,12,0)
but WITHOUT ANY WARRANTY; without even the implied warranty of
"BLD",7939,1,13,0)
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"BLD",7939,1,14,0)
GNU General Public License for more details.
"BLD",7939,1,15,0)
 
"BLD",7939,1,16,0)
You should have received a copy of the GNU General Public License along
"BLD",7939,1,17,0)
with this program; if not, write to the Free Software Foundation, Inc.,
"BLD",7939,1,18,0)
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
"BLD",7939,1,19,0)
 
"BLD",7939,1,20,0)
This is the 1.0 release of the Oroville e-Prescribing Package.
"BLD",7939,1,21,0)
 
"BLD",7939,1,22,0)
This package works as a web service communication framework to New Crop 
"BLD",7939,1,23,0)
(http://www.newcroprx.com/) to send and receive drug data.
"BLD",7939,1,24,0)
 
"BLD",7939,1,25,0)
It depends on the following packages/installations:
"BLD",7939,1,26,0)
- EWD (for Web Services communication in Mumps)
"BLD",7939,1,27,0)
- C0C (CCR/CCD Extraction, for metadata purposes)
"BLD",7939,1,28,0)
 
"BLD",7939,1,29,0)
Other KIDS files may be supplied to make this work if they not part of
"BLD",7939,1,30,0)
this package:
"BLD",7939,1,31,0)
- New Crop Web Services Data
"BLD",7939,1,32,0)
- RxNorm Full Concepts File for E-Rx
"BLD",7939,1,33,0)
- First DataBank Drugs and Allergies
"BLD",7939,4,0)
^9.64PA^1130590010^7
"BLD",7939,4,44,0)
44
"BLD",7939,4,44,2,0)
^9.641^44^2
"BLD",7939,4,44,2,44,0)
HOSPITAL LOCATION  (File-top level)
"BLD",7939,4,44,2,44,1,0)
^9.6411^113059116^5
"BLD",7939,4,44,2,44,1,113059111,0)
C0P ERX STREET ADDRESS 1
"BLD",7939,4,44,2,44,1,113059112,0)
C0P ERX STREET ADDRESS 2
"BLD",7939,4,44,2,44,1,113059114,0)
C0P ERX CITY
"BLD",7939,4,44,2,44,1,113059115,0)
C0P ERX STATE
"BLD",7939,4,44,2,44,1,113059116,0)
C0P ERX ZIP CODE
"BLD",7939,4,44,2,44.113059,0)
C0P ERX PHONE FAX  (sub-file)
"BLD",7939,4,44,2,44.113059,1,0)
^9.6411^^
"BLD",7939,4,44,222)
y^y^p^^^^n^^n
"BLD",7939,4,44,224)

"BLD",7939,4,200,0)
200
"BLD",7939,4,200,2,0)
^9.641^200.113059^1
"BLD",7939,4,200,2,200.113059,0)
C0P SUBSCRIPTION  (sub-file)
"BLD",7939,4,200,2,200.113059,1,0)
^9.6411^^
"BLD",7939,4,200,222)
y^y^p^^^^n^^n
"BLD",7939,4,200,224)

"BLD",7939,4,113059001,0)
113059001
"BLD",7939,4,113059001,222)
y^y^f^^^^n
"BLD",7939,4,113059002,0)
113059002
"BLD",7939,4,113059002,222)
y^y^f^^^^n^^
"BLD",7939,4,113059002,224)

"BLD",7939,4,113059003,0)
113059003
"BLD",7939,4,113059003,222)
y^y^f^^^^n
"BLD",7939,4,1130590010,0)
1130590010
"BLD",7939,4,1130590010,222)
y^y^f^^^^n
"BLD",7939,4,1130590010.002,0)
1130590010.002
"BLD",7939,4,1130590010.002,222)
y^y^f^^^^n
"BLD",7939,4,1130590011.001,0)
1130590011.001
"BLD",7939,4,1130590011.001,222)
y^y^f^^^^n
"BLD",7939,4,"APDD",44,44)

"BLD",7939,4,"APDD",44,44,113059111)

"BLD",7939,4,"APDD",44,44,113059112)

"BLD",7939,4,"APDD",44,44,113059114)

"BLD",7939,4,"APDD",44,44,113059115)

"BLD",7939,4,"APDD",44,44,113059116)

"BLD",7939,4,"APDD",44,44.113059)

"BLD",7939,4,"APDD",200,200.113059)

"BLD",7939,4,"B",44,44)

"BLD",7939,4,"B",200,200)

"BLD",7939,4,"B",113059001,113059001)

"BLD",7939,4,"B",113059002,113059002)

"BLD",7939,4,"B",113059003,113059003)

"BLD",7939,4,"B",1130590010,1130590010)

"BLD",7939,4,"B",1130590010.002,1130590010.002)

"BLD",7939,4,"B",1130590011.001,1130590011.001)

"BLD",7939,6.3)
103
"BLD",7939,"ABPKG")
n
"BLD",7939,"INI")

"BLD",7939,"INIT")
POST^C0PKIDS
"BLD",7939,"KRN",0)
^9.67PA^779.2^20
"BLD",7939,"KRN",.4,0)
.4
"BLD",7939,"KRN",.4,"NM",0)
^9.68A^1^1
"BLD",7939,"KRN",.4,"NM",1,0)
C0P MAPPED BRAND DRUGS VANAME    FILE #1130590010.002^1130590010.002^0
"BLD",7939,"KRN",.4,"NM","B","C0P MAPPED BRAND DRUGS VANAME    FILE #1130590010.002",1)

"BLD",7939,"KRN",.401,0)
.401
"BLD",7939,"KRN",.401,"NM",0)
^9.68A^2^2
"BLD",7939,"KRN",.401,"NM",1,0)
C0P BRAND NAME ANALYSIS    FILE #1130590010.002^1130590010.002^0
"BLD",7939,"KRN",.401,"NM",2,0)
C0P SORT BY RXNCUI    FILE #1130590010.002^1130590010.002^0
"BLD",7939,"KRN",.401,"NM","B","C0P BRAND NAME ANALYSIS    FILE #1130590010.002",1)

"BLD",7939,"KRN",.401,"NM","B","C0P SORT BY RXNCUI    FILE #1130590010.002",2)

"BLD",7939,"KRN",.402,0)
.402
"BLD",7939,"KRN",.402,"NM",0)
^9.68A^2^2
"BLD",7939,"KRN",.402,"NM",1,0)
C0P ERX ENTER EDIT LOCATION    FILE #44^44^0
"BLD",7939,"KRN",.402,"NM",2,0)
C0P SUPERVISING DOCTOR    FILE #200^200^0
"BLD",7939,"KRN",.402,"NM","B","C0P ERX ENTER EDIT LOCATION    FILE #44",1)

"BLD",7939,"KRN",.402,"NM","B","C0P SUPERVISING DOCTOR    FILE #200",2)

"BLD",7939,"KRN",.403,0)
.403
"BLD",7939,"KRN",.403,"NM",0)
^9.68A^1^1
"BLD",7939,"KRN",.403,"NM",1,0)
C0P ENTER SUBSCRIBER    FILE #200^200^0
"BLD",7939,"KRN",.403,"NM","B","C0P ENTER SUBSCRIBER    FILE #200",1)

"BLD",7939,"KRN",.5,0)
.5
"BLD",7939,"KRN",.84,0)
.84
"BLD",7939,"KRN",.84,"NM",0)
^9.68A^^
"BLD",7939,"KRN",3.6,0)
3.6
"BLD",7939,"KRN",3.6,"NM",0)
^9.68A^1^1
"BLD",7939,"KRN",3.6,"NM",1,0)
C0P EXTERNAL DRUG NOT FOUND^^0
"BLD",7939,"KRN",3.6,"NM","B","C0P EXTERNAL DRUG NOT FOUND",1)

"BLD",7939,"KRN",3.8,0)
3.8
"BLD",7939,"KRN",3.8,"NM",0)
^9.68A^1^1
"BLD",7939,"KRN",3.8,"NM",1,0)
ERX HELP DESK^^0
"BLD",7939,"KRN",3.8,"NM","B","ERX HELP DESK",1)

"BLD",7939,"KRN",9.2,0)
9.2
"BLD",7939,"KRN",9.2,"NM",0)
^9.68A^2^2
"BLD",7939,"KRN",9.2,"NM",1,0)
C0P SETUP HELP^^0
"BLD",7939,"KRN",9.2,"NM",2,0)
C0P SETUP HELP2^^0
"BLD",7939,"KRN",9.2,"NM","B","C0P SETUP HELP",1)

"BLD",7939,"KRN",9.2,"NM","B","C0P SETUP HELP2",2)

"BLD",7939,"KRN",9.8,0)
9.8
"BLD",7939,"KRN",9.8,"NM",0)
^9.68A^34^26
"BLD",7939,"KRN",9.8,"NM",1,0)
C0PSUB^^0^B140320803
"BLD",7939,"KRN",9.8,"NM",2,0)
C0PWS1^^0^B158660722
"BLD",7939,"KRN",9.8,"NM",3,0)
C0PCPRS1^^0^B122541165
"BLD",7939,"KRN",9.8,"NM",4,0)
C0PPAT^^0^B8357096
"BLD",7939,"KRN",9.8,"NM",5,0)
C0PXEWD^^0^B18300022
"BLD",7939,"KRN",9.8,"NM",6,0)
C0PMAIN^^0^B53352632
"BLD",7939,"KRN",9.8,"NM",7,0)
C0PRXNRD^^1^
"BLD",7939,"KRN",9.8,"NM",8,0)
C0PEWD2^^0^B48189391
"BLD",7939,"KRN",9.8,"NM",9,0)
C0PLKUP^^0^B29450708
"BLD",7939,"KRN",9.8,"NM",10,0)
C0PCUR^^0^B38235838
"BLD",7939,"KRN",9.8,"NM",11,0)
C0PRECON^^0^B81626600
"BLD",7939,"KRN",9.8,"NM",12,0)
C0PEWDU^^0^B2700278
"BLD",7939,"KRN",9.8,"NM",13,0)
C0PEWD4^^0^B26192887
"BLD",7939,"KRN",9.8,"NM",14,0)
C0PNVA^^0^B26597924
"BLD",7939,"KRN",9.8,"NM",15,0)
C0PALGY1^^0^B19614280
"BLD",7939,"KRN",9.8,"NM",16,0)
C0PALGY2^^0^B75872153
"BLD",7939,"KRN",9.8,"NM",17,0)
C0PALGY3^^0^B13104079
"BLD",7939,"KRN",9.8,"NM",18,0)
C0PEWD1^^0^B12507891
"BLD",7939,"KRN",9.8,"NM",19,0)
C0PWPS^^0^B36558462
"BLD",7939,"KRN",9.8,"NM",20,0)
C0PREFIL^^0^B176149670
"BLD",7939,"KRN",9.8,"NM",21,0)
C0PTRXN^^0^B112380604
"BLD",7939,"KRN",9.8,"NM",22,0)
C0PWS2^^0^B215641893
"BLD",7939,"KRN",9.8,"NM",23,0)
C0PEREW^^0^B41565998
"BLD",7939,"KRN",9.8,"NM",31,0)
C0PSMEDS^^0^B9112048
"BLD",7939,"KRN",9.8,"NM",33,0)
C0PKIDS^^0^B189289667
"BLD",7939,"KRN",9.8,"NM",34,0)
C0PLOAD^^0^B81524055
"BLD",7939,"KRN",9.8,"NM","B","C0PALGY1",15)

"BLD",7939,"KRN",9.8,"NM","B","C0PALGY2",16)

"BLD",7939,"KRN",9.8,"NM","B","C0PALGY3",17)

"BLD",7939,"KRN",9.8,"NM","B","C0PCPRS1",3)

"BLD",7939,"KRN",9.8,"NM","B","C0PCUR",10)

"BLD",7939,"KRN",9.8,"NM","B","C0PEREW",23)

"BLD",7939,"KRN",9.8,"NM","B","C0PEWD1",18)

"BLD",7939,"KRN",9.8,"NM","B","C0PEWD2",8)

"BLD",7939,"KRN",9.8,"NM","B","C0PEWD4",13)

"BLD",7939,"KRN",9.8,"NM","B","C0PEWDU",12)

"BLD",7939,"KRN",9.8,"NM","B","C0PKIDS",33)

"BLD",7939,"KRN",9.8,"NM","B","C0PLKUP",9)

"BLD",7939,"KRN",9.8,"NM","B","C0PLOAD",34)

"BLD",7939,"KRN",9.8,"NM","B","C0PMAIN",6)

"BLD",7939,"KRN",9.8,"NM","B","C0PNVA",14)

"BLD",7939,"KRN",9.8,"NM","B","C0PPAT",4)

"BLD",7939,"KRN",9.8,"NM","B","C0PRECON",11)

"BLD",7939,"KRN",9.8,"NM","B","C0PREFIL",20)

"BLD",7939,"KRN",9.8,"NM","B","C0PRXNRD",7)

"BLD",7939,"KRN",9.8,"NM","B","C0PSMEDS",31)

"BLD",7939,"KRN",9.8,"NM","B","C0PSUB",1)

"BLD",7939,"KRN",9.8,"NM","B","C0PTRXN",21)

"BLD",7939,"KRN",9.8,"NM","B","C0PWPS",19)

"BLD",7939,"KRN",9.8,"NM","B","C0PWS1",2)

"BLD",7939,"KRN",9.8,"NM","B","C0PWS2",22)

"BLD",7939,"KRN",9.8,"NM","B","C0PXEWD",5)

"BLD",7939,"KRN",19,0)
19
"BLD",7939,"KRN",19,"NM",0)
^9.68A^17^15
"BLD",7939,"KRN",19,"NM",1,0)
C0P ACCOUNT EDIT^^0
"BLD",7939,"KRN",19,"NM",4,0)
C0P ERX ORDER RPC^^0
"BLD",7939,"KRN",19,"NM",5,0)
C0P ERX PULLBACK^^0
"BLD",7939,"KRN",19,"NM",6,0)
C0P LIST SUBSCRIBERS^^1^
"BLD",7939,"KRN",19,"NM",7,0)
C0P LOCATION EDIT^^0
"BLD",7939,"KRN",19,"NM",8,0)
C0P MAIN^^1^
"BLD",7939,"KRN",19,"NM",9,0)
C0P SUBSCRIBER EDIT^^0
"BLD",7939,"KRN",19,"NM",10,0)
C0P SUBSCRIBER STATUS INQUIRE^^0
"BLD",7939,"KRN",19,"NM",11,0)
C0P ERX BATCH^^0
"BLD",7939,"KRN",19,"NM",12,0)
C0P SUPERVISING DOCTOR^^1^
"BLD",7939,"KRN",19,"NM",13,0)
C0P MAPPED BRANDED DRUGS^^0
"BLD",7939,"KRN",19,"NM",14,0)
C0P MAPPING MENU^^0
"BLD",7939,"KRN",19,"NM",15,0)
C0PMENU^^0
"BLD",7939,"KRN",19,"NM",16,0)
C0P SUPERVISING DOCTOR EDIT^^0
"BLD",7939,"KRN",19,"NM",17,0)
C0P SET-UP HELP^^0
"BLD",7939,"KRN",19,"NM","B","C0P ACCOUNT EDIT",1)

"BLD",7939,"KRN",19,"NM","B","C0P ERX BATCH",11)

"BLD",7939,"KRN",19,"NM","B","C0P ERX ORDER RPC",4)

"BLD",7939,"KRN",19,"NM","B","C0P ERX PULLBACK",5)

"BLD",7939,"KRN",19,"NM","B","C0P LIST SUBSCRIBERS",6)

"BLD",7939,"KRN",19,"NM","B","C0P LOCATION EDIT",7)

"BLD",7939,"KRN",19,"NM","B","C0P MAIN",8)

"BLD",7939,"KRN",19,"NM","B","C0P MAPPED BRANDED DRUGS",13)

"BLD",7939,"KRN",19,"NM","B","C0P MAPPING MENU",14)

"BLD",7939,"KRN",19,"NM","B","C0P SET-UP HELP",17)

"BLD",7939,"KRN",19,"NM","B","C0P SUBSCRIBER EDIT",9)

"BLD",7939,"KRN",19,"NM","B","C0P SUBSCRIBER STATUS INQUIRE",10)

"BLD",7939,"KRN",19,"NM","B","C0P SUPERVISING DOCTOR",12)

"BLD",7939,"KRN",19,"NM","B","C0P SUPERVISING DOCTOR EDIT",16)

"BLD",7939,"KRN",19,"NM","B","C0PMENU",15)

"BLD",7939,"KRN",19.1,0)
19.1
"BLD",7939,"KRN",19.1,"NM",0)
^9.68A^2^2
"BLD",7939,"KRN",19.1,"NM",1,0)
C0PZMGR^^0
"BLD",7939,"KRN",19.1,"NM",2,0)
C0PZMENU^^0
"BLD",7939,"KRN",19.1,"NM","B","C0PZMENU",2)

"BLD",7939,"KRN",19.1,"NM","B","C0PZMGR",1)

"BLD",7939,"KRN",101,0)
101
"BLD",7939,"KRN",409.61,0)
409.61
"BLD",7939,"KRN",771,0)
771
"BLD",7939,"KRN",779.2,0)
779.2
"BLD",7939,"KRN",870,0)
870
"BLD",7939,"KRN",8989.51,0)
8989.51
"BLD",7939,"KRN",8989.52,0)
8989.52
"BLD",7939,"KRN",8994,0)
8994
"BLD",7939,"KRN",8994,"NM",0)
^9.68A^5^5
"BLD",7939,"KRN",8994,"NM",1,0)
C0P ERX ORDER RPC^^0
"BLD",7939,"KRN",8994,"NM",2,0)
C0P ERX PULLBACK^^0
"BLD",7939,"KRN",8994,"NM",3,0)
C0P ERX ALERT RPC^^0
"BLD",7939,"KRN",8994,"NM",4,0)
ORWPS COVER^^0
"BLD",7939,"KRN",8994,"NM",5,0)
ORWPS DETAIL^^0
"BLD",7939,"KRN",8994,"NM","B","C0P ERX ALERT RPC",3)

"BLD",7939,"KRN",8994,"NM","B","C0P ERX ORDER RPC",1)

"BLD",7939,"KRN",8994,"NM","B","C0P ERX PULLBACK",2)

"BLD",7939,"KRN",8994,"NM","B","ORWPS COVER",4)

"BLD",7939,"KRN",8994,"NM","B","ORWPS DETAIL",5)

"BLD",7939,"KRN","B",.4,.4)

"BLD",7939,"KRN","B",.401,.401)

"BLD",7939,"KRN","B",.402,.402)

"BLD",7939,"KRN","B",.403,.403)

"BLD",7939,"KRN","B",.5,.5)

"BLD",7939,"KRN","B",.84,.84)

"BLD",7939,"KRN","B",3.6,3.6)

"BLD",7939,"KRN","B",3.8,3.8)

"BLD",7939,"KRN","B",9.2,9.2)

"BLD",7939,"KRN","B",9.8,9.8)

"BLD",7939,"KRN","B",19,19)

"BLD",7939,"KRN","B",19.1,19.1)

"BLD",7939,"KRN","B",101,101)

"BLD",7939,"KRN","B",409.61,409.61)

"BLD",7939,"KRN","B",771,771)

"BLD",7939,"KRN","B",779.2,779.2)

"BLD",7939,"KRN","B",870,870)

"BLD",7939,"KRN","B",8989.51,8989.51)

"BLD",7939,"KRN","B",8989.52,8989.52)

"BLD",7939,"KRN","B",8994,8994)

"BLD",7939,"PRE")
C0PKIDS
"BLD",7939,"QUES",0)
^9.62^^
"BLD",7939,"REQB",0)
^9.611^1^1
"BLD",7939,"REQB",1,0)
CCD/CCR GENERATION UTILITIES 1.2^2
"BLD",7939,"REQB","B","CCD/CCR GENERATION UTILITIES 1.2",1)

"FIA",44)
HOSPITAL LOCATION
"FIA",44,0)
^SC(
"FIA",44,0,0)
44I
"FIA",44,0,1)
y^y^p^^^^n^^n
"FIA",44,0,10)

"FIA",44,0,11)

"FIA",44,0,"RLRO")

"FIA",44,0,"VR")
1.0^ORO ERX E-PRESCRIBING
"FIA",44,44)
1
"FIA",44,44,113059001)

"FIA",44,44,113059111)

"FIA",44,44,113059112)

"FIA",44,44,113059114)

"FIA",44,44,113059115)

"FIA",44,44,113059116)

"FIA",44,44.113059)
0
"FIA",200)
NEW PERSON
"FIA",200,0)
^VA(200,
"FIA",200,0,0)
200Is
"FIA",200,0,1)
y^y^p^^^^n^^n
"FIA",200,0,10)

"FIA",200,0,11)

"FIA",200,0,"RLRO")

"FIA",200,0,"VR")
1.0^ORO ERX E-PRESCRIBING
"FIA",200,200)
1
"FIA",200,200,113059003)

"FIA",200,200.113059)
0
"FIA",113059001)
C0P XML TEMPLATE
"FIA",113059001,0)
^C0PX(
"FIA",113059001,0,0)
113059001
"FIA",113059001,0,1)
y^y^f^^^^n
"FIA",113059001,0,10)

"FIA",113059001,0,11)

"FIA",113059001,0,"RLRO")

"FIA",113059001,0,"VR")
1.0^ORO ERX E-PRESCRIBING
"FIA",113059001,113059001)
0
"FIA",113059001,113059001.01)
0
"FIA",113059001,113059001.02)
0
"FIA",113059001,113059001.03)
0
"FIA",113059001,113059001.04)
0
"FIA",113059001,113059001.05)
0
"FIA",113059002)
C0P WS ACCT
"FIA",113059002,0)
^C0PS(
"FIA",113059002,0,0)
113059002
"FIA",113059002,0,1)
y^y^f^^^^n^^
"FIA",113059002,0,10)

"FIA",113059002,0,11)

"FIA",113059002,0,"RLRO")

"FIA",113059002,0,"VR")
1.0^ORO ERX E-PRESCRIBING
"FIA",113059002,113059002)
0
"FIA",113059003)
C0P WEB SERVICE
"FIA",113059003,0)
^C0PW(
"FIA",113059003,0,0)
113059003
"FIA",113059003,0,1)
y^y^f^^^^n
"FIA",113059003,0,10)

"FIA",113059003,0,11)

"FIA",113059003,0,"RLRO")

"FIA",113059003,0,"VR")
1.0^ORO ERX E-PRESCRIBING
"FIA",113059003,113059003)
0
"FIA",113059003,113059003.01)
0
"FIA",113059003,113059003.02)
0
"FIA",113059003,113059003.03)
0
"FIA",113059003,113059003.04)
0
"FIA",1130590010)
FIRST DATABANK DRUGS
"FIA",1130590010,0)
^C0P("FDB",
"FIA",1130590010,0,0)
1130590010I
"FIA",1130590010,0,1)
y^y^f^^^^n
"FIA",1130590010,0,10)

"FIA",1130590010,0,11)

"FIA",1130590010,0,"RLRO")

"FIA",1130590010,0,"VR")
1.0^ORO ERX E-PRESCRIBING
"FIA",1130590010,1130590010)
0
"FIA",1130590010.002)
C0P RXNORM FDB VUID MAPPING
"FIA",1130590010.002,0)
^C0PRXN(
"FIA",1130590010.002,0,0)
1130590010.002I
"FIA",1130590010.002,0,1)
y^y^f^^^^n
"FIA",1130590010.002,0,10)

"FIA",1130590010.002,0,11)

"FIA",1130590010.002,0,"RLRO")

"FIA",1130590010.002,0,"VR")
1.0^ORO ERX E-PRESCRIBING
"FIA",1130590010.002,1130590010.002)
0
"FIA",1130590011.001)
RXNORM CONCEPTS C0P
"FIA",1130590011.001,0)
^C0P("RXN",
"FIA",1130590011.001,0,0)
1130590011.001I
"FIA",1130590011.001,0,1)
y^y^f^^^^n
"FIA",1130590011.001,0,10)

"FIA",1130590011.001,0,11)

"FIA",1130590011.001,0,"RLRO")

"FIA",1130590011.001,0,"VR")
1.0^ORO ERX E-PRESCRIBING
"FIA",1130590011.001,1130590011.001)
0
"FIA",1130590011.001,1130590011.0015)
0
"INIT")
POST^C0PKIDS
"IX",44,44.113059,"PRIORITY",0)
44.113059^PRIORITY^INDEX TO SORT C0P LOCATIONS BY THE PRIORITY FIELD^R^^F^IR^I^44.113059^^^^^LS
"IX",44,44.113059,"PRIORITY",1)
S ^SC(DA(1),"C0P","PRIORITY",X,DA)=""
"IX",44,44.113059,"PRIORITY",2)
K ^SC(DA(1),"C0P","PRIORITY",X,DA)
"IX",44,44.113059,"PRIORITY",2.5)
K ^SC(DA(1),"C0P","PRIORITY")
"IX",44,44.113059,"PRIORITY",11.1,0)
^.114IA^1^1
"IX",44,44.113059,"PRIORITY",11.1,1,0)
1^F^44.113059^3^^1^F
"IX",200,200,"AC0PSID",0)
200^AC0PSID^REGULAR WHOLE FILE INDEX FOR THE ERX SUBSCIBER ID^R^^F^IR^W^200.113059^^^^^S
"IX",200,200,"AC0PSID",1)
S ^VA(200,"AC0PSID",$E(X,1,240),DA(1),DA)=""
"IX",200,200,"AC0PSID",2)
K ^VA(200,"AC0PSID",$E(X,1,240),DA(1),DA)
"IX",200,200,"AC0PSID",2.5)
K ^VA(200,"AC0PSID")
"IX",200,200,"AC0PSID",11.1,0)
^.114IA^1^1
"IX",200,200,"AC0PSID",11.1,1,0)
1^F^200.113059^5^240^1^F
"IX",200,200,"AC0PSID",11.1,1,3)

"IX",200,200,"C0P",0)
200^C0P^Regular whole file cross reference of the Suscription subfile^R^^F^IR^W^200.113059^^^^^LS
"IX",200,200,"C0P",1)
S ^VA(200,"C0P",$E(X,1,20),DA(1),DA)=""
"IX",200,200,"C0P",2)
K ^VA(200,"C0P",$E(X,1,20),DA(1),DA)
"IX",200,200,"C0P",2.5)
K ^VA(200,"C0P")
"IX",200,200,"C0P",11.1,0)
^.114IA^1^1
"IX",200,200,"C0P",11.1,1,0)
1^F^200.113059^.01^20^1^F
"IX",113059001,113059001,"C",0)
113059001^C^Uniqueness Index for Key 'A' of File #113059001^R^^R^IR^I^113059001^^^^^LS
"IX",113059001,113059001,"C",1)
S ^C0PX("C",X(1),X(2),DA)=""
"IX",113059001,113059001,"C",2)
K ^C0PX("C",X(1),X(2),DA)
"IX",113059001,113059001,"C",2.5)
K ^C0PX("C")
"IX",113059001,113059001,"C",11.1,0)
^.114IA^2^2
"IX",113059001,113059001,"C",11.1,1,0)
1^F^113059001^.02^^1
"IX",113059001,113059001,"C",11.1,2,0)
2^F^113059001^.01^^2
"IX",113059001,113059001,"XPATH",0)
113059001^XPATH^WHOLE FILE XPATH INDEX FOR BINDINGS BY TEMPLATE^R^^F^IR^W^113059001.04^^^^^LS
"IX",113059001,113059001,"XPATH",1)
S ^C0PX("XPATH",$E(X,1,240),DA(1),DA)=""
"IX",113059001,113059001,"XPATH",2)
K ^C0PX("XPATH",$E(X,1,240),DA(1),DA)
"IX",113059001,113059001,"XPATH",2.5)
K ^C0PX("XPATH")
"IX",113059001,113059001,"XPATH",11.1,0)
^.114IA^1^1
"IX",113059001,113059001,"XPATH",11.1,1,0)
1^F^113059001.04^.01^240^1^F
"IX",113059001,113059001.04,"B",0)
113059001.04^B^REPLACEMENT FOR B INDEX TO INCREASE MAX LENGTH^R^^F^IR^I^113059001.04^^^^^LS
"IX",113059001,113059001.04,"B",1)
S ^C0PX(DA(1),5,"B",$E(X,1,240),DA)=""
"IX",113059001,113059001.04,"B",2)
K ^C0PX(DA(1),5,"B",$E(X,1,240),DA)
"IX",113059001,113059001.04,"B",2.5)
K ^C0PX(DA(1),5,"B")
"IX",113059001,113059001.04,"B",11.1,0)
^.114IA^1^1
"IX",113059001,113059001.04,"B",11.1,1,0)
1^F^113059001.04^.01^240^1^F
"IX",113059001,113059001.04,"B",11.1,1,3)

"IX",1130590010,1130590010,"DESC",0)
1130590010^DESC^REGULAR INDEX ON MED REF GEN CD DESC^R^^F^IR^I^1130590010^^^^^LS
"IX",1130590010,1130590010,"DESC",1)
S ^C0P("FDB","DESC",$E(X,1,120),DA)=""
"IX",1130590010,1130590010,"DESC",2)
K ^C0P("FDB","DESC",$E(X,1,120),DA)
"IX",1130590010,1130590010,"DESC",2.5)
K ^C0P("FDB","DESC")
"IX",1130590010,1130590010,"DESC",11.1,0)
^.114IA^1^1
"IX",1130590010,1130590010,"DESC",11.1,1,0)
1^F^1130590010^24^120^1^F
"IX",1130590010,1130590010,"MEDLONGNAME",0)
1130590010^MEDLONGNAME^Index for searching for drugs by name.^R^^F^IR^I^1130590010^^^^^LS
"IX",1130590010,1130590010,"MEDLONGNAME",.1,0)
^^4^4^3091205^
"IX",1130590010,1130590010,"MEDLONGNAME",.1,1,0)
This is an index of the free-text long name of the medication. The raison 
"IX",1130590010,1130590010,"MEDLONGNAME",.1,2,0)
d'etre for it is for user/programmers to be able to search the file using 
"IX",1130590010,1130590010,"MEDLONGNAME",.1,3,0)
fileman at will for a certain drug. It will not be used in M code since 
"IX",1130590010,1130590010,"MEDLONGNAME",.1,4,0)
we will be dealing exlusively with numbers that are indexed elsewhere.
"IX",1130590010,1130590010,"MEDLONGNAME",1)
S ^C0P("FDB","MEDLONGNAME",$E(X,1,50),DA)=""
"IX",1130590010,1130590010,"MEDLONGNAME",2)
K ^C0P("FDB","MEDLONGNAME",$E(X,1,50),DA)
"IX",1130590010,1130590010,"MEDLONGNAME",2.5)
K ^C0P("FDB","MEDLONGNAME")
"IX",1130590010,1130590010,"MEDLONGNAME",11.1,0)
^.114IA^1^1
"IX",1130590010,1130590010,"MEDLONGNAME",11.1,1,0)
1^F^1130590010^6^50^1^F
"IX",1130590010,1130590010,"MEDLONGNAME",11.1,1,2)
S X=$$UP^XLFSTR(X)
"IX",1130590010,1130590010,"MEDLONGNAME",11.1,1,3)
S X=$$SENTENCE^XLFSTR(X)
"IX",1130590010,1130590010,"MEDLONGNAME",11.1,1,4)
S X=$$UP^XLFSTR(X)
"IX",1130590010.002,1130590010.002,"FDBNAME",0)
1130590010.002^FDBNAME^REGULAR INDEX ON FDBNAME^R^^F^IR^I^1130590010.002^^^^^LS
"IX",1130590010.002,1130590010.002,"FDBNAME",1)
S ^C0PRXN("FDBNAME",$E(X,1,100),DA)=""
"IX",1130590010.002,1130590010.002,"FDBNAME",2)
K ^C0PRXN("FDBNAME",$E(X,1,100),DA)
"IX",1130590010.002,1130590010.002,"FDBNAME",2.5)
K ^C0PRXN("FDBNAME")
"IX",1130590010.002,1130590010.002,"FDBNAME",11.1,0)
^.114IA^1^1
"IX",1130590010.002,1130590010.002,"FDBNAME",11.1,1,0)
1^F^1130590010.002^2.02^100^1^F
"IX",1130590010.002,1130590010.002,"MEDID",0)
1130590010.002^MEDID^REGULAR INDEX ON THE MEDID FIELD^R^^F^IR^I^1130590010.002^^^^^LS
"IX",1130590010.002,1130590010.002,"MEDID",1)
S ^C0PRXN("MEDID",$E(X,1,30),DA)=""
"IX",1130590010.002,1130590010.002,"MEDID",2)
K ^C0PRXN("MEDID",$E(X,1,30),DA)
"IX",1130590010.002,1130590010.002,"MEDID",2.5)
K ^C0PRXN("MEDID")
"IX",1130590010.002,1130590010.002,"MEDID",11.1,0)
^.114IA^1^1
"IX",1130590010.002,1130590010.002,"MEDID",11.1,1,0)
1^F^1130590010.002^.02^30^1^F
"IX",1130590010.002,1130590010.002,"META",0)
1130590010.002^META^REGULAR INDEX ON FDB META DESC^R^^F^IR^I^1130590010.002^^^^^LS
"IX",1130590010.002,1130590010.002,"META",1)
S ^C0PRXN("META",X(2),DA)=""
"IX",1130590010.002,1130590010.002,"META",2)
K ^C0PRXN("META",X(2),DA)
"IX",1130590010.002,1130590010.002,"META",2.5)
K ^C0PRXN("META")
"IX",1130590010.002,1130590010.002,"META",11.1,0)
^.114IA^2^2
"IX",1130590010.002,1130590010.002,"META",11.1,1,0)
1^F^1130590010.002^1.02^^^F
"IX",1130590010.002,1130590010.002,"META",11.1,2,0)
2^C^^^^1
"IX",1130590010.002,1130590010.002,"META",11.1,2,1.5)
S X=$$GET1^DIQ(1130590010,X(1),24)
"IX",1130590010.002,1130590010.002,"VANAME",0)
1130590010.002^VANAME^REGULAR INDEX ON VA DRUG FILE NAME^R^^F^IR^I^1130590010.002^^^^^LS
"IX",1130590010.002,1130590010.002,"VANAME",1)
S ^C0PRXN("VANAME",$E(X,1,100),DA)=""
"IX",1130590010.002,1130590010.002,"VANAME",2)
K ^C0PRXN("VANAME",$E(X,1,100),DA)
"IX",1130590010.002,1130590010.002,"VANAME",2.5)
K ^C0PRXN("VANAME")
"IX",1130590010.002,1130590010.002,"VANAME",11.1,0)
^.114IA^1^1
"IX",1130590010.002,1130590010.002,"VANAME",11.1,1,0)
1^F^1130590010.002^2.03^100^1^F
"IX",1130590010.002,1130590010.002,"VAPROD",0)
1130590010.002^VAPROD^REGULAR INDEX ON VA PRODUCT NAME^R^^F^IR^I^1130590010.002^^^^^LS
"IX",1130590010.002,1130590010.002,"VAPROD",1)
S ^C0PRXN("VAPROD",$E(X,1,100),DA)=""
"IX",1130590010.002,1130590010.002,"VAPROD",2)
K ^C0PRXN("VAPROD",$E(X,1,100),DA)
"IX",1130590010.002,1130590010.002,"VAPROD",2.5)
K ^C0PRXN("VAPROD")
"IX",1130590010.002,1130590010.002,"VAPROD",11.1,0)
^.114IA^1^1
"IX",1130590010.002,1130590010.002,"VAPROD",11.1,1,0)
1^F^1130590010.002^1.04^100^1^F
"IX",1130590010.002,1130590010.002,"VUID",0)
1130590010.002^VUID^REGULAR INDEX ON THE VUID FIELD^R^^F^IR^I^1130590010.002^^^^^LS
"IX",1130590010.002,1130590010.002,"VUID",1)
S ^C0PRXN("VUID",$E(X,1,30),DA)=""
"IX",1130590010.002,1130590010.002,"VUID",2)
K ^C0PRXN("VUID",$E(X,1,30),DA)
"IX",1130590010.002,1130590010.002,"VUID",2.5)
K ^C0PRXN("VUID")
"IX",1130590010.002,1130590010.002,"VUID",11.1,0)
^.114IA^1^1
"IX",1130590010.002,1130590010.002,"VUID",11.1,1,0)
1^F^1130590010.002^.03^30^1^F
"IX",1130590011.001,1130590011.001,"GCN",0)
1130590011.001^GCN^This is used to index Generic Sequence Number from First Databank^R^^R^IR^I^1130590011.001^^^^^LS
"IX",1130590011.001,1130590011.001,"GCN",.1,0)
^^5^5^3091206^
"IX",1130590011.001,1130590011.001,"GCN",.1,1,0)
This is used to index Generic Sequence Numbers in First Databank. In 
"IX",1130590011.001,1130590011.001,"GCN",.1,2,0)
RxNorm, it's not called a GCN, but the GCN is the code when the Source 
"IX",1130590011.001,1130590011.001,"GCN",.1,3,0)
Abbrevaition is "NDDF" and the Term Type is "CDC". There will be a 
"IX",1130590011.001,1130590011.001,"GCN",.1,4,0)
transform of +X because the numbers are stored in RxNorm with leading 
"IX",1130590011.001,1130590011.001,"GCN",.1,5,0)
zeros while in the FDB file, they are not.
"IX",1130590011.001,1130590011.001,"GCN",1)
S ^C0P("RXN","GCN",X(1),DA)=""
"IX",1130590011.001,1130590011.001,"GCN",1.4)
S X=X(2)="NDDF"&(X(3)="CDC")
"IX",1130590011.001,1130590011.001,"GCN",2)
K ^C0P("RXN","GCN",X(1),DA)
"IX",1130590011.001,1130590011.001,"GCN",2.4)
S X=X(2)="NDDF"&(X(3)="CDC")
"IX",1130590011.001,1130590011.001,"GCN",2.5)
K ^C0P("RXN","GCN")
"IX",1130590011.001,1130590011.001,"GCN",11.1,0)
^.114IA^3^3
"IX",1130590011.001,1130590011.001,"GCN",11.1,1,0)
1^F^1130590011.001^4^^1^F
"IX",1130590011.001,1130590011.001,"GCN",11.1,1,2)
S X=+$TR(X,"E")
"IX",1130590011.001,1130590011.001,"GCN",11.1,2,0)
2^F^1130590011.001^2^^^F
"IX",1130590011.001,1130590011.001,"GCN",11.1,3,0)
3^F^1130590011.001^3^^^F
"IX",1130590011.001,1130590011.001,"NDDFBASE",0)
1130590011.001^NDDFBASE^Indexes ingredient entries belonging to First Databank^R^^R^IR^I^1130590011.001^^^^^LS
"IX",1130590011.001,1130590011.001,"NDDFBASE",.1,0)
^^7^7^3091223^
"IX",1130590011.001,1130590011.001,"NDDFBASE",.1,1,0)
Indexes ingredient entries when the SAB is "NDDF" (First Databank) and
"IX",1130590011.001,1130590011.001,"NDDFBASE",.1,2,0)
the TTY is "IN" (ingredient).
"IX",1130590011.001,1130590011.001,"NDDFBASE",.1,3,0)
This is used for lookup of RxNorm for allergies received from a First
"IX",1130590011.001,1130590011.001,"NDDFBASE",.1,4,0)
Databank (FDB) Database where the allergy Concept ID is the ingredient.
"IX",1130590011.001,1130590011.001,"NDDFBASE",.1,5,0)
The storage transform strips out "E" to prevent exponent interpretation 
"IX",1130590011.001,1130590011.001,"NDDFBASE",.1,6,0)
and pluses the value so that leading zeros are stripped. They are stored 
"IX",1130590011.001,1130590011.001,"NDDFBASE",.1,7,0)
in RxNorm with the zeros; but FDB does not store them with zeros.
"IX",1130590011.001,1130590011.001,"NDDFBASE",1)
S ^C0P("RXN","NDDFBASE",X(1),DA)=""
"IX",1130590011.001,1130590011.001,"NDDFBASE",1.4)
S X=X(2)="NDDF"&(X(3)="IN")
"IX",1130590011.001,1130590011.001,"NDDFBASE",2)
K ^C0P("RXN","NDDFBASE",X(1),DA)
"IX",1130590011.001,1130590011.001,"NDDFBASE",2.4)
S X=X(2)="NDDF"&(X(3)="IN")
"IX",1130590011.001,1130590011.001,"NDDFBASE",2.5)
K ^C0P("RXN","NDDFBASE")
"IX",1130590011.001,1130590011.001,"NDDFBASE",11.1,0)
^.114IA^3^3
"IX",1130590011.001,1130590011.001,"NDDFBASE",11.1,1,0)
1^F^1130590011.001^4^^1^F
"IX",1130590011.001,1130590011.001,"NDDFBASE",11.1,1,2)
S X=+$TR(X,"E")
"IX",1130590011.001,1130590011.001,"NDDFBASE",11.1,2,0)
2^F^1130590011.001^2^^^F
"IX",1130590011.001,1130590011.001,"NDDFBASE",11.1,3,0)
3^F^1130590011.001^3^^^F
"IX",1130590011.001,1130590011.001,"RNDDFBASE",0)
1130590011.001^RNDDFBASE^Reverse NDDF Base Index^R^^R^IR^I^1130590011.001^^^^^LS
"IX",1130590011.001,1130590011.001,"RNDDFBASE",.1,0)
^^1^1^3091229^
"IX",1130590011.001,1130590011.001,"RNDDFBASE",.1,1,0)
Use this to get a NDDF Ingredient from an RxNorm CUI.
"IX",1130590011.001,1130590011.001,"RNDDFBASE",1)
S ^C0P("RXN","RNDDFBASE",X(1),DA)=""
"IX",1130590011.001,1130590011.001,"RNDDFBASE",1.4)
S X=X(2)="NDDF"&(X(3)="IN")
"IX",1130590011.001,1130590011.001,"RNDDFBASE",2)
K ^C0P("RXN","RNDDFBASE",X(1),DA)
"IX",1130590011.001,1130590011.001,"RNDDFBASE",2.4)
S X=X(2)="NDDF"&(X(3)="IN")
"IX",1130590011.001,1130590011.001,"RNDDFBASE",2.5)
K ^C0P("RXN","RNDDFBASE")
"IX",1130590011.001,1130590011.001,"RNDDFBASE",11.1,0)
^.114IA^3^3
"IX",1130590011.001,1130590011.001,"RNDDFBASE",11.1,1,0)
1^F^1130590011.001^.01^^1^F
"IX",1130590011.001,1130590011.001,"RNDDFBASE",11.1,1,3)

"IX",1130590011.001,1130590011.001,"RNDDFBASE",11.1,2,0)
2^F^1130590011.001^2^^^F
"IX",1130590011.001,1130590011.001,"RNDDFBASE",11.1,2,3)

"IX",1130590011.001,1130590011.001,"RNDDFBASE",11.1,3,0)
3^F^1130590011.001^3^^^F
"IX",1130590011.001,1130590011.001,"RNDDFBASE",11.1,3,3)

"IX",1130590011.001,1130590011.001,"SCD",0)
1130590011.001^SCD^Index for RXNORM canonical entries^R^^R^IR^I^1130590011.001^^^^^LS
"IX",1130590011.001,1130590011.001,"SCD",.1,0)
^^4^4^3090222^
"IX",1130590011.001,1130590011.001,"SCD",.1,1,0)
This field indexes only Semantic Clinical Drugs. Thus indexed, if we get 
"IX",1130590011.001,1130590011.001,"SCD",.1,2,0)
into a quandary of 2 RxNorm codes, not knowing which one is the 
"IX",1130590011.001,1130590011.001,"SCD",.1,3,0)
cannonical one, we can find that one that has a semantic clinical drug 
"IX",1130590011.001,1130590011.001,"SCD",.1,4,0)
entry.
"IX",1130590011.001,1130590011.001,"SCD",1)
S ^C0P("RXN","SCD",X(1),DA)=""
"IX",1130590011.001,1130590011.001,"SCD",1.4)
S X=X(2)="RXNORM"&(X(3)="SCD")
"IX",1130590011.001,1130590011.001,"SCD",2)
K ^C0P("RXN","SCD",X(1),DA)
"IX",1130590011.001,1130590011.001,"SCD",2.4)
S X=X(2)="RXNORM"&(X(3)="SCD")
"IX",1130590011.001,1130590011.001,"SCD",2.5)
K ^C0P("RXN","SCD")
"IX",1130590011.001,1130590011.001,"SCD",11.1,0)
^.114IA^3^3
"IX",1130590011.001,1130590011.001,"SCD",11.1,1,0)
1^F^1130590011.001^.01^^1^F
"IX",1130590011.001,1130590011.001,"SCD",11.1,1,3)

"IX",1130590011.001,1130590011.001,"SCD",11.1,2,0)
2^F^1130590011.001^2^^^F
"IX",1130590011.001,1130590011.001,"SCD",11.1,2,3)

"IX",1130590011.001,1130590011.001,"SCD",11.1,3,0)
3^F^1130590011.001^3^^^F
"IX",1130590011.001,1130590011.001,"SCD",11.1,3,3)

"IX",1130590011.001,1130590011.001,"VUID",0)
1130590011.001^VUID^VUID Index^R^^R^IR^I^1130590011.001^^^^^LS
"IX",1130590011.001,1130590011.001,"VUID",.1,0)
^^1^1^3091229^
"IX",1130590011.001,1130590011.001,"VUID",.1,1,0)
This index assists in getting the RxNorm Value for a Drug given its VUID.
"IX",1130590011.001,1130590011.001,"VUID",1)
S ^C0P("RXN","VUID",X(1),DA)=""
"IX",1130590011.001,1130590011.001,"VUID",1.4)
S X=X(2)="VANDF"
"IX",1130590011.001,1130590011.001,"VUID",2)
K ^C0P("RXN","VUID",X(1),DA)
"IX",1130590011.001,1130590011.001,"VUID",2.4)
S X=X(2)="VANDF"
"IX",1130590011.001,1130590011.001,"VUID",2.5)
K ^C0P("RXN","VUID")
"IX",1130590011.001,1130590011.001,"VUID",11.1,0)
^.114IA^2^2
"IX",1130590011.001,1130590011.001,"VUID",11.1,1,0)
1^F^1130590011.001^4^^1^F
"IX",1130590011.001,1130590011.001,"VUID",11.1,1,3)

"IX",1130590011.001,1130590011.001,"VUID",11.1,2,0)
2^F^1130590011.001^2^^^F
"IX",1130590011.001,1130590011.001,"VUID",11.1,2,3)

"IX",1130590011.001,1130590011.001,"VUIDCD",0)
1130590011.001^VUIDCD^VUID Clinical Drugs Index^R^^R^IR^I^1130590011.001^^^^^LS
"IX",1130590011.001,1130590011.001,"VUIDCD",.1,0)
^^9^9^3091223^
"IX",1130590011.001,1130590011.001,"VUIDCD",.1,1,0)
This index is to enable the programmer to pull the VUID number given 
"IX",1130590011.001,1130590011.001,"VUIDCD",.1,2,0)
the RxNorm RXNCUI. The VUID is the source vocabulary code when the entry 
"IX",1130590011.001,1130590011.001,"VUIDCD",.1,3,0)
Source is "VANDF" (thus the index logic that you see). The number
"IX",1130590011.001,1130590011.001,"VUIDCD",.1,4,0)
corresponds to the VUID in the drug ingredients file, VA Generic file, and
"IX",1130590011.001,1130590011.001,"VUIDCD",.1,5,0)
various other drug files that reference a VUID. In addtion, GMR Allergy
"IX",1130590011.001,1130590011.001,"VUIDCD",.1,6,0)
file also references this file for allergens.
"IX",1130590011.001,1130590011.001,"VUIDCD",.1,7,0)
 
"IX",1130590011.001,1130590011.001,"VUIDCD",.1,8,0)
This specific index only indexes entries that are Clinical Drugs (TTY is 
"IX",1130590011.001,1130590011.001,"VUIDCD",.1,9,0)
CD). The file in VistA that contains those VUIDs is the VA Product file.
"IX",1130590011.001,1130590011.001,"VUIDCD",1)
S ^C0P("RXN","VUIDCD",X(1),DA)=""
"IX",1130590011.001,1130590011.001,"VUIDCD",1.4)
S X=X(2)="VANDF"&(X(3)="CD")
"IX",1130590011.001,1130590011.001,"VUIDCD",2)
K ^C0P("RXN","VUIDCD",X(1),DA)
"IX",1130590011.001,1130590011.001,"VUIDCD",2.4)
S X=X(2)="VANDF"&(X(3)="CD")
"IX",1130590011.001,1130590011.001,"VUIDCD",2.5)
K ^C0P("RXN","VUIDCD")
"IX",1130590011.001,1130590011.001,"VUIDCD",11.1,0)
^.114IA^3^3
"IX",1130590011.001,1130590011.001,"VUIDCD",11.1,1,0)
1^F^1130590011.001^.01^^1^F
"IX",1130590011.001,1130590011.001,"VUIDCD",11.1,2,0)
2^F^1130590011.001^2^^^F
"IX",1130590011.001,1130590011.001,"VUIDCD",11.1,3,0)
3^F^1130590011.001^3^^^F
"IX",1130590011.001,1130590011.001,"VUIDIN",0)
1130590011.001^VUIDIN^VUID Drug Ingredients Index^R^^R^IR^I^1130590011.001^^^^^LS
"IX",1130590011.001,1130590011.001,"VUIDIN",.1,0)
^^9^9^3091223^
"IX",1130590011.001,1130590011.001,"VUIDIN",.1,1,0)
This index is to enable the programmer to pull the VUID number given the
"IX",1130590011.001,1130590011.001,"VUIDIN",.1,2,0)
RxNorm RXNCUI. The VUID is the source vocabulary code when the entry
"IX",1130590011.001,1130590011.001,"VUIDIN",.1,3,0)
Source is "VANDF" (thus the index logic that you see). The number
"IX",1130590011.001,1130590011.001,"VUIDIN",.1,4,0)
corresponds to the VUID in the drug ingredients file, VA Generic file, and
"IX",1130590011.001,1130590011.001,"VUIDIN",.1,5,0)
various other drug files that reference a VUID. In addtion, GMR Allergy
"IX",1130590011.001,1130590011.001,"VUIDIN",.1,6,0)
file also references this file for allergens.
"IX",1130590011.001,1130590011.001,"VUIDIN",.1,7,0)
 
"IX",1130590011.001,1130590011.001,"VUIDIN",.1,8,0)
This specific index only indexes entries that are ingredients (TTY is IN).
"IX",1130590011.001,1130590011.001,"VUIDIN",.1,9,0)
The file in VistA that contains those VUIDs is the Drug Ingredient file.
"IX",1130590011.001,1130590011.001,"VUIDIN",1)
S ^C0P("RXN","VUIDIN",X(1),DA)=""
"IX",1130590011.001,1130590011.001,"VUIDIN",1.4)
S X=X(2)="VANDF"&(X(3)="IN")
"IX",1130590011.001,1130590011.001,"VUIDIN",2)
K ^C0P("RXN","VUIDIN",X(1),DA)
"IX",1130590011.001,1130590011.001,"VUIDIN",2.4)
S X=X(2)="VANDF"&(X(3)="IN")
"IX",1130590011.001,1130590011.001,"VUIDIN",2.5)
K ^C0P("RXN","VUIDIN")
"IX",1130590011.001,1130590011.001,"VUIDIN",11.1,0)
^.114IA^3^3
"IX",1130590011.001,1130590011.001,"VUIDIN",11.1,1,0)
1^F^1130590011.001^.01^^1^F
"IX",1130590011.001,1130590011.001,"VUIDIN",11.1,1,3)

"IX",1130590011.001,1130590011.001,"VUIDIN",11.1,2,0)
2^F^1130590011.001^2^^^F
"IX",1130590011.001,1130590011.001,"VUIDIN",11.1,2,3)

"IX",1130590011.001,1130590011.001,"VUIDIN",11.1,3,0)
3^F^1130590011.001^3^^^F
"IX",1130590011.001,1130590011.001,"VUIDIN",11.1,3,3)

"KEY",113059001,113059001,"A",0)
113059001^A^P^559
"KEY",113059001,113059001,"A",2,0)
^.312IA^2^2
"KEY",113059001,113059001,"A",2,1,0)
.01^113059001^2
"KEY",113059001,113059001,"A",2,2,0)
.02^113059001^1
"KEYPTR",113059001,113059001,"A")
113059001^C
"KRN",.4,1511,-1)
0^1
"KRN",.4,1511,0)
C0P MAPPED BRAND DRUGS VANAME^3100911.1425^@^1130590010.002^^@^3120424
"KRN",.4,1511,"F",2)
4.02~2.02~2.03~
"KRN",.4,1511,"H")
C0P RXNORM FDB VUID MAPPING SEARCH
"KRN",.401,918,-1)
0^1
"KRN",.401,918,0)
C0P BRAND NAME ANALYSIS^3100911.1357^@^1130590010.002^^@^3100912
"KRN",.401,918,"%D",0)
^.4012^3^3^3100911^^^^
"KRN",.401,918,"%D",1,0)
Created by gpl for the Oroville eRx project. Tries to locate all FDB 
"KRN",.401,918,"%D",2,0)
Brand name drugs and show the cooresponding PHARMACY ORDERABLE ITEM that 
"KRN",.401,918,"%D",3,0)
will be used in VistA after mapping by eRx.
"KRN",.401,918,"DC",1)
3^="2"
"KRN",.401,918,"DIS",0)
I $P($G(^C0PRXN(D0,2)),U,4)="2"
"KRN",.401,918,"DL")
1
"KRN",.401,918,"DL",0)
^1^
"KRN",.401,918,"O",0)
^
"KRN",.401,918,"O",1,0)
MAPPING TYPE EQUALS "2"^TYPE 2 DRUG FILE MATCH
"KRN",.401,918,"QR")
3100911.140028^278
"KRN",.401,919,-1)
0^2
"KRN",.401,919,0)
C0P SORT BY RXNCUI^3100912.1542^@^1130590010.002^^@^3120424
"KRN",.401,919,2,0)
^.4014^2^2
"KRN",.401,919,2,1,0)
1130590010.002^^'C0P BRAND NAME ANALYSIS' NUMBER^@'
"KRN",.401,919,2,1,"GET")
S DISX(1)=D0
"KRN",.401,919,2,1,"IX")
^DIBT(946,1,^C0PRXN(^1
"KRN",.401,919,2,1,"QCON")
I D0'=""
"KRN",.401,919,2,1,"TXT")
'C0P BRAND NAME ANALYSIS' NUMBER not null
"KRN",.401,919,2,2,0)
1130590010.002^.01^RXNCUI^^^^^^^4
"KRN",.401,919,2,2,"GET")
S DISX(2)=$P($G(^C0PRXN(D0,0)),U)
"KRN",.401,919,2,2,"IX")
^C0PRXN("B",^C0PRXN(^2
"KRN",.401,919,2,2,"QCON")
I DISX(2)'=""
"KRN",.401,919,2,2,"SER")
0^0
"KRN",.401,919,2,2,"TXT")
RXNCUI not null
"KRN",.401,919,2,"B",1130590010.002,1)

"KRN",.401,919,2,"B",1130590010.002,2)

"KRN",.402,1731,-1)
0^1
"KRN",.402,1731,0)
C0P ERX ENTER EDIT LOCATION^3101104.1951^@^44^^@^3120510
"KRN",.402,1731,"DR",1,44)
3;113059111;113059112;113059114;113059115;113059116;113059001;
"KRN",.402,1731,"DR",2,44.113059)
.01;1;2;3;
"KRN",.402,1732,-1)
0^2
"KRN",.402,1732,0)
C0P SUPERVISING DOCTOR^3110208.1104^@^200^^@^3120518
"KRN",.402,1732,"DR",1,200)
113059003;
"KRN",.402,1732,"DR",2,200.113059)
6;
"KRN",.403,111,-1)
0^1
"KRN",.403,111,0)
C0P ENTER SUBSCRIBER^@^@^^3091105.1303^^^200^0^0^1
"KRN",.403,111,40,0)
^.4031I^3^3
"KRN",.403,111,40,1,0)
1^^1,1
"KRN",.403,111,40,1,1)
Page 1
"KRN",.403,111,40,1,40,0)
^.4032IP^428^3
"KRN",.403,111,40,1,40,426,0)
C0P DISPLAY HEADER^1^1,1^d
"KRN",.403,111,40,1,40,427,0)
C0P EDIT F200^2^5,1^e
"KRN",.403,111,40,1,40,428,0)
C0P LICENSURE REPEATING^3^10,7^e
"KRN",.403,111,40,1,40,428,2)
4
"KRN",.403,111,40,2,0)
1.5^^6,9^^^1^17,70
"KRN",.403,111,40,2,1)
Page 1.5^SUBSCRIPTION,C0P EDIT F200,1
"KRN",.403,111,40,2,40,0)
^.4032IP^429^1
"KRN",.403,111,40,2,40,429,0)
C0P EDIT SUB FIELDS^1^3,4^e
"KRN",.403,111,40,3,0)
1.7^^4,3^^^1^16,77
"KRN",.403,111,40,3,1)
Page 1.7^PRACTICE LOCATION,C0P EDIT SUB FIELDS,1.5
"KRN",.403,111,40,3,40,0)
^.4032IP^431^2
"KRN",.403,111,40,3,40,430,0)
C0P DISPLAY LOCATION^1^3,5^d
"KRN",.403,111,40,3,40,430,1)
C0P SUBSCRIPTION:C0P LOCATION
"KRN",.403,111,40,3,40,431,0)
C0P ERX PHONE FAX EDIT^2^6,5^e
"KRN",.403,111,40,3,40,431,1)
C0P SUBSCRIPTION:C0P LOCATION
"KRN",.403,111,40,3,40,431,2)
4^PRIORITY^f
"KRN",.404,426,0)
C0P DISPLAY HEADER^200^
"KRN",.404,426,15,0)
^^1^1^3091105^
"KRN",.404,426,15,1,0)
This block contains the header saying which person we are editing...
"KRN",.404,426,40,0)
^.4044I^5^5
"KRN",.404,426,40,1,0)
1^Provider^3
"KRN",.404,426,40,1,1)
.01
"KRN",.404,426,40,1,2)
3,12^22^3,2
"KRN",.404,426,40,2,0)
2^Update Subscription to E-RX and other Web Services^1
"KRN",.404,426,40,2,2)
^^1,15
"KRN",.404,426,40,3,0)
3^Status^4
"KRN",.404,426,40,3,2)
4,12^65^4,4
"KRN",.404,426,40,3,30)
N %1 S %1=$$STATUS^C0PSUB(D0,"ERX") S Y=$TR($P(%1,U,2,99),U,", ")
"KRN",.404,426,40,4,0)
4^NPI^3
"KRN",.404,426,40,4,1)
41.99
"KRN",.404,426,40,4,2)
3,54^10^3,49
"KRN",.404,426,40,5,0)
5^-------------------------------------------------------------------------------^1
"KRN",.404,426,40,5,2)
^^5,1
"KRN",.404,427,0)
C0P EDIT F200^200
"KRN",.404,427,15,0)
^^6^6^3091105^
"KRN",.404,427,15,1,0)
This block will contain editing for the following:
"KRN",.404,427,15,2,0)
 
"KRN",.404,427,15,3,0)
DEA#
"KRN",.404,427,15,4,0)
VA#
"KRN",.404,427,15,5,0)
NPI
"KRN",.404,427,15,6,0)
C0P Subscription Multiple
"KRN",.404,427,40,0)
^.4044I^7^5
"KRN",.404,427,40,1,0)
1^DEA#^3
"KRN",.404,427,40,1,1)
53.2
"KRN",.404,427,40,1,2)
3,12^9^3,6
"KRN",.404,427,40,4,0)
5^LICENSURE STATE^1
"KRN",.404,427,40,4,2)
^^9,7
"KRN",.404,427,40,5,0)
6^LICENSE NUMBER^1
"KRN",.404,427,40,5,2)
^^9,43
"KRN",.404,427,40,6,0)
4^Select SUBSCRIPTION^3
"KRN",.404,427,40,6,1)
113059003
"KRN",.404,427,40,6,2)
6,39^11^6,18
"KRN",.404,427,40,7,0)
3^NPI^3
"KRN",.404,427,40,7,1)
41.99
"KRN",.404,427,40,7,2)
3,54^10^3,49
"KRN",.404,427,40,7,13)
D REFRESH^DDSUTL
"KRN",.404,427,40,7,14)
N %1 S %1=$$ADDNPI^XUSNPI("Individual_ID",D0,X,$$NOW^XLFDT()) I %1<0 S DDSERROR=+%1 W $C(7) D HLP^DDSUTL($P(%1,U,2))
"KRN",.404,428,0)
C0P LICENSURE REPEATING^200.541
"KRN",.404,428,40,0)
^.4044I^2^2
"KRN",.404,428,40,1,0)
1^^3
"KRN",.404,428,40,1,1)
.01
"KRN",.404,428,40,1,2)
5,1^30
"KRN",.404,428,40,2,0)
2^^3
"KRN",.404,428,40,2,1)
1
"KRN",.404,428,40,2,2)
5,37^21
"KRN",.404,429,0)
C0P EDIT SUB FIELDS^200.113059
"KRN",.404,429,40,0)
^.4044I^8^8
"KRN",.404,429,40,1,0)
1^Subscription Fields^1
"KRN",.404,429,40,1,2)
^^1,18
"KRN",.404,429,40,2,0)
2^SUBSCRIPTION TYPE^3
"KRN",.404,429,40,2,1)
.01
"KRN",.404,429,40,2,2)
3,20^22^3,1
"KRN",.404,429,40,3,0)
3^ACCOUNT^3
"KRN",.404,429,40,3,1)
1
"KRN",.404,429,40,3,2)
4,20^16^4,11
"KRN",.404,429,40,4,0)
4^PRACTICE LOCATION^3
"KRN",.404,429,40,4,1)
2
"KRN",.404,429,40,4,2)
5,20^33^5,1
"KRN",.404,429,40,5,0)
8^DISABLE SERVICE?^3
"KRN",.404,429,40,5,1)
3
"KRN",.404,429,40,5,2)
9,20^3^9,2
"KRN",.404,429,40,6,0)
5^USER TYPE^3
"KRN",.404,429,40,6,1)
4
"KRN",.404,429,40,6,2)
6,20^18^6,9
"KRN",.404,429,40,7,0)
6^USER ROLE^3
"KRN",.404,429,40,7,1)
4.1
"KRN",.404,429,40,7,2)
7,20^18^7,9
"KRN",.404,429,40,8,0)
7^REQUESTED PAGE^3
"KRN",.404,429,40,8,1)
4.2
"KRN",.404,429,40,8,2)
8,20^19^8,4
"KRN",.404,430,0)
C0P DISPLAY LOCATION^44^
"KRN",.404,430,40,0)
^.4044I^6^6
"KRN",.404,430,40,1,0)
1^Edit Location Web Service Fields for:^1
"KRN",.404,430,40,1,2)
^^1,1
"KRN",.404,430,40,2,0)
2^^3
"KRN",.404,430,40,2,1)
.01
"KRN",.404,430,40,2,2)
1,40^27
"KRN",.404,430,40,2,4)
^^1
"KRN",.404,430,40,3,0)
3^PRIORITY^1
"KRN",.404,430,40,3,2)
^^3,24
"KRN",.404,430,40,4,0)
4^LABEL^1
"KRN",.404,430,40,4,2)
^^3,1
"KRN",.404,430,40,5,0)
5^PHONE^1
"KRN",.404,430,40,5,2)
^^3,35
"KRN",.404,430,40,6,0)
6^FAX^1
"KRN",.404,430,40,6,2)
^^3,53
"KRN",.404,431,0)
C0P ERX PHONE FAX EDIT^44.113059
"KRN",.404,431,40,0)
^.4044I^4^4
"KRN",.404,431,40,1,0)
2^^3
"KRN",.404,431,40,1,1)
3
"KRN",.404,431,40,1,2)
1,28^4
"KRN",.404,431,40,1,4)
^^1
"KRN",.404,431,40,2,0)
1^^3
"KRN",.404,431,40,2,1)
.01
"KRN",.404,431,40,2,2)
1,1^22
"KRN",.404,431,40,3,0)
3^^3
"KRN",.404,431,40,3,1)
1
"KRN",.404,431,40,3,2)
1,35^14
"KRN",.404,431,40,4,0)
4^^3
"KRN",.404,431,40,4,1)
2
"KRN",.404,431,40,4,2)
1,53^14
"KRN",3.6,199,-1)
0^1
"KRN",3.6,199,0)
C0P EXTERNAL DRUG NOT FOUND^External Drug from E-Prescribing Not Found in VISTA
"KRN",3.6,199,1,0)
^^7^7^3120510^
"KRN",3.6,199,1,1,0)
Chart #: |1|    Drug: |2|
"KRN",3.6,199,1,2,0)
 
"KRN",3.6,199,1,3,0)
Drug |3| for patient |4| (#|5|) was stored as a FREE TEXT DRUG becuase a 
"KRN",3.6,199,1,4,0)
match in the Drug File could not be found.
"KRN",3.6,199,1,5,0)
 
"KRN",3.6,199,1,6,0)
To prevent this, make sure you add the specific drug to the Drug File and 
"KRN",3.6,199,1,7,0)
match it properly to the National Drug File.
"KRN",3.6,199,3,0)
^^5^5^3120510^
"KRN",3.6,199,3,1,0)
This bulletin notifies members of ERX HELP DESK if the prescription 
"KRN",3.6,199,3,2,0)
receivied from the external electronic prescirbing service is for a drug 
"KRN",3.6,199,3,3,0)
that is not in the VISTA database and that therefore has to be added in 
"KRN",3.6,199,3,4,0)
order for that drug not to show up as "FREE TXT DRUG" in the Drug View in 
"KRN",3.6,199,3,5,0)
CPRS and in Outpatient Pharmacy.
"KRN",3.6,199,4,0)
^3.64A^5^5
"KRN",3.6,199,4,1,0)
1
"KRN",3.6,199,4,1,1,0)
^^1^1^3120510^
"KRN",3.6,199,4,1,1,1,0)
Chart Number (Primary Long ID).
"KRN",3.6,199,4,2,0)
2
"KRN",3.6,199,4,2,1,0)
^^1^1^3120510^
"KRN",3.6,199,4,2,1,1,0)
Drug Name from External Service.
"KRN",3.6,199,4,3,0)
3
"KRN",3.6,199,4,3,1,0)
^^1^1^3120510^
"KRN",3.6,199,4,3,1,1,0)
Drug Name from External Service
"KRN",3.6,199,4,4,0)
4
"KRN",3.6,199,4,4,1,0)
^^1^1^3120510^
"KRN",3.6,199,4,4,1,1,0)
Patient Name
"KRN",3.6,199,4,5,0)
5
"KRN",3.6,199,4,5,1,0)
^^1^1^3120510^
"KRN",3.6,199,4,5,1,1,0)
Chart # (Primary Long ID)
"KRN",3.8,252,-1)
0^1
"KRN",3.8,252,0)
ERX HELP DESK^PU^y^^^^
"KRN",3.8,252,2,0)
^^2^2^3120510^
"KRN",3.8,252,2,1,0)
Mail group to receive eRx alerts such as failed faxes. Failed Faxes is 
"KRN",3.8,252,2,2,0)
the only event that is sent to this Mail Group currently.
"KRN",3.8,252,3)

"KRN",9.2,1264,-1)
0^1
"KRN",9.2,1264,0)
C0P SETUP HELP^E-PRESCRIBING SET-UP HELP^3120510.1731^^
"KRN",9.2,1264,1,0)
^9.21^22^22^3120510^^
"KRN",9.2,1264,1,1,0)
Make sure to set-up the following after installation: 
"KRN",9.2,1264,1,2,0)
 - Account Info in C0P WS ACCT
"KRN",9.2,1264,1,3,0)
 - Institution address fields in file 4
"KRN",9.2,1264,1,4,0)
 - Hospital Location E-Rx fields
"KRN",9.2,1264,1,5,0)
 - New Person E-Rx fields
"KRN",9.2,1264,1,6,0)
 - Mail users to mail group: ERX HELP DESK
"KRN",9.2,1264,1,7,0)
 - Schedule C0P ERX BATCH to run every 15 min using an eRx user
"KRN",9.2,1264,1,8,0)
 
"KRN",9.2,1264,1,9,0)
Most of these can be accomplished in C0PMENU. You need the C0PZMENU
"KRN",9.2,1264,1,10,0)
security key to enter the menu, and C0PZMGR to edit the account.
"KRN",9.2,1264,1,11,0)
 
"KRN",9.2,1264,1,12,0)
1. Account Info in C0P WS ACCT -> Account Add/Edit (C0P ACCOUNT EDIT)
"KRN",9.2,1264,1,13,0)
2. Institution address fields in file 4 -> These should be already 
"KRN",9.2,1264,1,14,0)
set-up in a production system. Contact your Site Manager/IRM to confirm
"KRN",9.2,1264,1,15,0)
that all sign-on institutions have address information. 
"KRN",9.2,1264,1,16,0)
3. Hospital Location E-Rx fields -> Location Edit (C0P LOCATION EDIT)
"KRN",9.2,1264,1,17,0)
   To add new Clinics, use the menu option SDBUILD in PIMS.
"KRN",9.2,1264,1,18,0)
4. New Person E-Rx fields -> Subscriber Edit (C0P SUBSCRIBER EDIT)
"KRN",9.2,1264,1,19,0)
(optional for Midlevels) -> Supervising Doctor Enter/Edit (C0P 
"KRN",9.2,1264,1,20,0)
SUPERVISING DOCTOR EDIT)
"KRN",9.2,1264,1,21,0)
 
"KRN",9.2,1264,1,22,0)
[MORE]
"KRN",9.2,1264,2,0)
^9.22A^1^1
"KRN",9.2,1264,2,1,0)
MORE^C0P SETUP HELP2
"KRN",9.2,1265,-1)
0^2
"KRN",9.2,1265,0)
C0P SETUP HELP2^E-PRESCRIBING SET-UP HELP CONTINUED^3120510.1731^^
"KRN",9.2,1265,1,0)
^^5^5^3120510^
"KRN",9.2,1265,1,1,0)
5. Mail users to mail group: ERX HELP DESK -> Can be done by the Site 
"KRN",9.2,1265,1,2,0)
Manager/IRM; users can join themselves from the Toolbox's mailman menu.
"KRN",9.2,1265,1,3,0)
6. Schedule C0P ERX BATCH to run every 15 min using an eRx user -> Site 
"KRN",9.2,1265,1,4,0)
Manager/IRM will do that. Make sure you have a proper user set-up and 
"KRN",9.2,1265,1,5,0)
tested with New Crop prior to activating the C0P ERX BATCH job.
"KRN",19,10997,-1)
0^4
"KRN",19,10997,0)
C0P ERX ORDER RPC^C0P ERX ORDER RPC^^B^^^^^^^^
"KRN",19,10997,"RPC",0)
^19.05P^1^1
"KRN",19,10997,"RPC",1,0)
C0P ERX ORDER RPC
"KRN",19,10997,"U")
C0P ERX ORDER RPC
"KRN",19,10998,-1)
0^9
"KRN",19,10998,0)
C0P SUBSCRIBER EDIT^Subscriber Edit^^C^^^^^^^^
"KRN",19,10998,1,0)
^19.06^4^4^3120519^^
"KRN",19,10998,1,1,0)
This option will lets you subscribe a user to ePrescribing. All fields 
"KRN",19,10998,1,2,0)
have to be filled out in order for the subscriber to become active for 
"KRN",19,10998,1,3,0)
eRx. A status field at the top of the form updates every time you save to
"KRN",19,10998,1,4,0)
check for missing data as you are entering data.
"KRN",19,10998,30)
VA(200,
"KRN",19,10998,31)
AEMQ
"KRN",19,10998,40)
[C0P ENTER SUBSCRIBER]
"KRN",19,10998,41)
200
"KRN",19,10998,43)
1
"KRN",19,10998,50)
C0P(
"KRN",19,10998,51)
[C0P ENTER EDIT SUBSCRIBER]
"KRN",19,10998,"U")
SUBSCRIBER EDIT
"KRN",19,10999,-1)
0^10
"KRN",19,10999,0)
C0P SUBSCRIBER STATUS INQUIRE^Show a subscriber's status^^R^^^^^^^^
"KRN",19,10999,1,0)
^^4^4^3120519^
"KRN",19,10999,1,1,0)
This option shows you the status of the a user with respect 
"KRN",19,10999,1,2,0)
to the ePrescribing Service. If there are no data elements missing, the 
"KRN",19,10999,1,3,0)
user will be active for the service; otherwise, the missing data elements 
"KRN",19,10999,1,4,0)
will be printed.
"KRN",19,10999,25)
STATUS2^C0PSUB
"KRN",19,10999,"U")
SHOW A SUBSCRIBER'S STATUS
"KRN",19,11000,-1)
0^1
"KRN",19,11000,0)
C0P ACCOUNT EDIT^Account Add/Edit^^E^^C0PZMGR^^^^^^ORO ERX E-PRESCRIBING^^1^1
"KRN",19,11000,1,0)
^19.06^4^4^3120510^^^^
"KRN",19,11000,1,1,0)
This option lets you add/edit the file containing the account information
"KRN",19,11000,1,2,0)
for the E-Rx subscription service, currently New Crop, in C0P WS ACCT. You
"KRN",19,11000,1,3,0)
need to do this first before doing anything else, as the rest of the
"KRN",19,11000,1,4,0)
set-up references this.
"KRN",19,11000,15)
K DLAYGO
"KRN",19,11000,20)
S DLAYGO=113059002
"KRN",19,11000,30)
C0PS(
"KRN",19,11000,31)
AEMQL
"KRN",19,11000,50)
C0PS(
"KRN",19,11000,51)
.01:9999
"KRN",19,11000,"U")
ACCOUNT ADD/EDIT
"KRN",19,11001,-1)
0^7
"KRN",19,11001,0)
C0P LOCATION EDIT^Location Edit^^E^^^^^^^^
"KRN",19,11001,1,0)
^^5^5^3120519^
"KRN",19,11001,1,1,0)
This option lets you edit the Hospital Location eRx-related fields. The 
"KRN",19,11001,1,2,0)
Phone Fax Label multiple is required for the functioning of the package. 
"KRN",19,11001,1,3,0)
If address information is not entered (specifically C0P ERX STREET 
"KRN",19,11001,1,4,0)
ADDRESS 1), the address of the current institution (i.e. the value 
"KRN",19,11001,1,5,0)
of DUZ(2)) will be used instead.
"KRN",19,11001,30)
SC(
"KRN",19,11001,31)
AEMQ
"KRN",19,11001,50)
SC(
"KRN",19,11001,51)
[C0P ERX ENTER EDIT LOCATION]
"KRN",19,11001,"U")
LOCATION EDIT
"KRN",19,11004,-1)
0^5
"KRN",19,11004,0)
C0P ERX PULLBACK^C0P ERX PULLBACK^^B^^^^^^^^
"KRN",19,11004,"RPC",0)
^19.05P^1^1
"KRN",19,11004,"RPC",1,0)
C0P ERX PULLBACK
"KRN",19,11004,"U")
C0P ERX PULLBACK
"KRN",19,11005,-1)
0^11
"KRN",19,11005,0)
C0P ERX BATCH^C0P ERX BATCH^^R^^^^^^^^
"KRN",19,11005,1,0)
^19.06^5^5^3100721^^^^
"KRN",19,11005,1,1,0)
Created by George Lilly on 4/15/2010 for the Oroville eRx Project.
"KRN",19,11005,1,2,0)
 
"KRN",19,11005,1,3,0)
This option is not meant to be accessed from a menu. It is to be 
"KRN",19,11005,1,4,0)
scheduled as a background task to run every 15 minutes or so to poll the 
"KRN",19,11005,1,5,0)
ePrescribing provider for refill requests from pharmacies.
"KRN",19,11005,25)
EN^C0PREFIL
"KRN",19,11005,200.9)
y
"KRN",19,11005,"U")
C0P ERX BATCH
"KRN",19,11007,-1)
0^14
"KRN",19,11007,0)
C0P MAPPING MENU^ERx Drug Mapping Menu^Reserved for use in Future Versions^M^^^^^^^^
"KRN",19,11007,10,0)
^19.01IP^1^1
"KRN",19,11007,10,1,0)
11008
"KRN",19,11007,10,1,"^")
C0P MAPPED BRANDED DRUGS
"KRN",19,11007,99)
62587,60540
"KRN",19,11007,"U")
ERX DRUG MAPPING MENU
"KRN",19,11008,-1)
0^13
"KRN",19,11008,0)
C0P MAPPED BRANDED DRUGS^ERX MAPPED BRANDED DRUG REPORT^^P^^^^^^^^
"KRN",19,11008,60)
C0PRXN(
"KRN",19,11008,62)
0
"KRN",19,11008,63)
[C0P MAPPED BRAND DRUGS VANAME]
"KRN",19,11008,64)
[C0P SORT BY RXNCUI]
"KRN",19,11008,65)

"KRN",19,11008,66)

"KRN",19,11008,"U")
ERX MAPPED BRANDED DRUG REPORT
"KRN",19,11070,-1)
0^15
"KRN",19,11070,0)
C0PMENU^e-Prescription Menu^^M^^C0PZMENU^^^^^^ORO ERX E-PRESCRIBING^y
"KRN",19,11070,1,0)
^19.06^1^1^3120519^^^^
"KRN",19,11070,1,1,0)
This menu contains all options related to e-Prescribing (namespace C0P).
"KRN",19,11070,10,0)
^19.01IP^11^11
"KRN",19,11070,10,2,0)
10998^3^3
"KRN",19,11070,10,2,"^")
C0P SUBSCRIBER EDIT
"KRN",19,11070,10,4,0)
10999^^10
"KRN",19,11070,10,4,"^")
C0P SUBSCRIBER STATUS INQUIRE
"KRN",19,11070,10,5,0)
11001^2^2
"KRN",19,11070,10,5,"^")
C0P LOCATION EDIT
"KRN",19,11070,10,8,0)
11071^4^4
"KRN",19,11070,10,8,"^")
C0P SUPERVISING DOCTOR EDIT
"KRN",19,11070,10,9,0)
11007^^99
"KRN",19,11070,10,9,"^")
C0P MAPPING MENU
"KRN",19,11070,10,10,0)
11000^1^1
"KRN",19,11070,10,10,"^")
C0P ACCOUNT EDIT
"KRN",19,11070,10,11,0)
11072^^15
"KRN",19,11070,10,11,"^")
C0P SET-UP HELP
"KRN",19,11070,99)
62587,63600
"KRN",19,11070,"U")
E-PRESCRIPTION MENU
"KRN",19,11071,-1)
0^16
"KRN",19,11071,0)
C0P SUPERVISING DOCTOR EDIT^Supervising Doctor Enter/Edit^^E^^^^^^^^ORO ERX E-PRESCRIBING
"KRN",19,11071,1,0)
^^2^2^3120519^
"KRN",19,11071,1,1,0)
For Midlevel providers needing an entry of a Supervising Doctor, this is 
"KRN",19,11071,1,2,0)
where you enter the supervising doctor.
"KRN",19,11071,30)
VA(200,
"KRN",19,11071,31)
AEMQ
"KRN",19,11071,50)
VA(200,
"KRN",19,11071,51)
[C0P SUPERVISING DOCTOR]
"KRN",19,11071,"U")
SUPERVISING DOCTOR ENTER/EDIT
"KRN",19,11072,-1)
0^17
"KRN",19,11072,0)
C0P SET-UP HELP^Set-Up Help^^A^^^^^^^^ORO ERX E-PRESCRIBING^^1
"KRN",19,11072,1,0)
^^2^2^3120519^
"KRN",19,11072,1,1,0)
This option invokes a Help Frame to provide help for users setting up the 
"KRN",19,11072,1,2,0)
package.
"KRN",19,11072,20)
S XQH="C0P SETUP HELP" D EN^XQH
"KRN",19,11072,"U")
SET-UP HELP
"KRN",19,11073,-1)
1^6
"KRN",19,11073,0)
C0P LIST SUBSCRIBERS
"KRN",19,11074,-1)
1^8
"KRN",19,11074,0)
C0P MAIN
"KRN",19,11075,-1)
1^12
"KRN",19,11075,0)
C0P SUPERVISING DOCTOR
"KRN",19.1,483,-1)
0^2
"KRN",19.1,483,0)
C0PZMENU^ERX Main Menu Key
"KRN",19.1,483,1,0)
^^1^1^3120518^
"KRN",19.1,483,1,1,0)
This key protects the main eRx menu.
"KRN",19.1,484,-1)
0^1
"KRN",19.1,484,0)
C0PZMGR^ERX Manager Key
"KRN",19.1,484,1,0)
^^1^1^3120518^
"KRN",19.1,484,1,1,0)
This key protects configuration options in the eRx Package.
"KRN",8994,349,-1)
0^5
"KRN",8994,349,0)
ORWPS DETAIL^DETAIL^C0PWPS^4^^^^1
"KRN",8994,349,1,0)
^8994.01^1^1^3000105^
"KRN",8994,349,1,1,0)
Returns text of details for a specific mediction order.
"KRN",8994,538,-1)
0^4
"KRN",8994,538,0)
ORWPS COVER^COVER3^C0PWPS^2
"KRN",8994,538,1,0)
^8994.01^2^2^3120110^^
"KRN",8994,538,1,1,0)
Returns a list of medications to display on the CPRS GUI cover sheet for a
"KRN",8994,538,1,2,0)
patient.
"KRN",8994,2413,-1)
0^1
"KRN",8994,2413,0)
C0P ERX ORDER RPC^ERXRPC^C0PCPRS1^2
"KRN",8994,2413,2,0)
^8994.02A^2^2
"KRN",8994,2413,2,1,0)
DUZ^1^30^1^1
"KRN",8994,2413,2,2,0)
DFN^1^30^1^2
"KRN",8994,2413,2,"B","DFN",2)

"KRN",8994,2413,2,"B","DUZ",1)

"KRN",8994,2413,2,"PARAMSEQ",1,1)

"KRN",8994,2413,2,"PARAMSEQ",2,2)

"KRN",8994,2414,-1)
0^2
"KRN",8994,2414,0)
C0P ERX PULLBACK^ERXPULL^C0PCPRS1^2
"KRN",8994,2414,2,0)
^8994.02A^3^2
"KRN",8994,2414,2,2,0)
DUZ^1^20^1^1
"KRN",8994,2414,2,3,0)
DFN^1^20^1^2
"KRN",8994,2414,2,"B","DFN",3)

"KRN",8994,2414,2,"B","DUZ",2)

"KRN",8994,2414,2,"PARAMSEQ",1,2)

"KRN",8994,2414,2,"PARAMSEQ",2,3)

"KRN",8994,2415,-1)
0^3
"KRN",8994,2415,0)
C0P ERX ALERT RPC^ALERTRPC^C0PCPRS1^2
"KRN",8994,2415,2,0)
^8994.02A^4^4
"KRN",8994,2415,2,1,0)
DUZ^1^20^1^1
"KRN",8994,2415,2,2,0)
DFN^1^20^1^2
"KRN",8994,2415,2,3,0)
DEST^1^10^1^3
"KRN",8994,2415,2,4,0)
RECORDID^1^100^1^4
"KRN",8994,2415,2,"B","DEST",3)

"KRN",8994,2415,2,"B","DFN",2)

"KRN",8994,2415,2,"B","DUZ",1)

"KRN",8994,2415,2,"B","RECORDID",4)

"KRN",8994,2415,2,"PARAMSEQ",1,1)

"KRN",8994,2415,2,"PARAMSEQ",2,2)

"KRN",8994,2415,2,"PARAMSEQ",3,3)

"KRN",8994,2415,2,"PARAMSEQ",4,4)

"MBREQ")
0
"ORD",0,9.8)
9.8;;1;RTNF^XPDTA;RTNE^XPDTA
"ORD",0,9.8,0)
ROUTINE
"ORD",1,9.2)
9.2;1;;;HELP^XPDTA1;HLPF1^XPDIA1;HLPE1^XPDIA1;HLPF2^XPDIA1;;HLPDEL^XPDIA1
"ORD",1,9.2,0)
HELP FRAME
"ORD",2,3.6)
3.6;2;1;;BUL^XPDTA1;;BULE1^XPDIA1;;;BULDEL^XPDIA1
"ORD",2,3.6,0)
BULLETIN
"ORD",3,19.1)
19.1;3;;;KEY^XPDTA1;KEYF1^XPDIA1;KEYE1^XPDIA1;KEYF2^XPDIA1;;KEYDEL^XPDIA1
"ORD",3,19.1,0)
SECURITY KEY
"ORD",5,.4)
.4;5;;;EDEOUT^DIFROMSO(.4,DA,"",XPDA);FPRE^DIFROMSI(.4,"",XPDA);EPRE^DIFROMSI(.4,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.4,DA,"",XPDA);DEL^DIFROMSK(.4,"",%)
"ORD",5,.4,0)
PRINT TEMPLATE
"ORD",6,.401)
.401;6;;;EDEOUT^DIFROMSO(.401,DA,"",XPDA);FPRE^DIFROMSI(.401,"",XPDA);EPRE^DIFROMSI(.401,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.401,DA,"",XPDA);DEL^DIFROMSK(.401,"",%)
"ORD",6,.401,0)
SORT TEMPLATE
"ORD",7,.402)
.402;7;;;EDEOUT^DIFROMSO(.402,DA,"",XPDA);FPRE^DIFROMSI(.402,"",XPDA);EPRE^DIFROMSI(.402,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.402,DA,"",XPDA);DEL^DIFROMSK(.402,"",%)
"ORD",7,.402,0)
INPUT TEMPLATE
"ORD",8,.403)
.403;8;;;EDEOUT^DIFROMSO(.403,DA,"",XPDA);FPRE^DIFROMSI(.403,"",XPDA);EPRE^DIFROMSI(.403,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.403,DA,"",XPDA);DEL^DIFROMSK(.403,"",%)
"ORD",8,.403,0)
FORM
"ORD",11,3.8)
3.8;11;;;MAILG^XPDTA1;MAILGF1^XPDIA1;MAILGE1^XPDIA1;MAILGF2^XPDIA1;;MAILGDEL^XPDIA1(%)
"ORD",11,3.8,0)
MAIL GROUP
"ORD",16,8994)
8994;16;1;;;;;;;RPCDEL^XPDIA1
"ORD",16,8994,0)
REMOTE PROCEDURE
"ORD",18,19)
19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA
"ORD",18,19,0)
OPTION
"PKG",211,-1)
1^1
"PKG",211,0)
ORO ERX E-PRESCRIBING^C0P^Oroville Electronic Prescriptions
"PKG",211,20,0)
^9.402P^^
"PKG",211,22,0)
^9.49I^1^1
"PKG",211,22,1,0)
1.0^3120613^3120510^8
"PKG",211,22,1,1,0)
^^33^33^3120613
"PKG",211,22,1,1,1,0)
Written on April 25th 2012.
"PKG",211,22,1,1,2,0)
 
"PKG",211,22,1,1,3,0)
Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"PKG",211,22,1,1,4,0)
General Public License See attached copy of the License.
"PKG",211,22,1,1,5,0)
 
"PKG",211,22,1,1,6,0)
This program is free software; you can redistribute it and/or modify
"PKG",211,22,1,1,7,0)
it under the terms of the GNU General Public License as published by
"PKG",211,22,1,1,8,0)
the Free Software Foundation; either version 2 of the License, or
"PKG",211,22,1,1,9,0)
(at your option) any later version.
"PKG",211,22,1,1,10,0)
 
"PKG",211,22,1,1,11,0)
This program is distributed in the hope that it will be useful,
"PKG",211,22,1,1,12,0)
but WITHOUT ANY WARRANTY; without even the implied warranty of
"PKG",211,22,1,1,13,0)
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"PKG",211,22,1,1,14,0)
GNU General Public License for more details.
"PKG",211,22,1,1,15,0)
 
"PKG",211,22,1,1,16,0)
You should have received a copy of the GNU General Public License along
"PKG",211,22,1,1,17,0)
with this program; if not, write to the Free Software Foundation, Inc.,
"PKG",211,22,1,1,18,0)
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
"PKG",211,22,1,1,19,0)
 
"PKG",211,22,1,1,20,0)
This is the 1.0 release of the Oroville e-Prescribing Package.
"PKG",211,22,1,1,21,0)
 
"PKG",211,22,1,1,22,0)
This package works as a web service communication framework to New Crop 
"PKG",211,22,1,1,23,0)
(http://www.newcroprx.com/) to send and receive drug data.
"PKG",211,22,1,1,24,0)
 
"PKG",211,22,1,1,25,0)
It depends on the following packages/installations:
"PKG",211,22,1,1,26,0)
- EWD (for Web Services communication in Mumps)
"PKG",211,22,1,1,27,0)
- C0C (CCR/CCD Extraction, for metadata purposes)
"PKG",211,22,1,1,28,0)
 
"PKG",211,22,1,1,29,0)
Other KIDS files may be supplied to make this work if they not part of
"PKG",211,22,1,1,30,0)
this package:
"PKG",211,22,1,1,31,0)
- New Crop Web Services Data
"PKG",211,22,1,1,32,0)
- RxNorm Full Concepts File for E-Rx
"PKG",211,22,1,1,33,0)
- First DataBank Drugs and Allergies
"PKG",211,"VERSION")
1.0
"PRE")
C0PKIDS
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
NO
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"RTN")
26
"RTN","C0PALGY1")
0^15^B19614280
"RTN","C0PALGY1",1,0)
C0PALGY1   ; ERX/GPL/SMH - eRx Allergy utilities ; 5/8/12 11:52pm
"RTN","C0PALGY1",2,0)
 ;;1.0;C0P;;Apr 25, 2012;Build 103
"RTN","C0PALGY1",3,0)
 ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"RTN","C0PALGY1",4,0)
 ;General Public License See attached copy of the License.
"RTN","C0PALGY1",5,0)
 ;
"RTN","C0PALGY1",6,0)
 ;This program is free software; you can redistribute it and/or modify
"RTN","C0PALGY1",7,0)
 ;it under the terms of the GNU General Public License as published by
"RTN","C0PALGY1",8,0)
 ;the Free Software Foundation; either version 2 of the License, or
"RTN","C0PALGY1",9,0)
 ;(at your option) any later version.
"RTN","C0PALGY1",10,0)
 ;
"RTN","C0PALGY1",11,0)
 ;This program is distributed in the hope that it will be useful,
"RTN","C0PALGY1",12,0)
 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0PALGY1",13,0)
 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"RTN","C0PALGY1",14,0)
 ;GNU General Public License for more details.
"RTN","C0PALGY1",15,0)
 ;
"RTN","C0PALGY1",16,0)
 ;You should have received a copy of the GNU General Public License along
"RTN","C0PALGY1",17,0)
 ;with this program; if not, write to the Free Software Foundation, Inc.,
"RTN","C0PALGY1",18,0)
 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
"RTN","C0PALGY1",19,0)
 ;
"RTN","C0PALGY1",20,0)
 Q
"RTN","C0PALGY1",21,0)
GETRXNS(C0PDUZ,C0PDFN,ZRTN) ; Public Procedure
"RTN","C0PALGY1",22,0)
 ; Retrieve allergies from WebService, and store in VistA
"RTN","C0PALGY1",23,0)
 ; ART APIs will automatically not file an allergy if it is a duplicate
"RTN","C0PALGY1",24,0)
 ; Also, marking pt as NKA won't work if pt already has allergy in VistA
"RTN","C0PALGY1",25,0)
 ; That's why there is no check for duplicates in this code
"RTN","C0PALGY1",26,0)
 ; Input:
"RTN","C0PALGY1",27,0)
 ; - C0PDUZ: DUZ, By Value
"RTN","C0PALGY1",28,0)
 ; - C0PDFN: DFN, By Value
"RTN","C0PALGY1",29,0)
 ;
"RTN","C0PALGY1",30,0)
 N C0PWSRXNS
"RTN","C0PALGY1",31,0)
 D SOAP^C0PWS1("C0PWSRXNS","GETALLERGIES",C0PDUZ,C0PDFN)
"RTN","C0PALGY1",32,0)
 N C0PI
"RTN","C0PALGY1",33,0)
 F C0PI=1:1:C0PWSRXNS(1,"RowCount") DO
"RTN","C0PALGY1",34,0)
 . N RXN M RXN=C0PWSRXNS(C0PI)
"RTN","C0PALGY1",35,0)
 . ; For certain food allergies, CompositeID is not returned
"RTN","C0PALGY1",36,0)
 . I '$D(RXN("CompositeID")) S RXN("CompositeID")="" ; prevent undef crash
"RTN","C0PALGY1",37,0)
 . I RXN("CompositeID")=11623 QUIT  ; Code for 'No Allergy Information'
"RTN","C0PALGY1",38,0)
 . I (RXN("CompositeID")=231)!(RXN("CompositeID")=232)!(RXN("CompositeID")=14278)!(RXN("CompositeID")=14279) D  QUIT
"RTN","C0PALGY1",39,0)
 . . N ORDFN S ORDFN=C0PDFN  ; Apparently the 'API' uses CPRS variables
"RTN","C0PALGY1",40,0)
 . . D NKA^GMRAGUI1  ; Codes for NKA
"RTN","C0PALGY1",41,0)
 . D FILE(.RXN,C0PDUZ,C0PDFN)
"RTN","C0PALGY1",42,0)
 QUIT  ; /GETRXNS
"RTN","C0PALGY1",43,0)
 ;
"RTN","C0PALGY1",44,0)
FILE(RXN,C0PDUZ,C0PDFN) ; Private Proc - File Drug Reaction
"RTN","C0PALGY1",45,0)
 ; Input: 
"RTN","C0PALGY1",46,0)
 ; - RXN: Merged WS ADR, by Reference
"RTN","C0PALGY1",47,0)
 ; - C0PDUZ: DUZ, By Value
"RTN","C0PALGY1",48,0)
 ; - C0PDFN: DFN, By Value
"RTN","C0PALGY1",49,0)
 ; ConceptTypeIDs: 6 = Generic Name; 2 = Brand Name; 1 = Drug Class
"RTN","C0PALGY1",50,0)
 N C0PRXN
"RTN","C0PALGY1",51,0)
 S:RXN("ConceptTypeID")=6 C0PRXN("GMRAGNT")=$$BASE(RXN("ConceptID"))
"RTN","C0PALGY1",52,0)
 S:RXN("ConceptTypeID")=2 C0PRXN("GMRAGNT")=$$NAME($$UP^XLFSTR(RXN("Name")))
"RTN","C0PALGY1",53,0)
 S:RXN("ConceptTypeID")=1 C0PRXN("GMRAGNT")=$$GROUP(RXN("ConceptID"))
"RTN","C0PALGY1",54,0)
 ; Try a free text match on 120.82 (GMRA ALLERGIES) to see if there is a
"RTN","C0PALGY1",55,0)
 ; match on a food allergy (ConceptTypeID 9 [free txt] or 10 [other allergies])
"RTN","C0PALGY1",56,0)
 IF $G(C0PRXN("GMRAGNT"))="" D  ; need to handle type 9 or 10 .. gpl
"RTN","C0PALGY1",57,0)
 . S C0PRXN("GMRAGNT")=$$GMRA($$UP^XLFSTR(RXN("Name")))
"RTN","C0PALGY1",58,0)
 IF C0PRXN("GMRAGNT")="" DO  QUIT  ; Agent not found in VistA; TODO mail msg
"RTN","C0PALGY1",59,0)
 . N ZT ; TEXT TO DISPLAY AS ERROR MESSAGE
"RTN","C0PALGY1",60,0)
 . S ZT="Error Mapping Allergy ConceptID: "_$G(RXN("ConceptID"))
"RTN","C0PALGY1",61,0)
 . D MAPERR^C0PRECON(.ZRTN,"Allergy",ZT) ;DISPLAY ERROR
"RTN","C0PALGY1",62,0)
 S C0PRXN("GMRATYPE")=$$TYPE(C0PRXN("GMRAGNT"))
"RTN","C0PALGY1",63,0)
 S C0PRXN("GMRANATR")="U^Unknown"
"RTN","C0PALGY1",64,0)
 S C0PRXN("GMRAORIG")=C0PDUZ
"RTN","C0PALGY1",65,0)
 S C0PRXN("GMRACHT",0)=1
"RTN","C0PALGY1",66,0)
 S C0PRXN("GMRACHT",1)=$$NOW^XLFDT
"RTN","C0PALGY1",67,0)
 S C0PRXN("GMRAORDT")=$$NOW^XLFDT
"RTN","C0PALGY1",68,0)
 S C0PRXN("GMRAOBHX")="h^HISTORICAL"
"RTN","C0PALGY1",69,0)
 I $D(RXN("Notes")) D
"RTN","C0PALGY1",70,0)
 . S C0PRXN("GMRACMTS",0)=1
"RTN","C0PALGY1",71,0)
 . S C0PRXN("GMRACMTS",1)=RXN("Notes")
"RTN","C0PALGY1",72,0)
 D UPDATE^GMRAGUI1("",C0PDFN,"C0PRXN")
"RTN","C0PALGY1",73,0)
 I $G(^TMP("C0PDEBUG"))="" Q  ; ONLY SHOW ALLERGY MESSAGES IN DEBUG
"RTN","C0PALGY1",74,0)
 I $P(ORY,U,1)<0 D MAPERR^C0PRECON(.ZRTN,"Allergies",ORY) ;ERROR MESSAGE
"RTN","C0PALGY1",75,0)
 QUIT
"RTN","C0PALGY1",76,0)
 ;
"RTN","C0PALGY1",77,0)
BASE(ID) ; $$ Private - Retrieve GMRAGNT for Generic Name ConceptID
"RTN","C0PALGY1",78,0)
 ; Input: ID, By Value
"RTN","C0PALGY1",79,0)
 ; Output: Ingreident Name^IEN;File Root for IEN
"RTN","C0PALGY1",80,0)
 ; First, match drug to VistA, Look in VA GENERIC first
"RTN","C0PALGY1",81,0)
 N VAGEN S VAGEN=$$VAGEN2^C0PLKUP(ID)
"RTN","C0PALGY1",82,0)
 ; if no match, look in DRUG INGREDIENT
"RTN","C0PALGY1",83,0)
 N DRUGING S DRUGING=""
"RTN","C0PALGY1",84,0)
 I '+VAGEN S DRUGING=$$DRUGING2^C0PLKUP(ID)
"RTN","C0PALGY1",85,0)
 Q:+VAGEN $P(VAGEN,U,2)_U_$P(VAGEN,U)_";PSNDF(50.6,"
"RTN","C0PALGY1",86,0)
 Q:+DRUGING $P(DRUGING,U,2)_U_$P(DRUGING,U)_";PS(50.416,"
"RTN","C0PALGY1",87,0)
 QUIT "" ; TODO: Notify somebody that no match found
"RTN","C0PALGY1",88,0)
 ;
"RTN","C0PALGY1",89,0)
NAME(BRAND)  ; $$ Private - Retrieve GMRAGNT for Brand Name
"RTN","C0PALGY1",90,0)
 ; Input: Brand Name, By Value
"RTN","C0PALGY1",91,0)
 ; Output: Ingreident Name^IEN;File Root for IEN
"RTN","C0PALGY1",92,0)
 N C0POUT,C0PMATCH  ; output variable, # of matches
"RTN","C0PALGY1",93,0)
 S C0PMATCH=$$TGTOG2^PSNAPIS(BRAND,.C0POUT)
"RTN","C0PALGY1",94,0)
 ; Output for C0POUT:
"RTN","C0PALGY1",95,0)
 ; C0POUT(24)="24^VANCOMYCIN"
"RTN","C0PALGY1",96,0)
 ; 24 is IEN of drug in VA GENERIC file
"RTN","C0PALGY1",97,0)
 Q:C0PMATCH $P(@$Q(C0POUT),U,2)_U_$P(@$Q(C0POUT),U)_";PSNDF(50.6,"
"RTN","C0PALGY1",98,0)
 Q "" ; otherwise quit with nothing
"RTN","C0PALGY1",99,0)
 ;
"RTN","C0PALGY1",100,0)
GROUP(ID) ; Private Proc - Store drug class allergy
"RTN","C0PALGY1",101,0)
 QUIT "" ; not implemented
"RTN","C0PALGY1",102,0)
GMRA(NAME) ; $$ Private - Retrieve GMRAGNT for food allergy from 120.82
"RTN","C0PALGY1",103,0)
 ; Input: Brand Name, By Value
"RTN","C0PALGY1",104,0)
 ; Output: Entry Name^IEN;File Root for IEN
"RTN","C0PALGY1",105,0)
 N C0PIEN S C0PIEN=$$FIND1^DIC(120.82,"","O",NAME,"B")
"RTN","C0PALGY1",106,0)
 Q:C0PIEN $$GET1^DIQ(120.82,C0PIEN,.01)_"^"_C0PIEN_";GMRD(120.82,"
"RTN","C0PALGY1",107,0)
 QUIT "" ; no match otherwise
"RTN","C0PALGY1",108,0)
TYPE(GMRAGNT) ; $$ Private - Get allergy Type (Drug, food, or other)
"RTN","C0PALGY1",109,0)
 ; Input: Allergen, formatted as Allergen^IEN;File Root
"RTN","C0PALGY1",110,0)
 ; Output: Type (internal)^Type (external) e.g. D^Drug
"RTN","C0PALGY1",111,0)
 N C0PIEN S C0PIEN=+$P(GMRAGNT,U,2)
"RTN","C0PALGY1",112,0)
 I GMRAGNT["GMRD(120.82," Q $$GET1^DIQ(120.82,C0PIEN,"ALLERGY TYPE","I")_U_$$GET1^DIQ(120.82,C0PIEN,"ALLERGY TYPE","E")
"RTN","C0PALGY1",113,0)
 Q "D^Drug" ; otherwise, it's a drug
"RTN","C0PALGY1",114,0)
ACCOUNTF()  Q 113059002  ; file number for account file
"RTN","C0PALGY1",115,0)
F200C0P() Q 200.113059 ; Subfile number of C0P Subscription Multiple
"RTN","C0PALGY1",116,0)
 ;
"RTN","C0PALGY2")
0^16^B75872153
"RTN","C0PALGY2",1,0)
C0PALGY2   ; ERX/GPL/SMH - eRx Allergy utilities ; 5/8/12 11:52pm
"RTN","C0PALGY2",2,0)
 ;;1.0;C0P;;Apr 25, 2012;Build 103
"RTN","C0PALGY2",3,0)
 ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"RTN","C0PALGY2",4,0)
 ;General Public License See attached copy of the License.
"RTN","C0PALGY2",5,0)
 ;
"RTN","C0PALGY2",6,0)
 ;This program is free software; you can redistribute it and/or modify
"RTN","C0PALGY2",7,0)
 ;it under the terms of the GNU General Public License as published by
"RTN","C0PALGY2",8,0)
 ;the Free Software Foundation; either version 2 of the License, or
"RTN","C0PALGY2",9,0)
 ;(at your option) any later version.
"RTN","C0PALGY2",10,0)
 ;
"RTN","C0PALGY2",11,0)
 ;This program is distributed in the hope that it will be useful,
"RTN","C0PALGY2",12,0)
 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0PALGY2",13,0)
 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"RTN","C0PALGY2",14,0)
 ;GNU General Public License for more details.
"RTN","C0PALGY2",15,0)
 ;
"RTN","C0PALGY2",16,0)
 ;You should have received a copy of the GNU General Public License along
"RTN","C0PALGY2",17,0)
 ;with this program; if not, write to the Free Software Foundation, Inc.,
"RTN","C0PALGY2",18,0)
 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
"RTN","C0PALGY2",19,0)
 ;
"RTN","C0PALGY2",20,0)
 Q
"RTN","C0PALGY2",21,0)
 ;
"RTN","C0PALGY2",22,0)
 ; THESE ROUTINES ARE USED TO TEST AND VALIDATE THE USE OF THE RXNORM
"RTN","C0PALGY2",23,0)
 ; DATABASE FOR LOOKING UP IDS AND MATCHING FIRST DATA BANK IDS TO 
"RTN","C0PALGY2",24,0)
 ; RXNORM CONCEPT IDS AND THEN FROM RXNORM CONCEPT IDS TO VISTA VUIDS
"RTN","C0PALGY2",25,0)
 ; THE PARTICULAR INTEREST HERE IS FOR MATCHING ALLERGIES TO A MEDICATION
"RTN","C0PALGY2",26,0)
 ; IN ADDITION THERE ARE ROUTINES HERE TO POPULATE THE C0P FDB ALLERGIES
"RTN","C0PALGY2",27,0)
 ; FILE.
"RTN","C0PALGY2",28,0)
 ; NONE OF THESE ROUTINES ARE USED IN REGULAR ERX ACTIVITIES. THEY
"RTN","C0PALGY2",29,0)
 ; ARE BROUGHT FORWARD AS PART OF THE ERX PACKAGE FOR DEBUGGING AND 
"RTN","C0PALGY2",30,0)
 ; FUTURE DEVELOPMENT
"RTN","C0PALGY2",31,0)
 ; GPL JUN 2010
"RTN","C0PALGY2",32,0)
TESTBASE ; TEST LOOKING UP CONCEPT IDS IN RXNORM
"RTN","C0PALGY2",33,0)
 ;
"RTN","C0PALGY2",34,0)
 N ZI
"RTN","C0PALGY2",35,0)
 S ZI=""
"RTN","C0PALGY2",36,0)
 S (COUNT,FOUND)=0
"RTN","C0PALGY2",37,0)
 F  S ZI=$O(^C0PALGY("TYPE","BASE",ZI)) Q:ZI=""  D  ; FOR EACH BASE CONCEPT
"RTN","C0PALGY2",38,0)
 . S COUNT=COUNT+1
"RTN","C0PALGY2",39,0)
 . S ZJ=$$GET1^DIQ(113059005,ZI_",",1,"E")
"RTN","C0PALGY2",40,0)
 . S ZN=$$GET1^DIQ(113059005,ZI_",",.01,"E")
"RTN","C0PALGY2",41,0)
 . S ZV=$$BASE^C0PALGY1(ZJ) ;LOOKUP VISTA MATCH
"RTN","C0PALGY2",42,0)
 . I ZV'="" S FOUND=FOUND+1
"RTN","C0PALGY2",43,0)
 . W !,ZJ," ",ZN," :: ",ZV
"RTN","C0PALGY2",44,0)
 W !,"COUNT:",COUNT," FOUND:",FOUND
"RTN","C0PALGY2",45,0)
 Q
"RTN","C0PALGY2",46,0)
 ;
"RTN","C0PALGY2",47,0)
TESTNAME ; TEST LOOKING UP CONCEPT IDS IN RXNORM
"RTN","C0PALGY2",48,0)
 ;
"RTN","C0PALGY2",49,0)
 N ZI
"RTN","C0PALGY2",50,0)
 S ZI=""
"RTN","C0PALGY2",51,0)
 S (COUNT,FOUND)=0
"RTN","C0PALGY2",52,0)
 F  S ZI=$O(^C0PALGY("TYPE","NAME",ZI)) Q:ZI=""  D  ; FOR EACH BASE CONCEPT
"RTN","C0PALGY2",53,0)
 . S COUNT=COUNT+1
"RTN","C0PALGY2",54,0)
 . S ZJ=$$GET1^DIQ(113059005,ZI_",",1,"E")
"RTN","C0PALGY2",55,0)
 . S ZN=$$GET1^DIQ(113059005,ZI_",",.01,"E")
"RTN","C0PALGY2",56,0)
 . S ZV=$$NAME^C0PALGY1($$UP^XLFSTR(ZN)) ;LOOKUP VISTA MATCH
"RTN","C0PALGY2",57,0)
 . I ZV'="" S FOUND=FOUND+1
"RTN","C0PALGY2",58,0)
 . W !,ZJ," ",ZN," :: ",ZV
"RTN","C0PALGY2",59,0)
 W !,"COUNT:",COUNT," FOUND:",FOUND
"RTN","C0PALGY2",60,0)
 Q
"RTN","C0PALGY2",61,0)
 ;
"RTN","C0PALGY2",62,0)
TEST3 ;
"RTN","C0PALGY2",63,0)
 ;
"RTN","C0PALGY2",64,0)
 S ZI=0
"RTN","C0PALGY2",65,0)
 S (COUNT,FOUND)=0
"RTN","C0PALGY2",66,0)
 F  S ZI=$O(^PSNDF(50.6,ZI)) Q:+ZI=0  D  ; FOR EVERY DRUG IN THE NDF
"RTN","C0PALGY2",67,0)
 . S COUNT=COUNT+1
"RTN","C0PALGY2",68,0)
 . S ZJ=$G(^PSNDF(50.6,ZI,"VUID")) ;VUID
"RTN","C0PALGY2",69,0)
 . S ZJ=$P(ZJ,"^",1) ;JUST THE FIRST PIECE
"RTN","C0PALGY2",70,0)
 . S ZJN=$G(^PSNDF(50.6,ZI,0)) ; VA NAME
"RTN","C0PALGY2",71,0)
 . W !,ZJN," ",ZJ
"RTN","C0PALGY2",72,0)
 . S ZK=$$NDDFBAS2^C0PLKUP(ZJ)
"RTN","C0PALGY2",73,0)
 . I ZK'=0 D  ; FDB CONCEPT ID FOUND
"RTN","C0PALGY2",74,0)
 . . S ZL=$O(^C0PALGY("C2","BASE",ZK,""))
"RTN","C0PALGY2",75,0)
 . . S ZN=$$GET1^DIQ(113059005,ZL_",",.01,"E")
"RTN","C0PALGY2",76,0)
 . . I ZN'="" D  ;
"RTN","C0PALGY2",77,0)
 . . . S FOUND=FOUND+1
"RTN","C0PALGY2",78,0)
 . . . S ZP=ZI_";PSNDF(50.6,"
"RTN","C0PALGY2",79,0)
 . . . S C0PFDA(113059005,ZL_",",6)=ZP
"RTN","C0PALGY2",80,0)
 . . . D UPDIE
"RTN","C0PALGY2",81,0)
 . . W $C(9),ZI," ",ZJ," :: ",ZK," ",ZN
"RTN","C0PALGY2",82,0)
 W !,"COUNT:",COUNT," FOUND:",FOUND
"RTN","C0PALGY2",83,0)
 Q
"RTN","C0PALGY2",84,0)
 ;
"RTN","C0PALGY2",85,0)
TEST4 ;
"RTN","C0PALGY2",86,0)
 ;
"RTN","C0PALGY2",87,0)
 S ZI=0
"RTN","C0PALGY2",88,0)
 S (COUNT,FOUND)=0
"RTN","C0PALGY2",89,0)
 F  S ZI=$O(^PS(50.416,ZI)) Q:+ZI=0  D  ; DRUG INGREDIENTS FILE 
"RTN","C0PALGY2",90,0)
 . S COUNT=COUNT+1
"RTN","C0PALGY2",91,0)
 . S ZJ=$G(^PS(50.416,ZI,"VUID")) ;VUID
"RTN","C0PALGY2",92,0)
 . S ZJ=$P(ZJ,"^",1) ;JUST THE FIRST PIECE
"RTN","C0PALGY2",93,0)
 . S ZJN=$G(^PS(50.416,ZI,0)) ; VA NAME
"RTN","C0PALGY2",94,0)
 . W !,ZJN," ",ZJ
"RTN","C0PALGY2",95,0)
 . S ZK=$$NDDFBAS2^C0PLKUP(ZJ)
"RTN","C0PALGY2",96,0)
 . ;I ZI=3912 B
"RTN","C0PALGY2",97,0)
 . I ZK'=0 D  ; FDB CONCEPT ID FOUND
"RTN","C0PALGY2",98,0)
 . . S ZL=$O(^C0PALGY("C2","BASE",ZK,""))
"RTN","C0PALGY2",99,0)
 . . S ZN=$$GET1^DIQ(113059005,ZL_",",.01,"E")
"RTN","C0PALGY2",100,0)
 . . I ZN'="" D  ;
"RTN","C0PALGY2",101,0)
 . . . S FOUND=FOUND+1
"RTN","C0PALGY2",102,0)
 . . . W $C(9),ZI," ",ZJ," :: ",ZK," ",ZN
"RTN","C0PALGY2",103,0)
 . . . S ZP=ZI_";PS(50.416,"
"RTN","C0PALGY2",104,0)
 . . . S C0PFDA(113059005,ZL_",",6)=ZP
"RTN","C0PALGY2",105,0)
 . . . D UPDIE
"RTN","C0PALGY2",106,0)
 W !,"COUNT:",COUNT," FOUND:",FOUND
"RTN","C0PALGY2",107,0)
 Q
"RTN","C0PALGY2",108,0)
 ;
"RTN","C0PALGY2",109,0)
TEST5 ; VA PRODUCT FILE
"RTN","C0PALGY2",110,0)
 ;
"RTN","C0PALGY2",111,0)
 S ZI=0
"RTN","C0PALGY2",112,0)
 S (COUNT,FOUND)=0
"RTN","C0PALGY2",113,0)
 F  S ZI=$O(^PSNDF(50.68,ZI)) Q:+ZI=0  D  ; FOR EVERY DRUG IN THE NDF
"RTN","C0PALGY2",114,0)
 . S COUNT=COUNT+1
"RTN","C0PALGY2",115,0)
 . S ZJ=$G(^PSNDF(50.68,ZI,"VUID")) ;VUID
"RTN","C0PALGY2",116,0)
 . S ZJ=$P(ZJ,"^",1) ;JUST THE FIRST PIECE
"RTN","C0PALGY2",117,0)
 . S ZJN=$G(^PSNDF(50.68,ZI,0)) ; VA NAME
"RTN","C0PALGY2",118,0)
 . ;W !,ZJN," ",ZJ
"RTN","C0PALGY2",119,0)
 . S ZK=$$NDDFBAS2^C0PLKUP(ZJ)
"RTN","C0PALGY2",120,0)
 . I ZK'=0 D  ; FDB CONCEPT ID FOUND
"RTN","C0PALGY2",121,0)
 . . S ZL=$O(^C0PALGY("C2","NAME",ZK,""))
"RTN","C0PALGY2",122,0)
 . . S ZN=$$GET1^DIQ(113059005,ZL_",",.01,"E")
"RTN","C0PALGY2",123,0)
 . . I ZN'="" D  ;
"RTN","C0PALGY2",124,0)
 . . . S FOUND=FOUND+1
"RTN","C0PALGY2",125,0)
 . . . S ZP=ZI_";PSNDF(50.68,"
"RTN","C0PALGY2",126,0)
 . . . S C0PFDA(113059005,ZL_",",6)=ZP
"RTN","C0PALGY2",127,0)
 . . . D UPDIE
"RTN","C0PALGY2",128,0)
 . . W !,ZJN," ",ZJ
"RTN","C0PALGY2",129,0)
 . . W $C(9),ZI," ",ZJ," :: ",ZK," ",ZN
"RTN","C0PALGY2",130,0)
 W !,"COUNT:",COUNT," FOUND:",FOUND
"RTN","C0PALGY2",131,0)
 Q
"RTN","C0PALGY2",132,0)
 ;
"RTN","C0PALGY2",133,0)
TEST6 ; CHECK ALL VUIDS IN VA PRODUCT FILE AGAINST RXNORM CONCEPT FILE
"RTN","C0PALGY2",134,0)
 ;
"RTN","C0PALGY2",135,0)
 S ZI=0
"RTN","C0PALGY2",136,0)
 S (COUNT,FOUND)=0
"RTN","C0PALGY2",137,0)
 F  S ZI=$O(^PSNDF(50.68,ZI)) Q:+ZI=0  D  ; FOR EVERY DRUG IN THE NDF
"RTN","C0PALGY2",138,0)
 . S COUNT=COUNT+1
"RTN","C0PALGY2",139,0)
 . S ZJ=$G(^PSNDF(50.68,ZI,"VUID")) ;VUID
"RTN","C0PALGY2",140,0)
 . S ZJ=$P(ZJ,"^",1) ;JUST THE FIRST PIECE
"RTN","C0PALGY2",141,0)
 . S ZJN=$G(^PSNDF(50.68,ZI,0)) ; VA NAME
"RTN","C0PALGY2",142,0)
 . ;W !,ZJN," ",ZJ
"RTN","C0PALGY2",143,0)
 . S ZRXN=$O(^C0P("RXN","VUID",ZJ,""))
"RTN","C0PALGY2",144,0)
 . I ZRXN'="" S FOUND=FOUND+1
"RTN","C0PALGY2",145,0)
 W !,"COUNT:",COUNT," FOUND:",FOUND
"RTN","C0PALGY2",146,0)
 Q
"RTN","C0PALGY2",147,0)
 ;
"RTN","C0PALGY2",148,0)
TEST7 ; CHECK ALL CONCEPT IDS IN THE FDB ALLERGY FILE AGAINST THE 
"RTN","C0PALGY2",149,0)
 ;RXNORM CONCEPT FILE - THIS APPOACH DOESN'T WORK.
"RTN","C0PALGY2",150,0)
 ;
"RTN","C0PALGY2",151,0)
 S ZI=0
"RTN","C0PALGY2",152,0)
 S (COUNT,FOUND)=0
"RTN","C0PALGY2",153,0)
 F  S ZI=$O(^C0PALGY("C",ZI)) Q:+ZI=0  D  ; EVERY FDB ALLERGY CONCEPT
"RTN","C0PALGY2",154,0)
 . S ZIN=$$GET1^DIQ(113059005,ZI_",",.01) ;NAME OF CONCEPT
"RTN","C0PALGY2",155,0)
 . S ZJ=$O(^C0P("RXN","B",ZI,"")) ; RXNORM CONCEPT FIELD IS .01
"RTN","C0PALGY2",156,0)
 . S COUNT=COUNT+1
"RTN","C0PALGY2",157,0)
 . I ZJ'="" D  ; FOUND
"RTN","C0PALGY2",158,0)
 . . S FOUND=FOUND+1
"RTN","C0PALGY2",159,0)
 . . S ZJN=$G(^C0P("RXN",ZJ,1,1,0)) ;NAME OF CONCEPT
"RTN","C0PALGY2",160,0)
 . . ;S ZJNNN=$$GET1^DIQ(1130590011.101,ZJ_",",,ZJN)
"RTN","C0PALGY2",161,0)
 . . I ZIN'="" W !,ZI,ZIN," :: ",ZJ," ",ZJN
"RTN","C0PALGY2",162,0)
 W !,"COUNT:",COUNT," FOUND:",FOUND
"RTN","C0PALGY2",163,0)
 Q
"RTN","C0PALGY2",164,0)
 ;
"RTN","C0PALGY2",165,0)
TESTC ; PRINT OUT DUPLICATES IN THE FROM THE C INDEX OF THE ALLERGY FILE
"RTN","C0PALGY2",166,0)
 ;
"RTN","C0PALGY2",167,0)
 S (COUNT,COUNT2)=0
"RTN","C0PALGY2",168,0)
 S ZI=""
"RTN","C0PALGY2",169,0)
 F  S ZI=$O(^C0PALGY("C",ZI)) Q:ZI=""  D  ;
"RTN","C0PALGY2",170,0)
 . S ZJ=$O(^C0PALGY("C",ZI,"")) ;IEN
"RTN","C0PALGY2",171,0)
 . I $O(^C0PALGY("C",ZI,ZJ))'="" D  ;
"RTN","C0PALGY2",172,0)
 . . S ZZ=""
"RTN","C0PALGY2",173,0)
 . . F  S ZZ=$O(^C0PALGY("C",ZI,ZZ)) Q:ZZ=""  D  ;
"RTN","C0PALGY2",174,0)
 . . . S COUNT=COUNT+1
"RTN","C0PALGY2",175,0)
 . . . S ZK=$$GET1^DIQ(113059005,ZZ_",",6)
"RTN","C0PALGY2",176,0)
 . . . S ZL=$$GET1^DIQ(113059005,ZZ_",",.01)
"RTN","C0PALGY2",177,0)
 . . . S ZT=$$GET1^DIQ(113059005,ZZ_",",2)
"RTN","C0PALGY2",178,0)
 . . . I ZK'="" S COUNT2=COUNT2+1
"RTN","C0PALGY2",179,0)
 . . . S DUPS(ZI,ZL,ZT)=ZK
"RTN","C0PALGY2",180,0)
 . . . W !,ZK," ",ZI
"RTN","C0PALGY2",181,0)
 Q
"RTN","C0PALGY2",182,0)
 ;
"RTN","C0PALGY2",183,0)
COUNT ; COUNT THE NUMBER OF MAPPINGS IN VA POINTER INDEX OF FDB ALLERGIES
"RTN","C0PALGY2",184,0)
 ;
"RTN","C0PALGY2",185,0)
 N ZI,ZJ,COUNT
"RTN","C0PALGY2",186,0)
 S COUNT=0
"RTN","C0PALGY2",187,0)
 S ZI="" S ZJ=""
"RTN","C0PALGY2",188,0)
 F  S ZI=$O(^C0PALGY("VA",ZI)) Q:ZI=""  D  ;
"RTN","C0PALGY2",189,0)
 . S ZJ=""
"RTN","C0PALGY2",190,0)
 . F  S ZJ=$O(^C0PALGY("VA",ZI,ZJ)) Q:ZJ=""  D  ;
"RTN","C0PALGY2",191,0)
 . . S COUNT=COUNT+1
"RTN","C0PALGY2",192,0)
 W !,"COUNT: ",COUNT,!
"RTN","C0PALGY2",193,0)
 Q
"RTN","C0PALGY2",194,0)
 ;
"RTN","C0PALGY2",195,0)
CHECK ; CHECK ALL ALLERGIES IN THE PATIENT ALLERGY FILE FOR MATCHES IN
"RTN","C0PALGY2",196,0)
 ; THE FDB ALLERGY FILE
"RTN","C0PALGY2",197,0)
 N ZI,ZJ,COUNT
"RTN","C0PALGY2",198,0)
 S (ZI,ZJ)=0 S COUNT=0 S COUNT2=0
"RTN","C0PALGY2",199,0)
 F  S ZI=$O(^GMR(120.8,ZI)) Q:+ZI=0  D  ; FOR EACH ENTRY
"RTN","C0PALGY2",200,0)
 . S ZJ=^GMR(120.8,ZI,0) ; ZERO NODE
"RTN","C0PALGY2",201,0)
 . S PAT=$P(ZJ,U,1) ;PATIENT
"RTN","C0PALGY2",202,0)
 . S ZN=$P(ZJ,U,2) ;REACTANT NAME
"RTN","C0PALGY2",203,0)
 . S GMR=$P(ZJ,U,3) ;POINTER
"RTN","C0PALGY2",204,0)
 . S COUNT=COUNT+1
"RTN","C0PALGY2",205,0)
 . S FOUND=$O(^C0PALGY("VA",GMR,"")) ; VA POINTER INDEX
"RTN","C0PALGY2",206,0)
 . S ZF=""
"RTN","C0PALGY2",207,0)
 . I FOUND'="" D  ;
"RTN","C0PALGY2",208,0)
 . . S COUNT2=COUNT2+1
"RTN","C0PALGY2",209,0)
 . . S ZF=$$GET1^DIQ(113059005,FOUND_",",.01,"E")
"RTN","C0PALGY2",210,0)
 . W !,"PAT:",PAT," ",ZN," ",GMR," :: ",FOUND," ",ZF
"RTN","C0PALGY2",211,0)
 W !,"COUNT:",COUNT," FOUND:",COUNT2
"RTN","C0PALGY2",212,0)
 Q
"RTN","C0PALGY2",213,0)
 ;
"RTN","C0PALGY2",214,0)
LOADRXN ; LOAD THE FDB TO RXNORM CSV FILE INTO ^TMP
"RTN","C0PALGY2",215,0)
 ; THE FILE NAME IS CompositeAllergyID2RxCui.csv
"RTN","C0PALGY2",216,0)
 ; AND IT IS STORED IN /home/dev
"RTN","C0PALGY2",217,0)
 N ZG
"RTN","C0PALGY2",218,0)
 S ZG=$NA(^TMP("C0PALGY","RXNCSV",1))
"RTN","C0PALGY2",219,0)
 W $$FTG^%ZISH("/home/dev/","CompositeAllergyID2RxCui.csv",ZG,3) ;INCREMENT
"RTN","C0PALGY2",220,0)
 ; 3rd NODE
"RTN","C0PALGY2",221,0)
 Q
"RTN","C0PALGY2",222,0)
 ;
"RTN","C0PALGY2",223,0)
ADDRXN ; ADD THE CompositeAllergyID to rxcui mapping to the 
"RTN","C0PALGY2",224,0)
 ; C0P FDB ALLERGY file
"RTN","C0PALGY2",225,0)
 ; the csv file with the mapping has been loaded into
"RTN","C0PALGY2",226,0)
 ; ^TMP("C0PALGY","RXNCSV") - see LOADRXN routine above
"RTN","C0PALGY2",227,0)
 N ZI,ZJ,ZARY,ZF,C0PFDA
"RTN","C0PALGY2",228,0)
 S ZF=113059005 ; FILE NUMBER FOR C0P FDB ALLERGY FILE
"RTN","C0PALGY2",229,0)
 S ZARY=$NA(^TMP("C0PALGY","RXNCSV"))
"RTN","C0PALGY2",230,0)
 S ZJ=$O(@ZARY@(""),-1) ; NUMBER OF ROWS IN THE ARRAY
"RTN","C0PALGY2",231,0)
 F ZI=2:1:ZJ D  ; SKIP ROW 1, WHICH HAS THE COLUMN NAMES
"RTN","C0PALGY2",232,0)
 . N ZFDA,ZRXN,ZROW
"RTN","C0PALGY2",233,0)
 . K C0PFDA
"RTN","C0PALGY2",234,0)
 . S ZROW=@ZARY@(ZI) ; EACH ROW IS ""X"",""Y""
"RTN","C0PALGY2",235,0)
 . S ZFDA=$P(ZROW,",",1) ; CompositeAllergyID
"RTN","C0PALGY2",236,0)
 . S ZFDA=$TR(ZFDA,"""") ; GET RID OF EXTRA QUOTES
"RTN","C0PALGY2",237,0)
 . S ZRXN=$P(ZROW,",",2) ; rxcui
"RTN","C0PALGY2",238,0)
 . S ZRXN=$TR(ZRXN,"""") ; GET RID OF EXTRA QUOTES 
"RTN","C0PALGY2",239,0)
 . W !,ZFDA," ",ZRXN
"RTN","C0PALGY2",240,0)
 . S ZOHONE=$$GET1^DIQ(ZF,ZFDA_",",.01)
"RTN","C0PALGY2",241,0)
 . S C0PFDA(ZF,ZFDA_",",.01)=ZOHONE
"RTN","C0PALGY2",242,0)
 . S C0PFDA(ZF,ZFDA_",",7)=ZRXN ; SET rxcui for ien ZFDA
"RTN","C0PALGY2",243,0)
 . D UPDIE
"RTN","C0PALGY2",244,0)
 Q
"RTN","C0PALGY2",245,0)
 ;
"RTN","C0PALGY2",246,0)
LOOKRXN ; LOOK UP RXCUI VALUES IN THE RXNORM CONCEPT FILE
"RTN","C0PALGY2",247,0)
 ;
"RTN","C0PALGY2",248,0)
 S COUNT=0 S FOUND=0
"RTN","C0PALGY2",249,0)
 S ZI=""
"RTN","C0PALGY2",250,0)
 F  S ZI=$O(^C0PALGY("RXCUI",ZI)) Q:ZI=""  D  ;
"RTN","C0PALGY2",251,0)
 . S COUNT=COUNT+1
"RTN","C0PALGY2",252,0)
 . S ZJ=$O(^C0P("RXN","B",ZI,"")) ;
"RTN","C0PALGY2",253,0)
 . W !,ZI," ",ZJ
"RTN","C0PALGY2",254,0)
 W !,COUNT," FOUND"
"RTN","C0PALGY2",255,0)
 Q
"RTN","C0PALGY2",256,0)
 ;
"RTN","C0PALGY2",257,0)
LOOKFDB ;LOOK UP FDB NUMBERS IN THE RXNORM FILE
"RTN","C0PALGY2",258,0)
 ;
"RTN","C0PALGY2",259,0)
 S ZI=""
"RTN","C0PALGY2",260,0)
 F  S ZI=$O(^C0PALGY("C",ZI)) Q:ZI=""  D  ;
"RTN","C0PALGY2",261,0)
 . S ZJ=$O(^C0PALGY("C",ZI,""))
"RTN","C0PALGY2",262,0)
 . W !,ZI," ",ZJ
"RTN","C0PALGY2",263,0)
 Q
"RTN","C0PALGY2",264,0)
 ;
"RTN","C0PALGY2",265,0)
MKRNF ; CREATING AN RNF FILE FOR THE FDB ALLERGY TABLE
"RTN","C0PALGY2",266,0)
 ;
"RTN","C0PALGY2",267,0)
 F ZI=1:1:999999 F ZJ=1:1:7 D  ;
"RTN","C0PALGY2",268,0)
 . I ZJ=1 S ^GRNF("V",ZI,$O(^GRNF("F",ZJ,"")))=ZI
"RTN","C0PALGY2",269,0)
 . S ZK=$P(^GPLFDB(ZI),""",""",ZJ)
"RTN","C0PALGY2",270,0)
 . S ZK=$TR(ZK,"""")
"RTN","C0PALGY2",271,0)
 . I ZJ=6  D  ;STATUS
"RTN","C0PALGY2",272,0)
 . . I (ZK'="A")&(ZK'="I") D ERROR^C0PMAIN(",U113059009,",$ST($ST,"PLACE"),"ERX-INVALID-DATA","Invalid Data") QUIT
"RTN","C0PALGY2",273,0)
 . I ZK'="" D  ;
"RTN","C0PALGY2",274,0)
 . . S ^GRNF("V",ZI,$O(^GRNF("F",ZJ,"")))=ZK
"RTN","C0PALGY2",275,0)
 Q
"RTN","C0PALGY2",276,0)
 ;
"RTN","C0PALGY2",277,0)
FILEFDB ;POPULATE C0P FDB ALLERGIES FROM RNF STRUCTURE IN ^GRNF
"RTN","C0PALGY2",278,0)
 ;
"RTN","C0PALGY2",279,0)
 F ZI=1:1:999999 D  ;
"RTN","C0PALGY2",280,0)
 . K C0PFDA
"RTN","C0PALGY2",281,0)
 . S C0PFDA(113059005,"?+1,",.01)=^GRNF("V",ZI,"Description")
"RTN","C0PALGY2",282,0)
 . S C0PFDA(113059005,"?+1,",.05)=$G(^GRNF("V",ZI,"CompositeAllergyID"))
"RTN","C0PALGY2",283,0)
 . S C0PFDA(113059005,"?+1,",1)=^GRNF("V",ZI,"ConceptID")
"RTN","C0PALGY2",284,0)
 . S C0PFDA(113059005,"?+1,",2)=^GRNF("V",ZI,"ConceptType")
"RTN","C0PALGY2",285,0)
 . S C0PFDA(113059005,"?+1,",3)=^GRNF("V",ZI,"Source")
"RTN","C0PALGY2",286,0)
 . S C0PFDA(113059005,"?+1,",4)=^GRNF("V",ZI,"Status")
"RTN","C0PALGY2",287,0)
 . S C0PFDA(113059005,"?+1,",5)=^GRNF("V",ZI,"TouchDate")
"RTN","C0PALGY2",288,0)
 . ;ZWR C0PFDA
"RTN","C0PALGY2",289,0)
 . ;B
"RTN","C0PALGY2",290,0)
 . D UPDIE
"RTN","C0PALGY2",291,0)
 Q
"RTN","C0PALGY2",292,0)
 ;
"RTN","C0PALGY2",293,0)
UPDIE   ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
"RTN","C0PALGY2",294,0)
 K ZERR
"RTN","C0PALGY2",295,0)
 D CLEAN^DILF
"RTN","C0PALGY2",296,0)
 D UPDATE^DIE("","C0PFDA","","ZERR")
"RTN","C0PALGY2",297,0)
 I $D(ZERR) D ERROR^C0PMAIN(",U113059008,",$ST($ST,"PLACE"),"ERX-UPDIE-FAIL","Fileman Data Update Failure") QUIT
"RTN","C0PALGY2",298,0)
 K C0PFDA
"RTN","C0PALGY2",299,0)
 Q
"RTN","C0PALGY3")
0^17^B13104079
"RTN","C0PALGY3",1,0)
C0PALGY3   ; ERX/GPL - eRx Allergy utilities ; 5/8/12 9:11pm
"RTN","C0PALGY3",2,0)
 ;;1.0;C0P;;Apr 25, 2012;Build 103
"RTN","C0PALGY3",3,0)
 ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"RTN","C0PALGY3",4,0)
 ;General Public License See attached copy of the License.
"RTN","C0PALGY3",5,0)
 ;
"RTN","C0PALGY3",6,0)
 ;This program is free software; you can redistribute it and/or modify
"RTN","C0PALGY3",7,0)
 ;it under the terms of the GNU General Public License as published by
"RTN","C0PALGY3",8,0)
 ;the Free Software Foundation; either version 2 of the License, or
"RTN","C0PALGY3",9,0)
 ;(at your option) any later version.
"RTN","C0PALGY3",10,0)
 ;
"RTN","C0PALGY3",11,0)
 ;This program is distributed in the hope that it will be useful,
"RTN","C0PALGY3",12,0)
 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0PALGY3",13,0)
 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"RTN","C0PALGY3",14,0)
 ;GNU General Public License for more details.
"RTN","C0PALGY3",15,0)
 ;
"RTN","C0PALGY3",16,0)
 ;You should have received a copy of the GNU General Public License along
"RTN","C0PALGY3",17,0)
 ;with this program; if not, write to the Free Software Foundation, Inc.,
"RTN","C0PALGY3",18,0)
 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
"RTN","C0PALGY3",19,0)
 ;
"RTN","C0PALGY3",20,0)
 Q
"RTN","C0PALGY3",21,0)
 ;
"RTN","C0PALGY3",22,0)
ADDALGY(RTNXML,ZDUZ,ZDFN,ZFILE) ; ADDS PATIENT ALLERGIES TO NCSCRIPT
"RTN","C0PALGY3",23,0)
 ; CLICK-THROUGH HTLM FILE FOR
"RTN","C0PALGY3",24,0)
 ; MAPPING ALLERGIES , XML IS RETURNED IN RTN,PASSED BY NAME
"RTN","C0PALGY3",25,0)
 ; IF ZFILE IS 1, THE FILE IS WRITTEN TO AN XML FILE
"RTN","C0PALGY3",26,0)
 ;D EN^C0PMAIN("G1","G2",ZDUZ,ZDFN) ; GET THE NCSCRIPT
"RTN","C0PALGY3",27,0)
 ;S @RTNURL=G2
"RTN","C0PALGY3",28,0)
 ;D GETXML^C0PWS1("G3",14) ; GET BEGINNING OF FILE
"RTN","C0PALGY3",29,0)
 ;D GETXML^C0PWS1("G4",15) ; GET END OF FILE
"RTN","C0PALGY3",30,0)
 N G1,G2,G3,G4,G5,G6,GBLD
"RTN","C0PALGY3",31,0)
 D GETALGY("G6",ZDFN) ;GET ALLERGIES
"RTN","C0PALGY3",32,0)
 ;D QUEUE^C0CXPATH("GBLD","G3",1,$O(G3(""),-1)) ;BUILD LIST BEGINNING OF FILE
"RTN","C0PALGY3",33,0)
 ;;D QUEUE^C0CXPATH("GBLD","G1",1,$O(G1(""),-1)) ; NCSCRIPT
"RTN","C0PALGY3",34,0)
 M G1=@RTNXML
"RTN","C0PALGY3",35,0)
 S GEND=$O(G1(""),-1)-2
"RTN","C0PALGY3",36,0)
 D QUEUE^C0CXPATH("GBLD","G1",1,GEND) ; NCSCRIPT.. UP TO </Patient>
"RTN","C0PALGY3",37,0)
 D QUEUE^C0CXPATH("GBLD","G6",1,$O(G6(""),-1)) ; ADD THE ALLERGIES
"RTN","C0PALGY3",38,0)
 D QUEUE^C0CXPATH("GBLD","G1",GEND+1,$O(G1(""),-1)) ;END OF NCSCRIPT
"RTN","C0PALGY3",39,0)
 D QUEUE^C0CXPATH("GBLD","G4",1,$O(G4(""),-1)) ; END OF FILE
"RTN","C0PALGY3",40,0)
 D BUILD^C0CXPATH("GBLD","G5") ; BUILD THE CONTENTS FROM THE BUILD LIST
"RTN","C0PALGY3",41,0)
 K @RTNXML
"RTN","C0PALGY3",42,0)
 M @RTNXML=G5 ;
"RTN","C0PALGY3",43,0)
 I $G(ZFILE)=1 W $$OUTPUT^C0CXPATH("G5(1)","ALLERGY-"_ZDFN_".html","/home/dev/CCR/")
"RTN","C0PALGY3",44,0)
 Q
"RTN","C0PALGY3",45,0)
 ;
"RTN","C0PALGY3",46,0)
GENTEST(RTNXML,RTNURL,ZDUZ,ZDFN,ZFILE) ; GENERATE A TEST 
"RTN","C0PALGY3",47,0)
 ; CLICK-THROUGH HTLM FILE FOR
"RTN","C0PALGY3",48,0)
 ; MAPPING ALLERGIES , XML IS RETURNED IN RTN,PASSED BY NAME
"RTN","C0PALGY3",49,0)
 ; IF ZFILE IS 1, THE FILE IS WRITTEN TO HOST FILE
"RTN","C0PALGY3",50,0)
 D EN^C0PMAIN("G1","G2",ZDUZ,ZDFN) ; GET THE NCSCRIPT
"RTN","C0PALGY3",51,0)
 ;S @RTNURL=G2
"RTN","C0PALGY3",52,0)
 D GETXML^C0PWS1("G3",14) ; GET BEGINNING OF FILE
"RTN","C0PALGY3",53,0)
 D GETXML^C0PWS1("G4",15) ; GET END OF FILE
"RTN","C0PALGY3",54,0)
 D GETALGY("G6",ZDFN) ;GET ALLERGIES
"RTN","C0PALGY3",55,0)
 D QUEUE^C0CXPATH("GBLD","G3",1,$O(G3(""),-1)) ;BUILD LIST BEGINNING OF FILE
"RTN","C0PALGY3",56,0)
 ;D QUEUE^C0CXPATH("GBLD","G1",1,$O(G1(""),-1)) ; NCSCRIPT
"RTN","C0PALGY3",57,0)
 D QUEUE^C0CXPATH("GBLD","G1",1,76) ; NCSCRIPT.. UP TO </Patient>
"RTN","C0PALGY3",58,0)
 D QUEUE^C0CXPATH("GBLD","G6",1,$O(G6(""),-1)) ; ADD THE ALLERGIES
"RTN","C0PALGY3",59,0)
 D QUEUE^C0CXPATH("GBLD","G1",77,$O(G1(""),-1)) ;END OF NCSCRIPT
"RTN","C0PALGY3",60,0)
 D QUEUE^C0CXPATH("GBLD","G4",1,$O(G4(""),-1)) ; END OF FILE
"RTN","C0PALGY3",61,0)
 D BUILD^C0CXPATH("GBLD","G5") ; BUILD THE CONTENTS FROM THE BUILD LIST
"RTN","C0PALGY3",62,0)
 M @RTNXML=G5 ;
"RTN","C0PALGY3",63,0)
 I $G(ZFILE)=1 W $$OUTPUT^C0CXPATH("G5(1)","ALLERGY-"_ZDFN_".html","/home/dev/CCR/")
"RTN","C0PALGY3",64,0)
 Q
"RTN","C0PALGY3",65,0)
 ;
"RTN","C0PALGY3",66,0)
GETALGY(OUTARY,ZDFN) ;
"RTN","C0PALGY3",67,0)
 ;
"RTN","C0PALGY3",68,0)
 N ZG,ZG2,ZB,ZN
"RTN","C0PALGY3",69,0)
 S DEBUG=0
"RTN","C0PALGY3",70,0)
 D GETTEMP^C0PWS1("ZG",16) ;GET THE ALLERGY TEMPLATE
"RTN","C0PALGY3",71,0)
 D EXTRACT^C0CALERT("ZG",ZDFN,"ZG2","ALGYCBK^C0PALGY3(ALTVMAP,A1)")
"RTN","C0PALGY3",72,0)
 S ZN=$O(ZG2(""),-1) ;NUMBER OF LINES IN OUTPUT
"RTN","C0PALGY3",73,0)
 D QUEUE^C0CXPATH("ZB","ZG2",2,ZN-1)
"RTN","C0PALGY3",74,0)
 D BUILD^C0CXPATH("ZB",OUTARY)
"RTN","C0PALGY3",75,0)
 Q
"RTN","C0PALGY3",76,0)
 ; 
"RTN","C0PALGY3",77,0)
ALGYCBK(ZRTN,ZIN) ;CALLBACK ROUTINE FOR C0CALERT USED TO SET FDB CONCEPT
"RTN","C0PALGY3",78,0)
 ; ID IF FOUND. ZIN IS PASSED BY NAME AND IS ONE ALLERGY
"RTN","C0PALGY3",79,0)
 N ZI,ZJ
"RTN","C0PALGY3",80,0)
 S ZI=$P(ZIN,"^",9) ;THIS IS THE VARIABLE POINTER OF THE GMR ALLERGY
"RTN","C0PALGY3",81,0)
 I ZI="" Q
"RTN","C0PALGY3",82,0)
 S ZJ=$O(^C0PALGY("VA",ZI,""))
"RTN","C0PALGY3",83,0)
 I ZJ'="" D  ; CONCEPT WAS FOUND
"RTN","C0PALGY3",84,0)
 . S ZK=$$GET1^DIQ(113059005,ZJ_",",.05) ;COMPOSIT ALLERGY ID (NOT CONCEPT)
"RTN","C0PALGY3",85,0)
 . S @ZRTN@("ALERTFDBCONCEPTID")=ZK
"RTN","C0PALGY3",86,0)
 . S @ZRTN@("ALERTFDB")="FDB"
"RTN","C0PALGY3",87,0)
 E  D  ;
"RTN","C0PALGY3",88,0)
 . S @ZRTN@("ALERTFDBCONCEPTID")=""
"RTN","C0PALGY3",89,0)
 . S @ZRTN@("ALERTFDB")=""
"RTN","C0PALGY3",90,0)
 Q
"RTN","C0PALGY3",91,0)
 ;
"RTN","C0PALGY3",92,0)
UPDIE   ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
"RTN","C0PALGY3",93,0)
 K ZERR
"RTN","C0PALGY3",94,0)
 D CLEAN^DILF
"RTN","C0PALGY3",95,0)
 D UPDATE^DIE("","C0PFDA","","ZERR")
"RTN","C0PALGY3",96,0)
 I $D(ZERR) D ERROR^C0PMAIN(",U113059008,",$ST($ST,"PLACE"),"ERX-UPDIE-FAIL","Fileman Data Update Failure") QUIT
"RTN","C0PALGY3",97,0)
 K C0PFDA
"RTN","C0PALGY3",98,0)
 Q
"RTN","C0PCPRS1")
0^3^B122541165
"RTN","C0PCPRS1",1,0)
C0PCPRS1   ; CCDCCR/GPL - ePrescription utilities; 8/1/09 ; 5/8/12 10:18pm
"RTN","C0PCPRS1",2,0)
 ;;1.0;C0P;;Apr 25, 2012;Build 103
"RTN","C0PCPRS1",3,0)
 ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"RTN","C0PCPRS1",4,0)
 ;General Public License See attached copy of the License.
"RTN","C0PCPRS1",5,0)
 ;
"RTN","C0PCPRS1",6,0)
 ;This program is free software; you can redistribute it and/or modify
"RTN","C0PCPRS1",7,0)
 ;it under the terms of the GNU General Public License as published by
"RTN","C0PCPRS1",8,0)
 ;the Free Software Foundation; either version 2 of the License, or
"RTN","C0PCPRS1",9,0)
 ;(at your option) any later version.
"RTN","C0PCPRS1",10,0)
 ;
"RTN","C0PCPRS1",11,0)
 ;This program is distributed in the hope that it will be useful,
"RTN","C0PCPRS1",12,0)
 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0PCPRS1",13,0)
 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"RTN","C0PCPRS1",14,0)
 ;GNU General Public License for more details.
"RTN","C0PCPRS1",15,0)
 ;
"RTN","C0PCPRS1",16,0)
 ;You should have received a copy of the GNU General Public License along
"RTN","C0PCPRS1",17,0)
 ;with this program; if not, write to the Free Software Foundation, Inc.,
"RTN","C0PCPRS1",18,0)
 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
"RTN","C0PCPRS1",19,0)
 ;
"RTN","C0PCPRS1",20,0)
 Q
"RTN","C0PCPRS1",21,0)
 ;
"RTN","C0PCPRS1",22,0)
 ; THESE ROUTINE CONSTITUTE ALL OF THE ENTRY POINTS IN THE ERX PACKAGE
"RTN","C0PCPRS1",23,0)
 ; THAT ARE USED BY CPRS.
"RTN","C0PCPRS1",24,0)
 ; ERXRPC IS USED BY CPRS TO LAUNCH THE MEDICATION COMPOSE SCREEN
"RTN","C0PCPRS1",25,0)
 ;   IT IS ALSO USED BY CPRS TO PROCESS AN INCOMPLETE ORDER ALERT
"RTN","C0PCPRS1",26,0)
 ; ERXPULL IS USED BY CPRS AFTER A SESSION WITH THE EPRESCRIBING PROVIDER
"RTN","C0PCPRS1",27,0)
 ;   TO PULL BACK ANY NEW MEDICATIONS AND ALLERGIES FROM THAT SESSION
"RTN","C0PCPRS1",28,0)
 ;   IT DOES MEDICATION AND ALLERGY RECONCILLIATION
"RTN","C0PCPRS1",29,0)
 ; ALERTRPC IS USED BY CPRS TO LAUCH THE RENEWAL REQUEST SCREEN IN THE 
"RTN","C0PCPRS1",30,0)
 ;   EPRECRIBING PROVIDER. AFTER THE RENEWAL SESSION ENDS, ERXPULL IS ALSO 
"RTN","C0PCPRS1",31,0)
 ;   CALLED
"RTN","C0PCPRS1",32,0)
 ; GPL JUNE, 2010
"RTN","C0PCPRS1",33,0)
 ;
"RTN","C0PCPRS1",34,0)
 ; TEST Lines below not intended for End Users. Programmers only.
"RTN","C0PCPRS1",35,0)
 ; BEWARE ZWRITE SYNTAX. It may not work in other M Implementations.
"RTN","C0PCPRS1",36,0)
TEST1 ; TEST ERX RPC FROM COMMAND LINE - RETURN RAW HTTPS POST ARRAY
"RTN","C0PCPRS1",37,0)
 ;
"RTN","C0PCPRS1",38,0)
 N C0PG1
"RTN","C0PCPRS1",39,0)
 D ERXRPC(.C0PG1,"135","2")
"RTN","C0PCPRS1",40,0)
 W $$OUTPUT^C0CXPATH("C0PG1(1)","Test-RPC-POST1.html","/home/dev/CCR/"),!
"RTN","C0PCPRS1",41,0)
 ZWRITE C0PG1
"RTN","C0PCPRS1",42,0)
 Q
"RTN","C0PCPRS1",43,0)
 ;
"RTN","C0PCPRS1",44,0)
TEST2 ; TEST ERX RPC FROM COMMAND LINE - RETURN CODED HTTPS POST ARRAY
"RTN","C0PCPRS1",45,0)
 ;
"RTN","C0PCPRS1",46,0)
 Q
"RTN","C0PCPRS1",47,0)
 ;
"RTN","C0PCPRS1",48,0)
ERXPULL(RTN,IDUZ,IDFN) ;RPC TO PULL BACK DRUGS AND ALLERGIES
"RTN","C0PCPRS1",49,0)
 ;
"RTN","C0PCPRS1",50,0)
 S ^TMP("GPL","PULLBACKDFN")=IDFN ; debugging
"RTN","C0PCPRS1",51,0)
 N UDFN
"RTN","C0PCPRS1",52,0)
 S UDFN=IDFN
"RTN","C0PCPRS1",53,0)
 I $D(^TMP("C0E",$J,"NEWDFN")) D  ; IF THERE IS A NEW RENEWAL PATIENT
"RTN","C0PCPRS1",54,0)
 . I IDFN'=0 Q  ; SHOULD BE ZERO FOR A NO MATCH RENEWAL
"RTN","C0PCPRS1",55,0)
 . S UDFN=^TMP("C0E",$J,"NEWDFN") ; GET THE MATCHED PATIENT DFN
"RTN","C0PCPRS1",56,0)
 . S ^TMP("GPL","NEWDFN")=UDFN ; debugging
"RTN","C0PCPRS1",57,0)
 . K ^TMP("C0E",$J,"NEWDFN") ; ERASE IT NOW THAT IT IS USED
"RTN","C0PCPRS1",58,0)
 D GETRXNS^C0PALGY1(IDUZ,UDFN,.RTN) ;PULL BACK ALLERGIES AND ADD TO ALLERGIES
"RTN","C0PCPRS1",59,0)
 D GETMEDS^C0PRECON(IDUZ,UDFN,.RTN) ;PULL BACK MEDS AND ADD TO NON-VA MEDS
"RTN","C0PCPRS1",60,0)
 I $G(RTN(1))="" S RTN(1)="OK"
"RTN","C0PCPRS1",61,0)
 I UDFN'=IDFN S RNT(1)="DFN="_UDFN ; TELL CPRS ABOUT THE NEW DFN
"RTN","C0PCPRS1",62,0)
 ;D REFILL^C0PREFIL ; PULL BACK REFILL REQUESTS EVERY TIME 
"RTN","C0PCPRS1",63,0)
 Q
"RTN","C0PCPRS1",64,0)
 ;
"RTN","C0PCPRS1",65,0)
TESTUC0P 
"RTN","C0PCPRS1",66,0)
 S ZA="OR,18,11305;135;3120305.103008"
"RTN","C0PCPRS1",67,0)
 D ALERTRPC(.GPL,135,18,1,ZA)
"RTN","C0PCPRS1",68,0)
 Q
"RTN","C0PCPRS1",69,0)
 ;
"RTN","C0PCPRS1",70,0)
TESTALRT(GPL,ZDUZ,ZDFN,MODE) ; TEST THE ALERT RPC
"RTN","C0PCPRS1",71,0)
 ;
"RTN","C0PCPRS1",72,0)
 ;S G=$O(^XTV(8992,135,"XQA",""),-1)
"RTN","C0PCPRS1",73,0)
 ;S G=3110102.15081201
"RTN","C0PCPRS1",74,0)
 ;S ZA="OR,18,11305;135;"_G ;3101223.125521" ; AN ALERT RECORD ID
"RTN","C0PCPRS1",75,0)
 ;S ZA="OR,0,11305;135;3110103.09324904"
"RTN","C0PCPRS1",76,0)
 I $G(MODE)'=1 S MODE=0 ; TEST MODE HERE
"RTN","C0PCPRS1",77,0)
 N ZI,ZJ S ZI=0
"RTN","C0PCPRS1",78,0)
 F  S ZI=$O(^XTV(8992,ZDUZ,"XQA",ZI)) Q:ZI=""  D  ;
"RTN","C0PCPRS1",79,0)
 . S ZJ=^XTV(8992,ZDUZ,"XQA",ZI,0)
"RTN","C0PCPRS1",80,0)
 . I ZJ["no match" S G=ZI
"RTN","C0PCPRS1",81,0)
 I $G(G)="" W !,"OOPS" Q  ;
"RTN","C0PCPRS1",82,0)
 S ZA="OR,18,11305;135;"_G
"RTN","C0PCPRS1",83,0)
 ;S ZA="OR,18,11305;135;3110810.123002"
"RTN","C0PCPRS1",84,0)
 W !,ZA
"RTN","C0PCPRS1",85,0)
 D ALERTRPC(.GPL,ZDUZ,ZDFN,1,ZA,MODE)
"RTN","C0PCPRS1",86,0)
 Q
"RTN","C0PCPRS1",87,0)
 I ZDFN=18 D ALERTRPC(.GPL,135,18,1,ZA)
"RTN","C0PCPRS1",88,0)
 E  D  ;
"RTN","C0PCPRS1",89,0)
 . ;S ZA="OR,0,11305;1;3101223.125521"
"RTN","C0PCPRS1",90,0)
 . D ALERTRPC(.GPL,135,0,1,ZA)
"RTN","C0PCPRS1",91,0)
 Q
"RTN","C0PCPRS1",92,0)
ALERTRPC(RTN,IDUZ,IDFN,DEST,ISTR,MODE) ;RPC FOR ERX ALERTS
"RTN","C0PCPRS1",93,0)
 ; MODE IS A MODE SWITCH IF MODE=1 WE ARE USING THE BROWSER REDIRECT
"RTN","C0PCPRS1",94,0)
 ; METHOD OF CLICKING THROUGH. THIS IS DONE TO COMPLETE NOMATCH RENEWALS
"RTN","C0PCPRS1",95,0)
 ; FROM EWD
"RTN","C0PCPRS1",96,0)
 ; IF MODE IS NOT SPECIFIED OR IS NOT 1, WE WILL USE THE CPRS REDIRECT
"RTN","C0PCPRS1",97,0)
 ; METHOD OF CLICKING THROUGH. 
"RTN","C0PCPRS1",98,0)
 ; THE MAIN DIFFERENCE BETWEEN THE TWO MODES IS THE HTML PACKAGING
"RTN","C0PCPRS1",99,0)
 ; SURROUNDING THE NCSCRIPT XML
"RTN","C0PCPRS1",100,0)
 ;
"RTN","C0PCPRS1",101,0)
 I $G(MODE)'=1 S MODE=0 ; MODE IS 0 IF IT'S NOT 1
"RTN","C0PCPRS1",102,0)
 S C0PRMODE=1 ; RENEWAL MODE - KILL AT THE END
"RTN","C0PCPRS1",103,0)
 ;
"RTN","C0PCPRS1",104,0)
 ; FIRST SEE IF LOOK UP THE RENEWAL GUID 
"RTN","C0PCPRS1",105,0)
 N ZGUID,ZALRT,C0PMED,ZDOB,ZSEX
"RTN","C0PCPRS1",106,0)
 ; USE THE NEW GETALRT^C0PREFIL TO GET THE GUID DIRECTLY FROM
"RTN","C0PCPRS1",107,0)
 ; THE ALERT TRACKING FILE USING THE RECORDID PASSED IN ISTR
"RTN","C0PCPRS1",108,0)
 ;D GETALRT^C0PREFIL("ZALRT",ISTR) ; GET THE ENTIRE ALERT
"RTN","C0PCPRS1",109,0)
 ;S ZGUID=$G(ZALRT("DATA FOR PROCESSING")) ; PULL OUT THE GUID
"RTN","C0PCPRS1",110,0)
 ; GET THE GUID THE QUICK WAY DIRECTLY FROM THE GLOBAL
"RTN","C0PCPRS1",111,0)
 S ZALRT=$P(ISTR,";",3) ;THE TIME PORTION OF THE RECORD ID
"RTN","C0PCPRS1",112,0)
 S ZGUID=$G(^XTV(8992,IDUZ,"XQA",ZALRT,1)) ;WHERE THE GUID SHOULD BE
"RTN","C0PCPRS1",113,0)
 S ZDOB=$P(ZGUID,"^",2) ; DATE OF BIRTH
"RTN","C0PCPRS1",114,0)
 S ZSEX=$P(ZGUID,"^",3) ; GENDER
"RTN","C0PCPRS1",115,0)
 S ZGUID=$P(ZGUID,"^",1) ; GUID IS PIECE ONE
"RTN","C0PCPRS1",116,0)
 I ZGUID'="" D  ; FOUND THE ALERT
"RTN","C0PCPRS1",117,0)
 . N ZNM S ZNM=$G(^XTV(8992,IDUZ,"XQA",ZALRT,0)) ; THE ALERT RECORD
"RTN","C0PCPRS1",118,0)
 . S C0PRNM=$P($P(ZNM,"[eRx] ",2)," Renewal",1) ; patient name
"RTN","C0PCPRS1",119,0)
 . S C0PMED=$P(ZNM,"request for ",2) ; name of the medication
"RTN","C0PCPRS1",120,0)
 ;I ZGUID="" S ^G("NOGUID")=ISTR
"RTN","C0PCPRS1",121,0)
 ;I ZGUID="" M ^G("NOGUID")=^XTV(8992,IDUZ,"XQA")
"RTN","C0PCPRS1",122,0)
UC0P1 I ZGUID="" D  Q  ; This is usually a missing Alert due to timing
"RTN","C0PCPRS1",123,0)
 . ; of the batch job and the CPRS request to process an error.
"RTN","C0PCPRS1",124,0)
 . W "ERROR EXTRACTING ALERT",!
"RTN","C0PCPRS1",125,0)
 . I $T(LOG^%ZTER)="" D ^%ZTER Q  ;
"RTN","C0PCPRS1",126,0)
 . N C0PERR S C0PERR="UC0P1"
"RTN","C0PCPRS1",127,0)
 . S C0PERR("PLACE")="UC0P1^C0PCPRS1"
"RTN","C0PCPRS1",128,0)
 . D LOG^%ZTER(.C0PERR)
"RTN","C0PCPRS1",129,0)
 ;N DONE S DONE=0
"RTN","C0PCPRS1",130,0)
 ;I ZGUID="" D  ; TRY AND FIND THE GUID ANYWAY
"RTN","C0PCPRS1",131,0)
 ;. N ZZI S ZZI=0
"RTN","C0PCPRS1",132,0)
 ;. F  S ZZI=$O(^XTV(8992,IDUZ,"XQA",ZZI)) Q:DONE  Q:ZZI=""  D  ; 
"RTN","C0PCPRS1",133,0)
 ;. . N ZA S ZA=$G(^XTV(8992,IDUZ,"XQA",ZZI,0))
"RTN","C0PCPRS1",134,0)
 ;. . ;W !,ZA B  
"RTN","C0PCPRS1",135,0)
 ;. . I ZA="" Q  ; SHOULDN'T HAPPEN
"RTN","C0PCPRS1",136,0)
 ;. . I $P(ZA,ZALRT,2)'="" D  ;
"RTN","C0PCPRS1",137,0)
 ;. . . N ZNM S ZNM=$G(^XTV(8992,IDUZ,"XQA",ZZI,0)) ; THE ALERT RECORD
"RTN","C0PCPRS1",138,0)
 ;. . . S C0PRNM=$P($P(ZNM,"[eRx] ",2)," Renewal",1) ; patient name
"RTN","C0PCPRS1",139,0)
 ;. . . S ZGUID=$G(^XTV(8992,IDUZ,"XQA",ZZI,1)) ; THE GUID
"RTN","C0PCPRS1",140,0)
 ;. . . S ZDOB=$P(ZGUID,"^",2) ; DATE OF BIRTH
"RTN","C0PCPRS1",141,0)
 ;. . . S ZSEX=$P(ZGUID,"^",3) ; GENDER
"RTN","C0PCPRS1",142,0)
 ;. . . S ZGUID=$P(ZGUID,"^",1) ; GUID IS PIECE ONE
"RTN","C0PCPRS1",143,0)
 ;. . . S C0PMED=$P(ZNM,"request for ",2) ; name of the medication
"RTN","C0PCPRS1",144,0)
 ;. . . S DONE=1
"RTN","C0PCPRS1",145,0)
 I ZGUID="" W "ERROR EXTRACTING ALERT",! Q  ;
"RTN","C0PCPRS1",146,0)
 ;S ZGUID=$P(ZGUID,U,3) ;THE VALUE IS IN P3
"RTN","C0PCPRS1",147,0)
 ;S ZIEN=$O(^C0PRE("E","A",IDUZ,IDFN,ISTR,"")) ;LOOK FOR AN ACTIVE ALERT 
"RTN","C0PCPRS1",148,0)
 ;I ZIEN="" D  Q  ; OOPS NO MATCHING ALERT. THIS IS AN ERROR
"RTN","C0PCPRS1",149,0)
 ;. W "ERROR ALERT NOT FOUND",!
"RTN","C0PCPRS1",150,0)
 ;S ZGUID=$$GET1^DIQ(113059006,ZIEN_",",.01,"I")
"RTN","C0PCPRS1",151,0)
 ; BUILD THE NCSRIPT XML FOR RENEWALS
"RTN","C0PCPRS1",152,0)
 N ZTID
"RTN","C0PCPRS1",153,0)
 S ZTID=$$RESTID^C0PWS1(IDUZ,"RENEWREQ") ;
"RTN","C0PCPRS1",154,0)
 N GVOR ; VARIABLE OVERRIDE ARRAY
"RTN","C0PCPRS1",155,0)
 S GVOR=""
"RTN","C0PCPRS1",156,0)
 S GVOR("REQUESTED-PAGE")="renewal"
"RTN","C0PCPRS1",157,0)
 N ZARY,ZURL
"RTN","C0PCPRS1",158,0)
 D EN^C0PMAIN("ZARY","ZURL",IDUZ,IDFN,,"GVOR") ; GET THE NCSCRIPT
"RTN","C0PCPRS1",159,0)
 I IDFN=0 D DELETE^C0CXPATH("ZARY","//NCScript/Patient") ;delete patient
"RTN","C0PCPRS1",160,0)
 I IDFN=0 D  ; GOING TO CALL THE EWD RENEWAL PATIENT MATCHING SCREEN
"RTN","C0PCPRS1",161,0)
 . S C0PNONAME=1
"RTN","C0PCPRS1",162,0)
 . S C0PSAV("IDUZ")=IDUZ
"RTN","C0PCPRS1",163,0)
 . M C0PSAV("DUZ")=DUZ
"RTN","C0PCPRS1",164,0)
 . S C0PSAV("DFN")=0
"RTN","C0PCPRS1",165,0)
 . S C0PSAV("C0PRenewalName")=C0PRNM ; THE RENEWAL NAME
"RTN","C0PCPRS1",166,0)
 . S C0PSAV("RenewalDOB")=ZDOB ; PHARMACY REQUEST DATE OF BIRTH
"RTN","C0PCPRS1",167,0)
 . S C0PSAV("RenewalSex")=ZSEX ; PHARMACY REQUEST GENDER
"RTN","C0PCPRS1",168,0)
 . S C0PSAV("renewalToken")=ISTR ; CPRS ALERT TOKEN IDENTIFIER
"RTN","C0PCPRS1",169,0)
 . S C0PMED=$P(C0PMED,"^",1) ; CLEAN UP THE MEDICATION NAME
"RTN","C0PCPRS1",170,0)
 . S C0PSAV("medication")=C0PMED ; MEDICATION BEING RENEWED
"RTN","C0PCPRS1",171,0)
 . S C0PSAV("C0PGuid")=ZGUID ; RENEWAL GUID
"RTN","C0PCPRS1",172,0)
 . S C0PSAV("dollarJ")=$J ; save the $J of the CPRS session
"RTN","C0PCPRS1",173,0)
 . ; PASSING THE SUPERVISING DOCTOR DUZ ALONG TO THE EWD RENEWAL SCREEN
"RTN","C0PCPRS1",174,0)
 . S C0PSAV("SUPERVISING-DUZ")=$G(C0PVARS("SUPERVISING-DOCTOR-DUZ")) ;
"RTN","C0PCPRS1",175,0)
 N ZTMP
"RTN","C0PCPRS1",176,0)
 D GETTEMP^C0PWS1("ZTMP",ZTID)
"RTN","C0PCPRS1",177,0)
 N ZV
"RTN","C0PCPRS1",178,0)
 S ZV("RENEWAL-GUID")=ZGUID
"RTN","C0PCPRS1",179,0)
 S ZV("RESPONSE-CODE")="Undetermined"
"RTN","C0PCPRS1",180,0)
 N ZRVAR,ZREXML
"RTN","C0PCPRS1",181,0)
 D BIND^C0PMAIN("ZRVAR","ZV",ZTID)
"RTN","C0PCPRS1",182,0)
 D MAP^C0CXPATH("ZTMP","ZRVAR","ZREXML")
"RTN","C0PCPRS1",183,0)
 K ZREXML(0) ; 
"RTN","C0PCPRS1",184,0)
 D INSERT^C0CXPATH("ZARY","ZREXML","//NCScript")
"RTN","C0PCPRS1",185,0)
 K ZARY(0)
"RTN","C0PCPRS1",186,0)
 D WRAP(.RTN,.ZARY,MODE)
"RTN","C0PCPRS1",187,0)
 K C0PRMODE ; TURN OFF THE RENEWAL MODE
"RTN","C0PCPRS1",188,0)
 Q
"RTN","C0PCPRS1",189,0)
 ;
"RTN","C0PCPRS1",190,0)
ERXRPC(RTN,IDUZ,IDFN) ; RPC CALL TO RETURN HTTPS POST ARRAY FOR MEDS ORDERING
"RTN","C0PCPRS1",191,0)
 ;
"RTN","C0PCPRS1",192,0)
 ;I IDUZ=135 D TESTALRT(.RTN,IDFN) Q  ;GPLTESTING
"RTN","C0PCPRS1",193,0)
 N C0PXML,C0PURL
"RTN","C0PCPRS1",194,0)
 D EN^C0PMAIN("C0PXML","C0PURL",IDUZ,IDFN,,,1) ;INCLUDE FREEFORM ALLERGIES
"RTN","C0PCPRS1",195,0)
 D WRAP(.RTN,.C0PXML) ; WRAP IN HTML FOR PROCESSING IN CPRS
"RTN","C0PCPRS1",196,0)
 Q
"RTN","C0PCPRS1",197,0)
 ;
"RTN","C0PCPRS1",198,0)
WRAP(ZRTN,ZINARY,MODE) ;WRAPS AN XML ARRAY (ZINARY) IN HTML FOR PROCESSING
"RTN","C0PCPRS1",199,0)
 ; BY CPRS - ZINARY AND ZRTN ARE PASSED BY REFERENCE
"RTN","C0PCPRS1",200,0)
 ; SEE COMMENT ABOVE ABOUT THE MODE SWITCH
"RTN","C0PCPRS1",201,0)
 I $G(MODE)'=1 S MODE=0 ; BROWSER REDIRECT MODE IS 0 IF IT IS NOT 1
"RTN","C0PCPRS1",202,0)
 ;
"RTN","C0PCPRS1",203,0)
 I '$D(ZINARY(1)) D  Q  ; NOT SET UP FOR ERX 
"RTN","C0PCPRS1",204,0)
 . S ZRTN(1)="ERROR, PROVIDER NOT SUBSCRIBED"
"RTN","C0PCPRS1",205,0)
 I MODE'=1 S ZINARY(1)="RxInput="_ZINARY(1)
"RTN","C0PCPRS1",206,0)
 ; GPL - GET THE URL FROM THE XML TEMPLATE FILE BASED ON PRODUCTION FLAG
"RTN","C0PCPRS1",207,0)
 ;S url="https://preproduction.newcropaccounts.com/InterfaceV7/RxEntry.aspx"
"RTN","C0PCPRS1",208,0)
 D SETUP^C0PMAIN() ;INITALIZE C0PACCT WS ACCOUNT IEN
"RTN","C0PCPRS1",209,0)
 S url=$$CTURL^C0PMAIN(C0PACCT) ; PRODUCTION OR TEST URL
"RTN","C0PCPRS1",210,0)
 I $G(C0PNONAME)=1 D  ;
"RTN","C0PCPRS1",211,0)
 . I MODE Q  ; WE'VE ALREADY BEEN TO EWD. THIS IS SECOND TIME
"RTN","C0PCPRS1",212,0)
 . n token s token=$$STORE^C0CEWD("C0PSAV") ; STORE FOR EWD SCREENS
"RTN","C0PCPRS1",213,0)
 . N ZT,ZU,ZP
"RTN","C0PCPRS1",214,0)
 . S ZT=$O(^C0PX("B","C0P RENEWAL NOMATCH URL","")) ; IEN FOR URL
"RTN","C0PCPRS1",215,0)
 . ; EXAMPLE URL: https://viper/dev/eRx/index1.ewd - be sure it matches
"RTN","C0PCPRS1",216,0)
 . ; your system
"RTN","C0PCPRS1",217,0)
 . S ZU=$$GET1^DIQ(113059001,ZT_",",1) ; URL OF NOMATCH RENEWAL SCREEN
"RTN","C0PCPRS1",218,0)
 . I C0PVARS("SUBSCRIBER-USERTYPE")="MidlevelPrescriber" S ZP="midmatch.ewd"
"RTN","C0PCPRS1",219,0)
 . E  S ZP="index1.ewd" ; midlevels get their own page
"RTN","C0PCPRS1",220,0)
 . S url=ZU_ZP_"?token="""_token_"""" ; ewd interface
"RTN","C0PCPRS1",221,0)
 . S C0PNONAME=0
"RTN","C0PCPRS1",222,0)
 I MODE D BRSRDR Q  ; BROWSER REDIRCT PACKAGEING INSTEAD OF httpPOST2
"RTN","C0PCPRS1",223,0)
 S ok=$$httpPOST2(.ZRTN,url,.ZINARY,"application/x-www-form-urlencoded",.gpl6,"","",.gpl5,.gpl7)
"RTN","C0PCPRS1",224,0)
 Q
"RTN","C0PCPRS1",225,0)
 ;
"RTN","C0PCPRS1",226,0)
BRSRDR ; GENERATE BROWSER REDIRECT PACKAGING TO RETURN TO BE SENT TO THE
"RTN","C0PCPRS1",227,0)
 ; BROWSER
"RTN","C0PCPRS1",228,0)
 ;
"RTN","C0PCPRS1",229,0)
 N ZB,ZTMP,ZTOP,ZBOT,ZTID1,ZTID2,ZVARS
"RTN","C0PCPRS1",230,0)
 S ZTID1=$$RESTID^C0PWS1(IDUZ,"C0P RENEWAL BRSRDR TOP") ; TOP XML IEN
"RTN","C0PCPRS1",231,0)
 S ZTID2=$$RESTID^C0PWS1(IDUZ,"C0P RENEWAL BRSRDR BOTTOM") ; BOTTOM XML IEN
"RTN","C0PCPRS1",232,0)
 D GETXML^C0PWS1("ZTMP",ZTID1) ; TOP XML
"RTN","C0PCPRS1",233,0)
 S ZVARS("url")=url
"RTN","C0PCPRS1",234,0)
 D MAP^C0CXPATH("ZTMP","ZVARS","ZTOP") ; SET THE URL PROPERLY
"RTN","C0PCPRS1",235,0)
 D GETXML^C0PWS1("ZBOT",ZTID2) ; BOTTOM XML
"RTN","C0PCPRS1",236,0)
 D QUEUE^C0CXPATH("ZB","ZTOP",1,$O(ZTOP(""),-1)) ; ADD TOP TO BUILD LIST
"RTN","C0PCPRS1",237,0)
 D QUEUE^C0CXPATH("ZB","ZINARY",1,$O(ZINARY(""),-1)) ; ADD NCSCRIPT
"RTN","C0PCPRS1",238,0)
 D QUEUE^C0CXPATH("ZB","ZBOT",1,$O(ZBOT(""),-1)) ; ADD BOTTOM
"RTN","C0PCPRS1",239,0)
 D BUILD^C0CXPATH("ZB","ZRTN") ; BUILD RETURN HTML
"RTN","C0PCPRS1",240,0)
 K ZRTN(0) ; KILL LENTGH NODE
"RTN","C0PCPRS1",241,0)
 Q
"RTN","C0PCPRS1",242,0)
 ;
"RTN","C0PCPRS1",243,0)
GETPOST1(URL) ;
"RTN","C0PCPRS1",244,0)
 ;RETRIEVES WSDL SAMPLE XML FROM A WEBSERVICE AT ADDRESS URL PASSED BY VALUE
"RTN","C0PCPRS1",245,0)
 ;RETURNS THE XML IN ARRAY gpl
"RTN","C0PCPRS1",246,0)
 s ok=$$httpGET^%zewdGTM(URL,.gpl)
"RTN","C0PCPRS1",247,0)
 ;W "XML retrieved from Web Service:",!
"RTN","C0PCPRS1",248,0)
 ;ZWR gpl
"RTN","C0PCPRS1",249,0)
 D INDEX^C0CXPATH("gpl","gpl2",-1,"gplTEMP")
"RTN","C0PCPRS1",250,0)
 Q
"RTN","C0PCPRS1",251,0)
 ;
"RTN","C0PCPRS1",252,0)
httpPOST2(ARY,url,payload,mimeType,html,headerArray,timeout,test,rawResponse,respHeaders,sslHost,sslPort) 
"RTN","C0PCPRS1",253,0)
 ;ORGINALLY THIS ROUTINE WAS FROM zewdGTM.m (thanks Rob!)
"RTN","C0PCPRS1",254,0)
 ;HACKED BY GPL TO RETURN ITS HTML IN AN ARRAY (ARY PASSED BY REF)
"RTN","C0PCPRS1",255,0)
 ;INSTEAD OF SENDING IT OUT A TPC PORT
"RTN","C0PCPRS1",256,0)
 ;THE ARY WILL BE SENT VIA RPC TO CPRS TO LAUNCH A BROWERS
"RTN","C0PCPRS1",257,0)
 ;USING THIS "POST" HTML AS THE STARTING PAGE (THANKS ART)
"RTN","C0PCPRS1",258,0)
 ;USES THE ROUTINE gw BELOW TO BUILD THE ARRAY
"RTN","C0PCPRS1",259,0)
 ; todo: html not used, test not used, rawResponse, respHeaders
"RTN","C0PCPRS1",260,0)
 ; sam's notes: this routine doesn't actually post anything; it just formats.
"RTN","C0PCPRS1",261,0)
 n contentLength,dev,host,HTTPVersion,io,port,rawURL,ssl,urllc
"RTN","C0PCPRS1",262,0)
 n zg ; gpl
"RTN","C0PCPRS1",263,0)
 ;
"RTN","C0PCPRS1",264,0)
 k rawResponse,html
"RTN","C0PCPRS1",265,0)
 s HTTPVersion="1.0"
"RTN","C0PCPRS1",266,0)
 s rawURL=url
"RTN","C0PCPRS1",267,0)
 s ssl=0
"RTN","C0PCPRS1",268,0)
 s port=80
"RTN","C0PCPRS1",269,0)
 s urllc=$$zcvt^%zewdAPI(url,"l")
"RTN","C0PCPRS1",270,0)
 i $e(urllc,1,7)="http://" d
"RTN","C0PCPRS1",271,0)
 . s url=$e(url,8,$l(url))
"RTN","C0PCPRS1",272,0)
 . s sslHost=$p(url,"/",1)
"RTN","C0PCPRS1",273,0)
 . s sslPort=80
"RTN","C0PCPRS1",274,0)
 e  i $e(urllc,1,8)="https://" d
"RTN","C0PCPRS1",275,0)
 . s url=$e(url,9,$l(url))
"RTN","C0PCPRS1",276,0)
 . s ssl=1
"RTN","C0PCPRS1",277,0)
 . s sslHost=$g(sslHost)
"RTN","C0PCPRS1",278,0)
 . i sslHost="" s sslHost="127.0.0.1"
"RTN","C0PCPRS1",279,0)
 . s sslPort=$g(sslPort)
"RTN","C0PCPRS1",280,0)
 . i sslPort="" s sslPort=89
"RTN","C0PCPRS1",281,0)
 e  QUIT "Invalid URL"
"RTN","C0PCPRS1",282,0)
 s host=$p(url,"/",1)
"RTN","C0PCPRS1",283,0)
 i host[":" d
"RTN","C0PCPRS1",284,0)
 . s port=$p(host,":",2)
"RTN","C0PCPRS1",285,0)
 . s host=$p(host,":",1)
"RTN","C0PCPRS1",286,0)
 s url="/"_$p(url,"/",2,5000)
"RTN","C0PCPRS1",287,0)
 i $g(timeout)="" s timeout=20
"RTN","C0PCPRS1",288,0)
 ;
"RTN","C0PCPRS1",289,0)
 ;GPL s io=$io
"RTN","C0PCPRS1",290,0)
 i $g(test)'=1 d
"RTN","C0PCPRS1",291,0)
 . ;GPL s dev=$$openTCP(sslHost,sslPort,timeout)
"RTN","C0PCPRS1",292,0)
 ;GPL . u dev
"RTN","C0PCPRS1",293,0)
 i ssl d
"RTN","C0PCPRS1",294,0)
 . ;w "POST "_rawURL_" HTTP/"_HTTPVersion_$c(13,10)
"RTN","C0PCPRS1",295,0)
 . s zg="POST "_rawURL_" HTTP/"_HTTPVersion_"^M"
"RTN","C0PCPRS1",296,0)
 . d gw(zg)
"RTN","C0PCPRS1",297,0)
 e  d
"RTN","C0PCPRS1",298,0)
 . ;w "POST "_url_" HTTP/"_HTTPVersion_$c(13,10)
"RTN","C0PCPRS1",299,0)
 . s zg="POST "_url_" HTTP/"_HTTPVersion_"^M"
"RTN","C0PCPRS1",300,0)
 . d gw(zg)
"RTN","C0PCPRS1",301,0)
 ;w "Host: "_host
"RTN","C0PCPRS1",302,0)
 s zg="Host: "_host
"RTN","C0PCPRS1",303,0)
 d gw(zg)
"RTN","C0PCPRS1",304,0)
 i port'=80 s zg=":"_port d gw(zg) ;w ":"_port
"RTN","C0PCPRS1",305,0)
 s zg=$c(13,10) d gw(zg) ;w $c(13,10)
"RTN","C0PCPRS1",306,0)
 s zg="Accept: */*"_$c(13,10) d gw(zg) ;w "Accept: */*"_"^M"
"RTN","C0PCPRS1",307,0)
 ;
"RTN","C0PCPRS1",308,0)
 i $d(headerArray) d
"RTN","C0PCPRS1",309,0)
 . n n
"RTN","C0PCPRS1",310,0)
 . s n=""
"RTN","C0PCPRS1",311,0)
 . f  s n=$o(headerArray(n)) q:n=""  d
"RTN","C0PCPRS1",312,0)
 . . ;w headerArray(n)_$c(13,10)
"RTN","C0PCPRS1",313,0)
 . . s zg=headerArray(n)_"^M"
"RTN","C0PCPRS1",314,0)
 . . d gw(zg)
"RTN","C0PCPRS1",315,0)
 ;
"RTN","C0PCPRS1",316,0)
 s mimeType=$g(mimeType)
"RTN","C0PCPRS1",317,0)
 i mimeType="" s mimeType="application/x-www-form-urlencoded"
"RTN","C0PCPRS1",318,0)
 s contentLength=0
"RTN","C0PCPRS1",319,0)
 i $d(payload) d
"RTN","C0PCPRS1",320,0)
 . n no
"RTN","C0PCPRS1",321,0)
 . s no=""
"RTN","C0PCPRS1",322,0)
 . f  s no=$O(payload(no)) q:no=""  D
"RTN","C0PCPRS1",323,0)
 . . s contentLength=contentLength+$l(payload(no))
"RTN","C0PCPRS1",324,0)
 . s contentLength=contentLength
"RTN","C0PCPRS1",325,0)
 . s zg="Content-Type: "_mimeType ;w "Content-Type: ",mimeType
"RTN","C0PCPRS1",326,0)
 . d gw(zg)
"RTN","C0PCPRS1",327,0)
 . i $g(charset)'="" d  ;
"RTN","C0PCPRS1",328,0)
 . . ;w "; charset=""",charset,""""
"RTN","C0PCPRS1",329,0)
 . . s zg="; charset="""_charset_""""
"RTN","C0PCPRS1",330,0)
 . . d gw(zg)
"RTN","C0PCPRS1",331,0)
 . s zg="^M" d gw(zg) ;w $c(13,10)
"RTN","C0PCPRS1",332,0)
 . ;w "Content-Length: ",contentLength,$c(13,10)
"RTN","C0PCPRS1",333,0)
 . s zg="Content-Length: "_contentLength_"^M"
"RTN","C0PCPRS1",334,0)
 . d gw(zg)
"RTN","C0PCPRS1",335,0)
 ;
"RTN","C0PCPRS1",336,0)
 s zg="^M" d gw(zg) ;w $c(13,10)
"RTN","C0PCPRS1",337,0)
 i $D(payload) d
"RTN","C0PCPRS1",338,0)
 . n no
"RTN","C0PCPRS1",339,0)
 . s no=""
"RTN","C0PCPRS1",340,0)
 . f  s no=$O(payload(no)) q:no=""  d
"RTN","C0PCPRS1",341,0)
 . . ;w payload(no)
"RTN","C0PCPRS1",342,0)
 . . s zg=payload(no)
"RTN","C0PCPRS1",343,0)
 . . d gw(zg)
"RTN","C0PCPRS1",344,0)
 ; 
"RTN","C0PCPRS1",345,0)
 s zg="^M" d gw(zg) ;w $c(13,10)
"RTN","C0PCPRS1",346,0)
 ;w $c(13,10),!  gpl- what does a bang send out????????
"RTN","C0PCPRS1",347,0)
 ;
"RTN","C0PCPRS1",348,0)
 ; That's the request sent !
"RTN","C0PCPRS1",349,0)
 ;
"RTN","C0PCPRS1",350,0)
 ;g httpResponse
"RTN","C0PCPRS1",351,0)
 ;
"RTN","C0PCPRS1",352,0)
 q ""
"RTN","C0PCPRS1",353,0)
 ;
"RTN","C0PCPRS1",354,0)
gw(LINE) ; Private proc; Adds line to end of array
"RTN","C0PCPRS1",355,0)
 ;
"RTN","C0PCPRS1",356,0)
 I '$D(ARY(1)) S ARY(1)=LINE
"RTN","C0PCPRS1",357,0)
 E  D  ;
"RTN","C0PCPRS1",358,0)
 . N CNT
"RTN","C0PCPRS1",359,0)
 . S CNT=$O(ARY(""),-1)
"RTN","C0PCPRS1",360,0)
 . S CNT=CNT+1
"RTN","C0PCPRS1",361,0)
 . S ARY(CNT)=LINE
"RTN","C0PCPRS1",362,0)
 Q
"RTN","C0PCPRS1",363,0)
 ;
"RTN","C0PCUR")
0^10^B38235838
"RTN","C0PCUR",1,0)
C0PCUR ; VEN/SMH - Get current medications ; 5/8/12 9:24pm
"RTN","C0PCUR",2,0)
 ;;1.0;C0P;;Apr 25, 2012;Build 103
"RTN","C0PCUR",3,0)
 ;
"RTN","C0PCUR",4,0)
 ;Copyright 2009 Sam Habiel.  Licensed under the terms of the GNU
"RTN","C0PCUR",5,0)
 ;General Public License See attached copy of the License.
"RTN","C0PCUR",6,0)
 ;
"RTN","C0PCUR",7,0)
 ;This program is free software; you can redistribute it and/or modify
"RTN","C0PCUR",8,0)
 ;it under the terms of the GNU General Public License as published by
"RTN","C0PCUR",9,0)
 ;the Free Software Foundation; either version 2 of the License, or
"RTN","C0PCUR",10,0)
 ;(at your option) any later version.
"RTN","C0PCUR",11,0)
 ;
"RTN","C0PCUR",12,0)
 ;This program is distributed in the hope that it will be useful,
"RTN","C0PCUR",13,0)
 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0PCUR",14,0)
 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"RTN","C0PCUR",15,0)
 ;GNU General Public License for more details.
"RTN","C0PCUR",16,0)
 ;
"RTN","C0PCUR",17,0)
 ;You should have received a copy of the GNU General Public License along
"RTN","C0PCUR",18,0)
 ;with this program; if not, write to the Free Software Foundation, Inc.,
"RTN","C0PCUR",19,0)
 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
"RTN","C0PCUR",20,0)
 ;
"RTN","C0PCUR",21,0)
GET(C0PMEDS,C0PDFN) ; Private Proc - Get Current C0PMEDS
"RTN","C0PCUR",22,0)
 ; Input: 
"RTN","C0PCUR",23,0)
 ; C0PMEDS by reference
"RTN","C0PCUR",24,0)
 ; C0PDFN by Value
"RTN","C0PCUR",25,0)
 ; Output: (modified PSOORRL output)
"RTN","C0PCUR",26,0)
 ; C0PMEDS(D0,0): Order#_File;Pkg^Drug Name^Infusion Rate^Stop Date ^Refills Remaining^Total Dose^Units per Dose^Placer#^Status^Last Filldate^Days Supply^Qty^NOT TO BE GIVEN^Pending Renewal (1 or 0)
"RTN","C0PCUR",27,0)
 ; C0PMEDS(D0,"DRUG"): Drug IEN
"RTN","C0PCUR",28,0)
 ; C0PMEDS(D0,"A",0)      = # of lines
"RTN","C0PCUR",29,0)
 ; C0PMEDS(D0,"A",D1,0)   = Additive Name^Amount^Bottle
"RTN","C0PCUR",30,0)
 ; C0PMEDS(D0,"ADM",0)    = # of lines
"RTN","C0PCUR",31,0)
 ; C0PMEDS(D0,"ADM",D1,0) = Administration Times
"RTN","C0PCUR",32,0)
 ; C0PMEDS(D0,"B",0)      = # of lines
"RTN","C0PCUR",33,0)
 ; C0PMEDS(D0,"B",D1,0)   = Solution Name^Amount
"RTN","C0PCUR",34,0)
 ; C0PMEDS(D0,"MDR",0)    = # of lines
"RTN","C0PCUR",35,0)
 ; C0PMEDS(D0,"MDR",D1,0) = Medication Route abbreviation
"RTN","C0PCUR",36,0)
 ; C0PMEDS(D0,"P",0)      = IEN^Name of Ordering Provider (#200)
"RTN","C0PCUR",37,0)
 ; C0PMEDS(D0,"SCH",0)    = # of lines
"RTN","C0PCUR",38,0)
 ; C0PMEDS(D0,"SCH",D1,0) = Schedule Name
"RTN","C0PCUR",39,0)
 ; C0PMEDS(D0,"SIG",0)    = # of lines
"RTN","C0PCUR",40,0)
 ; C0PMEDS(D0,"SIG",D1,0) = Sig (outpatient) or Instructions (inpatient)
"RTN","C0PCUR",41,0)
 ; C0PMEDS(D0,"SIO",0)    = # of lines
"RTN","C0PCUR",42,0)
 ; C0PMEDS(D0,"SIO",D1,0) = Special Instructions/Other Print Info
"RTN","C0PCUR",43,0)
 ; C0PMEDS(D0,"START"): Start Date (timson)
"RTN","C0PCUR",44,0)
 ; added by gpl
"RTN","C0PCUR",45,0)
 ; C0PMEDS(D0,"NVAIEN")   = IEN of the drug in the NVA subfile
"RTN","C0PCUR",46,0)
 ; C0PMEDS(D0,"COMMENTS") = First line of the comment WP field in NVA
"RTN","C0PCUR",47,0)
 K ^TMP("PS",$J)
"RTN","C0PCUR",48,0)
 N BEG,END,CTX
"RTN","C0PCUR",49,0)
 S (BEG,END,CTX)=""
"RTN","C0PCUR",50,0)
 S CTX=$$GET^XPAR("ALL","ORCH CONTEXT C0PMEDS") ; PSOORRL defaults to 120d
"RTN","C0PCUR",51,0)
 I CTX=";" D DEL^XPAR("USR.`"_DUZ,"ORCH CONTEXT C0PMEDS")
"RTN","C0PCUR",52,0)
 S CTX=$$GET^XPAR("ALL","ORCH CONTEXT C0PMEDS")
"RTN","C0PCUR",53,0)
 S BEG=$$DT($P(CTX,";")),END=$$DT($P(CTX,";",2))
"RTN","C0PCUR",54,0)
 D OCL^PSOORRL(C0PDFN,BEG,END)  ;DBIA #2400
"RTN","C0PCUR",55,0)
 M C0PMEDS=^TMP("PS",$J)
"RTN","C0PCUR",56,0)
 N C0PI S C0PI="" ; THIS IS THE RETURNED LIST OF MEDS
"RTN","C0PCUR",57,0)
 N ZI S ZI=0 ; THIS WILL BE THE MATCHING IEN IN THE NVA MULTIPLE
"RTN","C0PCUR",58,0)
 F  S C0PI=$O(C0PMEDS(C0PI)) Q:C0PI=""  D
"RTN","C0PCUR",59,0)
 . K ^TMP("PS",$J) ; again
"RTN","C0PCUR",60,0)
 . N LSIEN S LSIEN=$P(C0PMEDS(C0PI,0),U,1) ; LIST IEN xN;O OR xR;O gpl
"RTN","C0PCUR",61,0)
 . D OEL^PSOORRL(C0PDFN,LSIEN)
"RTN","C0PCUR",62,0)
 . S C0PMEDS(C0PI,"START")=$P(^TMP("PS",$J,0),U,5) ; Start Date in fm
"RTN","C0PCUR",63,0)
 . S:+$G(^TMP("PS",$J,"DD",1,0)) C0PMEDS(C0PI,"DRUG")=+^(0) ; Drug IEN
"RTN","C0PCUR",64,0)
 . ;I '$D(GPLTEST) Q  ; let me test and others still work
"RTN","C0PCUR",65,0)
 . ; now go look for the NVAIEN in the subfile - gpl
"RTN","C0PCUR",66,0)
 . ;W !,"LSIEN "_LSIEN_"C0PI "_C0PI
"RTN","C0PCUR",67,0)
 . I $P(LSIEN,";",1)["N" D  ; only for NVA drugs
"RTN","C0PCUR",68,0)
 . . ;N ZI S ZI=0 
"RTN","C0PCUR",69,0)
 . . N FOUND S FOUND=0
"RTN","C0PCUR",70,0)
 . . ;F  Q:FOUND=1  S ZI=$O(^PS(55,C0PDFN,"NVA",ZI)) Q:+ZI=0  D  ;EACH NVA
"RTN","C0PCUR",71,0)
 . . S ZI=$O(^PS(55,C0PDFN,"NVA",ZI)) D  ; NEXT NVA IEN (MAKE SURE IT MATCHES)
"RTN","C0PCUR",72,0)
 . . . N ZN S ZN=$NA(^PS(55,C0PDFN,"NVA",ZI))
"RTN","C0PCUR",73,0)
 . . . I '$D(@ZN@(0)) Q  ; BAD NVA NODE
"RTN","C0PCUR",74,0)
 . . . I $P(@ZN@(0),U,2)=$G(C0PMEDS(C0PI,"DRUG")) S FOUND=1 ;DRUG NUMBERS MATCH
"RTN","C0PCUR",75,0)
 . . . E  D  ; CHECK FOR FREE TEXT DRUG MATCH
"RTN","C0PCUR",76,0)
 . . . . N Z1 S Z1=$P($P(@ZN@(0),U,3),"|",1) ; free txt drug from NVA
"RTN","C0PCUR",77,0)
 . . . . N Z2 S Z2=$P(C0PMEDS(C0PI,"SIG",1,0),"|",1) ; free txt from list
"RTN","C0PCUR",78,0)
 . . . . I Z1=Z2 S FOUND=1
"RTN","C0PCUR",79,0)
 . . . I FOUND=1 D  ; found the NVA subfile entry
"RTN","C0PCUR",80,0)
 . . . . S C0PMEDS(C0PI,"NVAIEN")=ZI ; NVA ien
"RTN","C0PCUR",81,0)
 . . . . ;S C0PMEDS(C0PI,"COMMENTS")=$G(@ZN@(1,1,0)) ; first line of comments
"RTN","C0PCUR",82,0)
 . . . . N ZC ; to store the comment wp field
"RTN","C0PCUR",83,0)
 . . . . N ZM S ZM=$$GET1^DIQ(55.05,ZI_","_C0PDFN,14,,"ZC")
"RTN","C0PCUR",84,0)
 . . . . M C0PMEDS(C0PI,"COMMENTS")=ZC ; the comments
"RTN","C0PCUR",85,0)
 . . . . ;N ZC S ZC=0
"RTN","C0PCUR",86,0)
 . . . . ;F  S ZC=$G(@ZN@(1,ZC)) Q:+ZC=0  D  ; pull out the comments
"RTN","C0PCUR",87,0)
 . . . . ;. S C0PMEDS(C0PI,"COMMENTS",ZC)=$G(@ZN@(1,ZC,0)) ;line of comment
"RTN","C0PCUR",88,0)
 . . . . ;M C0PMEDS(C0PI,"COMMENTS")=@ZN@(1) ; all the lines of comments
"RTN","C0PCUR",89,0)
 . . . E  D  ; ERROR .. THESE SHOULD MATCH. There is a bug.
"RTN","C0PCUR",90,0)
 . . . . D ERROR^C0PMAIN(",U113059007,",$ST($ST,"PLACE"),"ERX-NVA","Non-VA Meds Error") QUIT
"RTN","C0PCUR",91,0)
 QUIT
"RTN","C0PCUR",92,0)
DT(X) ; -- Returns FM date for X
"RTN","C0PCUR",93,0)
 N Y,%DT S %DT="T",Y="" D:X'="" ^%DT
"RTN","C0PCUR",94,0)
 Q Y
"RTN","C0PCUR",95,0)
 ;
"RTN","C0PCUR",96,0)
MEDLIST(ZMLIST,ZDFN,ZPARMS,NOERX,SUMMARY) ; RETURNS THE MEDLIST FOR PATIENT DFN
"RTN","C0PCUR",97,0)
 ; USES C0C PACKAGE ROUTINES TO PULL ALL MEDS FOR THE PATIENT
"RTN","C0PCUR",98,0)
 ; IF NOERX=1 IT WILL FILTER OUT EPRESCRIBING MEDS FROM THE LIST
"RTN","C0PCUR",99,0)
 ; SUMMARY IS PASSED BY NAME AND IS THE PLACE TO PUT A SUMMARY IF PROVIDED
"RTN","C0PCUR",100,0)
 N ZCCRT,ZCCRR
"RTN","C0PCUR",101,0)
 D INITXPF^C0PWS1("C0PF") ; SET FILE NUMBER AND PARAMATERS 
"RTN","C0PCUR",102,0)
 D GETTEMP^C0CMXP("ZCCRT","CCRMEDS","C0PF")
"RTN","C0PCUR",103,0)
 K ^TMP("C0CRIM","VARS",ZDFN) ; KILL RIM VARIABLES TO MAKE SURE THEY ARE FRESH
"RTN","C0PCUR",104,0)
 I '$D(ZPARMS) S ZPARMS="MEDALL"
"RTN","C0PCUR",105,0)
 D SET^C0CPARMS(ZPARMS) ; SET PARAMATER TO PULL ALL MEDS
"RTN","C0PCUR",106,0)
 I '$D(DEBUG) S DEBUG=0
"RTN","C0PCUR",107,0)
 D EXTRACT^C0CMED("ZCCRT",ZDFN,"ZCCRR")
"RTN","C0PCUR",108,0)
 M @ZMLIST=^TMP("C0CRIM","VARS",ZDFN,"MEDS")
"RTN","C0PCUR",109,0)
 I $G(SUMMARY)="" Q  ; NO SUMMARY NEEDED
"RTN","C0PCUR",110,0)
 S ZI=""
"RTN","C0PCUR",111,0)
 F  S ZI=$O(@ZMLIST@(ZI)) Q:ZI=""  D  ;
"RTN","C0PCUR",112,0)
 . S @SUMMARY@(ZI,"MED")=$G(@ZMLIST@(ZI,"MEDPRODUCTNAMETEXT"))
"RTN","C0PCUR",113,0)
 . ;W @SUMMARY@(ZI,"MED")
"RTN","C0PCUR",114,0)
 . S @SUMMARY@(ZI,"STATUS")=$G(@ZMLIST@(ZI,"MEDSTATUSTEXT"))
"RTN","C0PCUR",115,0)
 . S @SUMMARY@(ZI,"CODESYSTEM")=$G(@ZMLIST@(ZI,"MEDPRODUCTNAMECODINGINGSYSTEM"))
"RTN","C0PCUR",116,0)
 . S @SUMMARY@(ZI,"CODE")=$G(@ZMLIST@(ZI,"MEDPRODUCTNAMECODEVALUE"))
"RTN","C0PCUR",117,0)
 . S @SUMMARY@(ZI,"COMMENT")=$G(@ZMLIST@(ZI,"MEDFULLFILLMENTINSTRUCTIONS"))
"RTN","C0PCUR",118,0)
 Q
"RTN","C0PCUR",119,0)
 ;
"RTN","C0PCUR",120,0)
ANALYZE(ZSTR,ZNUM) ; ANALYZE MED LISTS FOR ZNUM PATIENTS STARTING AT
"RTN","C0PCUR",121,0)
 ; PATIENT ZSTR. IF ZSTR="" START WHERE WE LEFT OFF
"RTN","C0PCUR",122,0)
 ; FIRST TIME, START WITH THE FIRST PATIENT
"RTN","C0PCUR",123,0)
 N C0PZI
"RTN","C0PCUR",124,0)
 I ZSTR="" D  ; WANT TO START WHERE WE LEFT OFF OR AT THE FIRST PATIENT
"RTN","C0PCUR",125,0)
 . S C0PZI=$G(^TMP("C0PAMED","LAST"))
"RTN","C0PCUR",126,0)
 . I C0PZI="" S C0PZI=0
"RTN","C0PCUR",127,0)
 . S C0PZI=$O(^DPT(C0PZI)) ; FIRST PATIENT TO DO
"RTN","C0PCUR",128,0)
 E  S C0PZI=ZSTR ; STARTING PATIENT IS SPECIFIED
"RTN","C0PCUR",129,0)
 N SUMM
"RTN","C0PCUR",130,0)
 N ZN S ZN=0
"RTN","C0PCUR",131,0)
 N DONE S DONE=0
"RTN","C0PCUR",132,0)
 F ZN=1:1:ZNUM Q:DONE  D  ; TRY AND DO ZNUM PATIENTS
"RTN","C0PCUR",133,0)
 . W !,"C0PZI=",C0PZI
"RTN","C0PCUR",134,0)
 . I +C0PZI=0 S DONE=1 Q  ; OUT OF PATIENTS
"RTN","C0PCUR",135,0)
 . S SUMM=$NA(^TMP("C0PAMED",C0PZI)) ; PLACE TO PUT SUMMARY
"RTN","C0PCUR",136,0)
 . W "SUMM ",SUMM
"RTN","C0PCUR",137,0)
 . K G ; MED LIST RETURN VARIABLE
"RTN","C0PCUR",138,0)
 . D MEDLIST("G",C0PZI,"MEDACTIVE",,SUMM) ; PULL THE MEDS FOR THIS PATIENT
"RTN","C0PCUR",139,0)
 . S ^TMP("C0PAMED","LAST")=C0PZI ; SAVE WHERE WE ARE
"RTN","C0PCUR",140,0)
 . S C0PZI=$O(^DPT(C0PZI)) ; NEXT PATIENT
"RTN","C0PCUR",141,0)
 Q
"RTN","C0PCUR",142,0)
 ;
"RTN","C0PCUR",143,0)
RESET ; CLEAR OUT THE ANALYZE ARRAY
"RTN","C0PCUR",144,0)
 K ^TMP("C0PAMED")
"RTN","C0PCUR",145,0)
 Q
"RTN","C0PCUR",146,0)
 ;
"RTN","C0PCUR",147,0)
INDEX ; INDEX THE ANALYSES
"RTN","C0PCUR",148,0)
 N ZI,ZJ
"RTN","C0PCUR",149,0)
 S (ZI,ZJ)=""
"RTN","C0PCUR",150,0)
 F  S ZI=$O(^TMP("C0PAMED",ZI)) Q:ZI=""  D  ;
"RTN","C0PCUR",151,0)
 . S ZJ=""
"RTN","C0PCUR",152,0)
 . F  S ZJ=$O(^TMP("C0PAMED",ZI,ZJ)) Q:ZJ=""  D  ;
"RTN","C0PCUR",153,0)
 . . N ZMED
"RTN","C0PCUR",154,0)
 . . S ZMED=$G(^TMP("C0PAMED",ZI,ZJ,"MED"))
"RTN","C0PCUR",155,0)
 . . I ZMED'="" S ^TMP("C0PAMED","MED",ZMED,ZI)=""
"RTN","C0PCUR",156,0)
 . . N ZCODE
"RTN","C0PCUR",157,0)
 . . S ZCODE=$G(^TMP("C0PAMED",ZI,ZJ,"CODE"))
"RTN","C0PCUR",158,0)
 . . I ZCODE'="" S ^TMP("C0PAMED","CODE",ZCODE,ZI)=""
"RTN","C0PCUR",159,0)
 D COUNT
"RTN","C0PCUR",160,0)
 Q
"RTN","C0PCUR",161,0)
 ;
"RTN","C0PCUR",162,0)
COUNT ; COUNT THE MEDS AND THE CODES
"RTN","C0PCUR",163,0)
 N ZI,ZN S ZN=0
"RTN","C0PCUR",164,0)
 S ZI=""
"RTN","C0PCUR",165,0)
 F  S ZI=$O(^TMP("C0PAMED","MED",ZI)) Q:ZI=""  D  ;
"RTN","C0PCUR",166,0)
 . S ZN=ZN+1
"RTN","C0PCUR",167,0)
 W !,"MED COUNT: ",ZN
"RTN","C0PCUR",168,0)
 S ZN=0
"RTN","C0PCUR",169,0)
 S ZI=""
"RTN","C0PCUR",170,0)
 F  S ZI=$O(^TMP("C0PAMED","CODE",ZI)) Q:ZI=""  D  ;
"RTN","C0PCUR",171,0)
 . S ZN=ZN+1
"RTN","C0PCUR",172,0)
 W !,"CODE COUNT: ",ZN
"RTN","C0PCUR",173,0)
 Q
"RTN","C0PCUR",174,0)
 ;
"RTN","C0PCUR",175,0)
 ; NB: EP below not used in C0P 1.0 --smh 5/9/2012
"RTN","C0PCUR",176,0)
OUTSIDE(ZRTN,ZMEDS) ; WRAP THE MEDS IN THE OUTSIDEPRESRIPTION XML
"RTN","C0PCUR",177,0)
 ; Here's what the xml looks like. It's stored in the Template field
"RTN","C0PCUR",178,0)
 ; of the OUTSIDEPRESCRIPTION record in file C0P XML TEMPLATE file
"RTN","C0PCUR",179,0)
 ;<OutsidePrescription>
"RTN","C0PCUR",180,0)
 ; <externalId>@@PRESCRIPTIONID@@</externalId>
"RTN","C0PCUR",181,0)
 ; <date>@@MEDDATE@@</date>
"RTN","C0PCUR",182,0)
 ; <doctorName>@@DOCTORNAME@@</doctorName>
"RTN","C0PCUR",183,0)
 ; <drug>@@MEDTEXT@@</drug>
"RTN","C0PCUR",184,0)
 ; <dispenseNumber>@@DISPENSENUMBER@@</dispenseNumber>
"RTN","C0PCUR",185,0)
 ; <sig>@@SIG@@</sig>
"RTN","C0PCUR",186,0)
 ; <refillCount>@@REFILLCOUNT@@</refillCount>
"RTN","C0PCUR",187,0)
 ; <prescriptionType>@@PRESCRIPTIONTYPE@@</prescriptionType>
"RTN","C0PCUR",188,0)
 ;</OutsidePrescription>
"RTN","C0PCUR",189,0)
 N C0PZI,ZTEMP,C0PF
"RTN","C0PCUR",190,0)
 S C0PZI=""
"RTN","C0PCUR",191,0)
 D INITXPF^C0PWS1("C0PF") ; SET UP FILE POINTERS
"RTN","C0PCUR",192,0)
 D GETTEMP^C0CMXP("ZTEMP","OUTSIDEPRESCRIPTION","C0PF")
"RTN","C0PCUR",193,0)
 ; BREAK
"RTN","C0PCUR",194,0)
 Q
"RTN","C0PEREW")
0^23^B41565998
"RTN","C0PEREW",1,0)
C0PEREW   ; eRx/GPL - ePrescription ewd utilities; 1/3/11
"RTN","C0PEREW",2,0)
 ;;1.0;C0P;;Apr 25, 2012;Build 103
"RTN","C0PEREW",3,0)
 ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"RTN","C0PEREW",4,0)
 ;General Public License See attached copy of the License.
"RTN","C0PEREW",5,0)
 ;
"RTN","C0PEREW",6,0)
 ;This program is free software; you can redistribute it and/or modify
"RTN","C0PEREW",7,0)
 ;it under the terms of the GNU General Public License as published by
"RTN","C0PEREW",8,0)
 ;the Free Software Foundation; either version 2 of the License, or
"RTN","C0PEREW",9,0)
 ;(at your option) any later version.
"RTN","C0PEREW",10,0)
 ;
"RTN","C0PEREW",11,0)
 ;This program is distributed in the hope that it will be useful,
"RTN","C0PEREW",12,0)
 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0PEREW",13,0)
 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"RTN","C0PEREW",14,0)
 ;GNU General Public License for more details.
"RTN","C0PEREW",15,0)
 ;
"RTN","C0PEREW",16,0)
 ;You should have received a copy of the GNU General Public License along
"RTN","C0PEREW",17,0)
 ;with this program; if not, write to the Free Software Foundation, Inc.,
"RTN","C0PEREW",18,0)
 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
"RTN","C0PEREW",19,0)
 ;
"RTN","C0PEREW",20,0)
 Q
"RTN","C0PEREW",21,0)
 ;
"RTN","C0PEREW",22,0)
test1(sessid) ;
"RTN","C0PEREW",23,0)
 d setSessionValue^%zewdAPI("testing","ZZ",sessid)
"RTN","C0PEREW",24,0)
 q 0
"RTN","C0PEREW",25,0)
 ;
"RTN","C0PEREW",26,0)
cbTestMethod(prefix,seedValue,lastSeedValue,optionNo,options) 
"RTN","C0PEREW",27,0)
 ;
"RTN","C0PEREW",28,0)
 n maxNo,noFound,dfn,dob,sex
"RTN","C0PEREW",29,0)
 ;
"RTN","C0PEREW",30,0)
 s maxNo=50
"RTN","C0PEREW",31,0)
 s noFound=0
"RTN","C0PEREW",32,0)
 f  s seedValue=$o(^DPT("B",seedValue)) q:seedValue=""  q:noFound=maxNo  d
"RTN","C0PEREW",33,0)
 . s lastSeedValue=seedValue
"RTN","C0PEREW",34,0)
 . i prefix'="",$e(seedValue,1,$l(prefix))'=prefix q
"RTN","C0PEREW",35,0)
 . s optionNo=optionNo+1
"RTN","C0PEREW",36,0)
 . s noFound=noFound+1
"RTN","C0PEREW",37,0)
 . s options(optionNo)=seedValue
"RTN","C0PEREW",38,0)
 . s dfn=$o(^DPT("B",seedValue,"")) ; dfn of the patient
"RTN","C0PEREW",39,0)
 . s dob=$$GET1^DIQ(2,dfn,.03) ; date of birth
"RTN","C0PEREW",40,0)
 . s sex=$$GET1^DIQ(2,dfn,.02,"I") ; sex M or F
"RTN","C0PEREW",41,0)
 . s options(optionNo)=seedValue_"  "_dob_" "_sex ; complete patient
"RTN","C0PEREW",42,0)
 QUIT
"RTN","C0PEREW",43,0)
 ;
"RTN","C0PEREW",44,0)
set1 ;
"RTN","C0PEREW",45,0)
 s ^zewd("comboPlus","methodMap","test")="cbTestMethod^C0PEREW"
"RTN","C0PEREW",46,0)
 ; THIS THE SHELL SCRIPT WHICH CREATED THE EWD PAGES IN THE C0P NAMESPACE
"RTN","C0PEREW",47,0)
 ;cp ../w/ewdWLerxewdajaxerror.m C0PE001.m
"RTN","C0PEREW",48,0)
 ;cp ../w/ewdWLerxewdajaxerrorredirect.m C0PE002.m
"RTN","C0PEREW",49,0)
 ;cp ../w/ewdWLerxewderrorredirect.m C0PE003.m
"RTN","C0PEREW",50,0)
 ;cp ../w/ewdWLerxindex1.m C0PE004.m
"RTN","C0PEREW",51,0)
 ;cp ../w/ewdWLerxmatch.m C0PE005.m
"RTN","C0PEREW",52,0)
 ;cp ../w/ewdWLerxnomatch.m C0PE006.m
"RTN","C0PEREW",53,0)
 ; WE NEED TO ADD THIS CONFIGURATION ONE TIME TO ^zewd
"RTN","C0PEREW",54,0)
 ;s ^zewd("routineMap","eRx","ewdajaxerror")="C0PE001"
"RTN","C0PEREW",55,0)
 ;s ^zewd("routineMap","eRx","ewdajaxerrorredirect")="C0PE002"
"RTN","C0PEREW",56,0)
 ;s ^zewd("routineMap","eRx","ewderrorredirect")="C0PE003"
"RTN","C0PEREW",57,0)
 ;s ^zewd("routineMap","eRx","index1")="C0PE004"
"RTN","C0PEREW",58,0)
 ;s ^zewd("routineMap","eRx","match")="C0PE005"
"RTN","C0PEREW",59,0)
 ;s ^zewd("routineMap","eRx","nomatch")="C0PE006"
"RTN","C0PEREW",60,0)
 ; unfortunately, the global map doesn't really work for now.. but
"RTN","C0PEREW",61,0)
 ; we will keep trying in future releases
"RTN","C0PEREW",62,0)
 q
"RTN","C0PEREW",63,0)
 ;
"RTN","C0PEREW",64,0)
INITSES(sessid) ; INITIALIZE AN EWD SESSION BY PULLING "VISTA" VARIABLES 
"RTN","C0PEREW",65,0)
 ; INTO THE SESSION FROM WHERE THEY HAVE BEEN STORED. THEY ARE INDEXED
"RTN","C0PEREW",66,0)
 ; BY A UNIQUE RANDOM TOKEN WHICH IS PASSED WITH THE URL
"RTN","C0PEREW",67,0)
 ; FOR EXAMPLE https//example.com/ewd/myApp/index.ewd?token="12345"
"RTN","C0PEREW",68,0)
 N ZTOKEN,C0EARY
"RTN","C0PEREW",69,0)
 S ZTOKEN=$$URLTOKEN^C0CEWD(sessid) ; get the token passed on the url
"RTN","C0PEREW",70,0)
 D GET^C0CEWD("C0EARY",ZTOKEN,1) ; GET THE ARRAY OF VALUES
"RTN","C0PEREW",71,0)
 S C0EARY("TOKEN")=ZTOKEN
"RTN","C0PEREW",72,0)
 M ^TMP("GPL")=C0EARY
"RTN","C0PEREW",73,0)
 d mergeArrayToSession^%zewdAPI(.C0EARY,"VistA",sessid)
"RTN","C0PEREW",74,0)
 ; ALL VISTA VARIABLES ARE IN THE "VistA" section of the session
"RTN","C0PEREW",75,0)
 Q
"RTN","C0PEREW",76,0)
 ;
"RTN","C0PEREW",77,0)
INITREW(sessid) ; initialze the eRx Renewal Patient Matching screen
"RTN","C0PEREW",78,0)
 ;
"RTN","C0PEREW",79,0)
 N C0PSES,ZDJ,ZDOB,ZSEX
"RTN","C0PEREW",80,0)
 D INITSES(sessid) ; add the VistA Variables to the session
"RTN","C0PEREW",81,0)
 D mergeArrayFromSession^%zewdAPI(.C0PSES,"VistA",sessid) ; get them back
"RTN","C0PEREW",82,0)
 N ZNAME,ZMED,ZSV
"RTN","C0PEREW",83,0)
 S ZNAME=$G(C0PSES("C0PRenewalName"))
"RTN","C0PEREW",84,0)
 I ZNAME="" Q "" ;OOPS
"RTN","C0PEREW",85,0)
 S ZDOB=$G(C0PSES("RenewalDOB")) ; date of birth
"RTN","C0PEREW",86,0)
 I ZDOB'="" S ZDOB=$E(ZDOB,5,6)_"/"_$E(ZDOB,7,8)_"/"_$E(ZDOB,1,4) ; REFORMAT
"RTN","C0PEREW",87,0)
 d setSessionValue^%zewdAPI("RenewalDOB",ZDOB,sessid) ; save in session
"RTN","C0PEREW",88,0)
 S ZSEX=$G(C0PSES("RenewalSex")) ; gender
"RTN","C0PEREW",89,0)
 d setSessionValue^%zewdAPI("RenewalSex",ZSEX,sessid) ; save in session
"RTN","C0PEREW",90,0)
 s ZNAME=ZNAME_"  "_ZDOB_" "_ZSEX ; ADD DOB AND SEX TO PATIENT NAME
"RTN","C0PEREW",91,0)
 d setSessionValue^%zewdAPI("C0PRenewalName",ZNAME,sessid) ;the whole name
"RTN","C0PEREW",92,0)
 d setSessionValue^%zewdAPI("pat4",$e(ZNAME,1,4),sessid) ;first part of name
"RTN","C0PEREW",93,0)
 S ZMED=$G(C0PSES("medication")) ; pull med from VistA part of session
"RTN","C0PEREW",94,0)
 d setSessionValue^%zewdAPI("medication",ZMED,sessid) ;the med
"RTN","C0PEREW",95,0)
 S ZDJ=$G(C0PSES("dollarJ")) ; job number of CPRS session
"RTN","C0PEREW",96,0)
 d setSessionValue^%zewdAPI("CPRSdollarJ",ZDJ,sessid) ; save in the session 
"RTN","C0PEREW",97,0)
 S ZSV=$G(C0PSES("SUPERVISING-DUZ")) ; supervising doctor DUZ
"RTN","C0PEREW",98,0)
 d setSessionValue^%zewdAPI("supervisor",ZSV,sessid) ; save 
"RTN","C0PEREW",99,0)
 d clearList^%zewdAPI("supervisor",sessid) ; make sure no list is there
"RTN","C0PEREW",100,0)
 M DUZ=C0PSES("DUZ") ; PASS LOG ON AUTHORITY
"RTN","C0PEREW",101,0)
 n svlist ; list of licensed prescribers
"RTN","C0PEREW",102,0)
 d SVLIST("svlist") ; generate the list
"RTN","C0PEREW",103,0)
 n zi,zn
"RTN","C0PEREW",104,0)
 s zi=""
"RTN","C0PEREW",105,0)
 f  s zi=$o(svlist(zi)) q:zi=""  d  ; for each licensed prescriber
"RTN","C0PEREW",106,0)
 . s zn=$o(svlist(zi,"")) ; DUZ of prescriber
"RTN","C0PEREW",107,0)
 . d appendToList^%zewdAPI("supervisor",zi,zn,sessid) ;add to list
"RTN","C0PEREW",108,0)
 Q ""
"RTN","C0PEREW",109,0)
 ;
"RTN","C0PEREW",110,0)
MATCH(sessid) ; process submit after matching
"RTN","C0PEREW",111,0)
 S ^TMP("GPL","MATCH",sessid)=""
"RTN","C0PEREW",112,0)
 N ZRTN,ZNAME,ZDFN
"RTN","C0PEREW",113,0)
 S ZNAME=$$getSessionValue^%zewdAPI("patient",sessid) ; current match
"RTN","C0PEREW",114,0)
 S ZNAME=$P(ZNAME,"  ",1) ; GET JUST THE NAME - NOT DOB OR SEX
"RTN","C0PEREW",115,0)
 S ZDFN=$O(^DPT("B",ZNAME,""))
"RTN","C0PEREW",116,0)
 S ZRTN=""
"RTN","C0PEREW",117,0)
 I ZDFN="" S ZRTN="Please select a patient"
"RTN","C0PEREW",118,0)
 D setSessionValue^%zewdAPI("selectedDFN",ZDFN,sessid) ; record selection
"RTN","C0PEREW",119,0)
 Q ZRTN
"RTN","C0PEREW",120,0)
 ;
"RTN","C0PEREW",121,0)
NOMATCH(sessid) ; process submit after matching
"RTN","C0PEREW",122,0)
 S ^TMP("GPL","NOMATCH",sessid)=""
"RTN","C0PEREW",123,0)
 Q ""
"RTN","C0PEREW",124,0)
 ;
"RTN","C0PEREW",125,0)
MTCHPG(sessid) ; process the match clickthrough page
"RTN","C0PEREW",126,0)
 N GDFN,ZDJ
"RTN","C0PEREW",127,0)
 S GDFN=$$getSessionValue^%zewdAPI("selectedDFN",sessid) ; THE PATIENT SELECTED
"RTN","C0PEREW",128,0)
 S ZDJ=$$getSessionValue^%zewdAPI("CPRSdollarJ",sessid) ; CPRS job number
"RTN","C0PEREW",129,0)
 S ^TMP("C0E",ZDJ,"NEWDFN")=GDFN ; PASS THE NEW DFN TO CPRS
"RTN","C0PEREW",130,0)
 D BRSRDR(GDFN,sessid) ; GENERATE THE RENEWAL BROWSER REDIRECT PAGE
"RTN","C0PEREW",131,0)
 Q ""
"RTN","C0PEREW",132,0)
 ;
"RTN","C0PEREW",133,0)
NOMTCHPG(sessid) ; process the nomatch clickthrough page
"RTN","C0PEREW",134,0)
 D BRSRDR(0,sessid) ; BOTH MATCH AND NOMATCH DO THE SAME THING FOR NOW
"RTN","C0PEREW",135,0)
 Q ""
"RTN","C0PEREW",136,0)
 ;
"RTN","C0PEREW",137,0)
BRSRDR(ZDFN,sessid) ; GENERATE RENEWAL BROWSER REDIRCT HTML/XML TO CLICK THRU
"RTN","C0PEREW",138,0)
 ; TO ERX RENEWAL
"RTN","C0PEREW",139,0)
 N ZISTR,ZDUZ,ZHTML,C0PSES
"RTN","C0PEREW",140,0)
 D mergeArrayFromSession^%zewdAPI(.C0PSES,"VistA",sessid) ; get SESSION VARS
"RTN","C0PEREW",141,0)
 S ZDUZ=$G(C0PSES("DUZ"))
"RTN","C0PEREW",142,0)
 M DUZ=C0PSES("DUZ") ; PASS LOG ON AUTHORITY
"RTN","C0PEREW",143,0)
 S ZISTR=$G(C0PSES("renewalToken"))
"RTN","C0PEREW",144,0)
 S C0PSPRV=$$getSessionValue^%zewdAPI("supervisor",sessid) ;supervisor selected
"RTN","C0PEREW",145,0)
 I C0PSPRV="" S C0PSVRV=$G(C0PSES("SUPERVISOR-DUZ")) ; SUPERVISING DOCTOR DUZ
"RTN","C0PEREW",146,0)
 D ALERTRPC^C0PCPRS1(.ZHTML,ZDUZ,ZDFN,1,ZISTR,1) ; CALL WITH MODE=1
"RTN","C0PEREW",147,0)
 d mergeArrayToSession^%zewdAPI(.ZHTML,"eRxRenew",sessid)
"RTN","C0PEREW",148,0)
 Q
"RTN","C0PEREW",149,0)
 ;
"RTN","C0PEREW",150,0)
SVLIST(ZLIST) ; GENERATE A LIST OF LICENSED PRESCRIBERS FOR THE
"RTN","C0PEREW",151,0)
 ; MIDLEVEL SUPERVISING DOCTOR PULLDOWN; ZLIST IS PASSED BY NAME
"RTN","C0PEREW",152,0)
 N ZI,ZA
"RTN","C0PEREW",153,0)
 S ZA=$NA(^VA(200,"C0P","ERX")) ; INDEX TO USE
"RTN","C0PEREW",154,0)
 S ZI=""
"RTN","C0PEREW",155,0)
 F  S ZI=$O(@ZA@(ZI)) Q:ZI=""  D  ; FOR EACH SUBSCRIBER
"RTN","C0PEREW",156,0)
 . N ZS
"RTN","C0PEREW",157,0)
 . D SETACCT^C0PSUB("ZS",ZI) ; GET SUBSCRIPTION INFO
"RTN","C0PEREW",158,0)
 . I $G(ZS("SUBSCRIBER-USERTYPE"))="LicensedPrescriber" D  ; USE IT
"RTN","C0PEREW",159,0)
 . . N ZN
"RTN","C0PEREW",160,0)
 . . S ZN=$$GET1^DIQ(200,ZI,.01,"E") ; NAME OF SUBSCRIBER
"RTN","C0PEREW",161,0)
 . . S @ZLIST@(ZN,ZI)="" ; RETURN THIS SUBSCRIBER
"RTN","C0PEREW",162,0)
 . K ZS
"RTN","C0PEREW",163,0)
 Q
"RTN","C0PEREW",164,0)
 ;
"RTN","C0PEWD1")
0^18^B12507891
"RTN","C0PEWD1",1,0)
C0PEWD1   ; CCDCCR/GPL - ePrescription utilities; 12/6/08 ; 5/8/12 3:57pm
"RTN","C0PEWD1",2,0)
 ;;1.0;C0P;;Apr 25, 2012;Build 103
"RTN","C0PEWD1",3,0)
 ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
"RTN","C0PEWD1",4,0)
 ;General Public License See attached copy of the License.
"RTN","C0PEWD1",5,0)
 ;
"RTN","C0PEWD1",6,0)
 ;This program is free software; you can redistribute it and/or modify
"RTN","C0PEWD1",7,0)
 ;it under the terms of the GNU General Public License as published by
"RTN","C0PEWD1",8,0)
 ;the Free Software Foundation; either version 2 of the License, or
"RTN","C0PEWD1",9,0)
 ;(at your option) any later version.
"RTN","C0PEWD1",10,0)
 ;
"RTN","C0PEWD1",11,0)
 ;This program is distributed in the hope that it will be useful,
"RTN","C0PEWD1",12,0)
 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0PEWD1",13,0)
 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"RTN","C0PEWD1",14,0)
 ;GNU General Public License for more details.
"RTN","C0PEWD1",15,0)
 ;
"RTN","C0PEWD1",16,0)
 ;You should have received a copy of the GNU General Public License along
"RTN","C0PEWD1",17,0)
 ;with this program; if not, write to the Free Software Foundation, Inc.,
"RTN","C0PEWD1",18,0)
 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
"RTN","C0PEWD1",19,0)
 ;
"RTN","C0PEWD1",20,0)
 Q
"RTN","C0PEWD1",21,0)
 ; THE FOLLOWING ROUTINES ARE EXPERIMENTS USED TO TEST HTTP CALLS FROM
"RTN","C0PEWD1",22,0)
 ; MUMPS USING EWD. NONE OF THE ROUTINES ARE USED FOR PROCESSING IN THE
"RTN","C0PEWD1",23,0)
 ; ERX PACKAGE. THEY ARE INCLUDED AND BROUGHT FORWARD FOR USE IN DEBUGGING
"RTN","C0PEWD1",24,0)
 ; AND FUTURE DEVELOPMENT
"RTN","C0PEWD1",25,0)
 ; GPL JUN 2010
"RTN","C0PEWD1",26,0)
 ;
"RTN","C0PEWD1",27,0)
 ;TEST(filepath) ; filepath IS THE PATH/FILE TO BE READ IN
"RTN","C0PEWD1",28,0)
 i $g(^%ZISH)["" d  ; if the VistA Kernal routine %ZISH exists
"RTN","C0PEWD1",29,0)
 . n zfile,zpath,ztmp s (zfile,zpath,ztmp)=""
"RTN","C0PEWD1",30,0)
 . s zfile=$re($p($re(filepath),"/",1)) ;file name
"RTN","C0PEWD1",31,0)
 . s zpath=$p(filepath,zfile,1) ; file path
"RTN","C0PEWD1",32,0)
 . s ztmp=$na(^CacheTempEWD($j,0))
"RTN","C0PEWD1",33,0)
 . s ok=$$FTG^%ZISH(zpath,zfile,ztmp,2) ; import the file incrementing subscr 2
"RTN","C0PEWD1",34,0)
 q
"RTN","C0PEWD1",35,0)
 ;
"RTN","C0PEWD1",36,0)
TEST2 ;
"RTN","C0PEWD1",37,0)
 s zfilepath="/home/vademo2/CCR/PAT_780_CCR_V1_0_17.xml"
"RTN","C0PEWD1",38,0)
 ;s ok=$$gtmImportFile^%zewdHTMLParser(zfilepath)
"RTN","C0PEWD1",39,0)
 s ok=$$LOAD(zfilepath) ;load the XML file to the EWD global
"RTN","C0PEWD1",40,0)
 s ok=$$parseDocument^%zewdHTMLParser("DerekDOM",0)
"RTN","C0PEWD1",41,0)
 ;s ok=$$parseXMLFile^%zewdAPI(zfilepath,"fourthDOM")
"RTN","C0PEWD1",42,0)
 w ok,!
"RTN","C0PEWD1",43,0)
 q
"RTN","C0PEWD1",44,0)
 ;
"RTN","C0PEWD1",45,0)
GPLTEST ;
"RTN","C0PEWD1",46,0)
 ;s ok=$$httpGET^%zewdGTM("http://preproduction.newcropaccounts.com/InterfaceV7/NewrxFDB.xml",.gpl)
"RTN","C0PEWD1",47,0)
 s URL="https://trac.opensourcevista.net/CCD-CCR-Project/browser/ccr/tags/CCR_1_0_7/output"
"RTN","C0PEWD1",48,0)
 s ok=$$httpGET^%zewdGTM(URL,.gpl)
"RTN","C0PEWD1",49,0)
 S ZG=""
"RTN","C0PEWD1",50,0)
 F  S ZG=$O(gpl(ZG)) Q:ZG=""  D  ;
"RTN","C0PEWD1",51,0)
 . s gpl(ZG)=$$CLEAN^C0PEWDU(gpl(ZG)) ;
"RTN","C0PEWD1",52,0)
 . ;w gpl(ZG)
"RTN","C0PEWD1",53,0)
 m ^CacheTempEWD($j)=gpl
"RTN","C0PEWD1",54,0)
 ; b
"RTN","C0PEWD1",55,0)
 s ok=$$parseDocument^%zewdHTMLParser("gpl2",0)
"RTN","C0PEWD1",56,0)
 s ok=$$outputDOM^%zewdDOM("gpl2",1,1)
"RTN","C0PEWD1",57,0)
 Q
"RTN","C0PEWD1",58,0)
 ;
"RTN","C0PEWD1",59,0)
GPLTEST2 ;
"RTN","C0PEWD1",60,0)
 s URL="https://preproduction.newcropaccounts.com/InterfaceV7/NewrxFDB.xml"
"RTN","C0PEWD1",61,0)
 ;s URL="https://trac.opensourcevista.net/CCD-CCR-Project/browser/ccr/tags/CCR_1_0_7/output"
"RTN","C0PEWD1",62,0)
 s ok=$$httpGET^%zewdGTM(URL,.gpl)
"RTN","C0PEWD1",63,0)
 D INDEX^C0CXPATH("gpl","gpl2")
"RTN","C0PEWD1",64,0)
 S G=""
"RTN","C0PEWD1",65,0)
 F  S G=$O(gpl2(G)) Q:G=""  D  ;
"RTN","C0PEWD1",66,0)
 . W !,G," = ",gpl2(G)
"RTN","C0PEWD1",67,0)
 W !
"RTN","C0PEWD1",68,0)
 Q
"RTN","C0PEWD1",69,0)
 ;
"RTN","C0PEWD1",70,0)
CLEAN(INX) ;DELETE NON-PRINTING CHARACTER IN INX, PASSED BY VALUE
"RTN","C0PEWD1",71,0)
 ;DON'T USE THIS -- IT DOESN'T WORK -- USE $$CLEAN^C0PEWDU
"RTN","C0PEWD1",72,0)
 ;N ZT,ZI
"RTN","C0PEWD1",73,0)
 S ZT=""
"RTN","C0PEWD1",74,0)
 F ZI=32:1:126 S ZT=ZT_$CHAR(ZI)
"RTN","C0PEWD1",75,0)
 S ZZ=$TR(INX,ZT)
"RTN","C0PEWD1",76,0)
 Q ZZ
"RTN","C0PEWD1",77,0)
 ;
"RTN","C0PEWD1",78,0)
LOAD(filepath) ; load an xml file into the EWD global for DOM processing
"RTN","C0PEWD1",79,0)
 ; need to call s error=$$parseDocument^%zewdHTMLParser(docName,isHTML)
"RTN","C0PEWD1",80,0)
 ; after to process it to the DOM - isHTML=0 for XML files
"RTN","C0PEWD1",81,0)
 n i
"RTN","C0PEWD1",82,0)
 i $g(^%ZISH)["" d  QUIT i ; if VistA Kernal routine %ZISH exists - gpl 2/23/09
"RTN","C0PEWD1",83,0)
 . n zfile,zpath,ztmp,zok s (zfile,zpath,ztmp)=""
"RTN","C0PEWD1",84,0)
 . s zfile=$re($p($re(filepath),"/",1)) ;file name
"RTN","C0PEWD1",85,0)
 . s zpath=$p(filepath,zfile,1) ; file path
"RTN","C0PEWD1",86,0)
 . s ztmp=$na(^CacheTempEWD($j,0))
"RTN","C0PEWD1",87,0)
 . s zok=$$FTG^%ZISH(zpath,zfile,ztmp,2) ; import the file increment subscr 2
"RTN","C0PEWD1",88,0)
 . s i=$o(^CacheTempEWD($j,""),-1) ; highest line number
"RTN","C0PEWD1",89,0)
 q i
"RTN","C0PEWD1",90,0)
 ;
"RTN","C0PEWD1",91,0)
Q(ZQ,ZD) ; SEND QUERY ZQ TO DOM ZD AND DIPLAY NODES RETURNED
"RTN","C0PEWD1",92,0)
 I '$D(ZD) S ZD="DerekDOM"
"RTN","C0PEWD1",93,0)
 s error=$$select^%zewdXPath(ZQ,ZD,.nodes) ;
"RTN","C0PEWD1",94,0)
 d displayNodes^%zewdXPath(.nodes)
"RTN","C0PEWD1",95,0)
 q
"RTN","C0PEWD1",96,0)
 ;
"RTN","C0PEWD1",97,0)
TEST1 
"RTN","C0PEWD1",98,0)
 S url="https://ec2-75-101-247-83.compute-1.amazonaws.com:8181/ccr/CCRService?wsdl"
"RTN","C0PEWD1",99,0)
 ;S url="http://ec2-75-101-247-83.compute-1.amazonaws.com"
"RTN","C0PEWD1",100,0)
 D GET1URL^C0PEWD2(url)
"RTN","C0PEWD1",101,0)
 Q
"RTN","C0PEWD1",102,0)
 ;
"RTN","C0PEWD2")
0^8^B48189391
"RTN","C0PEWD2",1,0)
C0PEWD2   ; CCDCCR/GPL - ePrescription utilities; 4/24/09 ; 5/8/12 10:22pm
"RTN","C0PEWD2",2,0)
 ;;1.0;C0P;;Apr 25, 2012;Build 103
"RTN","C0PEWD2",3,0)
 ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"RTN","C0PEWD2",4,0)
 ;General Public License See attached copy of the License.
"RTN","C0PEWD2",5,0)
 ;
"RTN","C0PEWD2",6,0)
 ;This program is free software; you can redistribute it and/or modify
"RTN","C0PEWD2",7,0)
 ;it under the terms of the GNU General Public License as published by
"RTN","C0PEWD2",8,0)
 ;the Free Software Foundation; either version 2 of the License, or
"RTN","C0PEWD2",9,0)
 ;(at your option) any later version.
"RTN","C0PEWD2",10,0)
 ;
"RTN","C0PEWD2",11,0)
 ;This program is distributed in the hope that it will be useful,
"RTN","C0PEWD2",12,0)
 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0PEWD2",13,0)
 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"RTN","C0PEWD2",14,0)
 ;GNU General Public License for more details.
"RTN","C0PEWD2",15,0)
 ;
"RTN","C0PEWD2",16,0)
 ;You should have received a copy of the GNU General Public License along
"RTN","C0PEWD2",17,0)
 ;with this program; if not, write to the Free Software Foundation, Inc.,
"RTN","C0PEWD2",18,0)
 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
"RTN","C0PEWD2",19,0)
 ;
"RTN","C0PEWD2",20,0)
 Q
"RTN","C0PEWD2",21,0)
 ; TEST Lines below not intended for End Users. Programmers only.
"RTN","C0PEWD2",22,0)
 ; BEWARE ZWRITE SYNTAX. It may not work in other M Implementations.
"RTN","C0PEWD2",23,0)
gpltest3 ;  (zduz,zdfn) ; experiment with passing parameters from trigger
"RTN","C0PEWD2",24,0)
 ;W "<br><b>SESSIONID:",zduz,"</b><br><hr>"
"RTN","C0PEWD2",25,0)
 W "<b>eRx</b> pullback trigger processing prototype<hr>",!
"RTN","C0PEWD2",26,0)
 I $D(req4) ZWRITE req4
"RTN","C0PEWD2",27,0)
 w "<hr>"
"RTN","C0PEWD2",28,0)
 W "XID=",$G(req4("XID",1)),"<br>"
"RTN","C0PEWD2",29,0)
 W "DFN=",$G(req4("DFN",1)),"<br>"
"RTN","C0PEWD2",30,0)
 w "DUZ=",$G(req4("DUZ",1)),"<hr>"
"RTN","C0PEWD2",31,0)
 s DFN=$G(req4("DFN",1))
"RTN","C0PEWD2",32,0)
 D PSEUDO ; FAKE LOGIN
"RTN","C0PEWD2",33,0)
 D XPAT^C0CCCR(DFN,"MEDALL")
"RTN","C0PEWD2",34,0)
 W "<br>"
"RTN","C0PEWD2",35,0)
 ;D XPAT^C0CCCR(DFN)
"RTN","C0PEWD2",36,0)
 W "<a href=""http://hollywood/dev/CCR/PAT_"_DFN_"_CCR_V1_0_0.xml"" target=""CCR"">Display CCR</a>"
"RTN","C0PEWD2",37,0)
 ;D RIM2RNF^C0CRIMA("GPL",DFN,"ALERTS")
"RTN","C0PEWD2",38,0)
 ;D RNF2HVN^C0CRNF("G1","GPL")
"RTN","C0PEWD2",39,0)
 ;D PARY^C0CXPATH("G1",-1)
"RTN","C0PEWD2",40,0)
 F ZG="ALERTS","MEDS","PROCEDURES" D  ;
"RTN","C0PEWD2",41,0)
 . N GPL,G2
"RTN","C0PEWD2",42,0)
 . W "<hr>"
"RTN","C0PEWD2",43,0)
 . W "<b>Current CCR "_ZG_"</b><br>",!
"RTN","C0PEWD2",44,0)
 . D RIM2RNF^C0CRIMA("GPL",DFN,ZG)
"RTN","C0PEWD2",45,0)
 . D RNF2HNV^C0CRNF("G2","GPL")
"RTN","C0PEWD2",46,0)
 . D PARY^C0CXPATH("G2",-1)
"RTN","C0PEWD2",47,0)
 Q
"RTN","C0PEWD2",48,0)
 ;
"RTN","C0PEWD2",49,0)
PSEUDO ; FAKE LOGIN SETS SOME LOCAL VARIABLE TO FOOL FILEMAN
"RTN","C0PEWD2",50,0)
 S DILOCKTM=3
"RTN","C0PEWD2",51,0)
 S DISYS=19
"RTN","C0PEWD2",52,0)
 S DT=3100112
"RTN","C0PEWD2",53,0)
 S DTIME=9999
"RTN","C0PEWD2",54,0)
 S DUZ=135
"RTN","C0PEWD2",55,0)
 S DUZ(0)=""
"RTN","C0PEWD2",56,0)
 S DUZ(1)=""
"RTN","C0PEWD2",57,0)
 S DUZ(2)=67
"RTN","C0PEWD2",58,0)
 S DUZ("AG")="E"
"RTN","C0PEWD2",59,0)
 S DUZ("BUF")=1
"RTN","C0PEWD2",60,0)
 S DUZ("LANG")=1
"RTN","C0PEWD2",61,0)
 ;S IO="/dev/pts/0"
"RTN","C0PEWD2",62,0)
 ;S IO(0)="/dev/pts/0"
"RTN","C0PEWD2",63,0)
 ;S IO(1,"/dev/pts/0")=""
"RTN","C0PEWD2",64,0)
 ;S IO("ERROR")=""
"RTN","C0PEWD2",65,0)
 ;S IO("HOME")="50^/dev/pts/0"
"RTN","C0PEWD2",66,0)
 ;S IO("ZIO")="/dev/pts/0"
"RTN","C0PEWD2",67,0)
 ;S IOBS="$C(8)"
"RTN","C0PEWD2",68,0)
 ;S IOF="!!!!!!!!!!!!!!!!!!!!!!!!,#,$C(27,91,50,74,27,91,72)"
"RTN","C0PEWD2",69,0)
 ;S IOM=80
"RTN","C0PEWD2",70,0)
 ;S ION="GTM/UNIX TELNET"
"RTN","C0PEWD2",71,0)
 ;S IOS=50
"RTN","C0PEWD2",72,0)
 ;S IOSL=24
"RTN","C0PEWD2",73,0)
 ;S IOST="C-VT100"
"RTN","C0PEWD2",74,0)
 ;S IOST(0)=9
"RTN","C0PEWD2",75,0)
 ;S IOT="VTRM"
"RTN","C0PEWD2",76,0)
 ;S IOXY="W $C(27,91)_((DY+1))_$C(59)_((DX+1))_$C(72)"
"RTN","C0PEWD2",77,0)
 S U="^"
"RTN","C0PEWD2",78,0)
 S X="1;DIC(4.2,"
"RTN","C0PEWD2",79,0)
 S XPARSYS="1;DIC(4.2,"
"RTN","C0PEWD2",80,0)
 S XQXFLG="^^XUP"
"RTN","C0PEWD2",81,0)
 S Y="DEV^VISTA^hollywood^VISTA:hollywood"
"RTN","C0PEWD2",82,0)
 Q
"RTN","C0PEWD2",83,0)
 ;
"RTN","C0PEWD2",84,0)
gpltest2(zduz,zdfn) ; experiment with passing parameters from trigger
"RTN","C0PEWD2",85,0)
 W "<br><b>SESSIONID:",zduz,"</b><br><hr>"
"RTN","C0PEWD2",86,0)
 W "HELLO WORLD<hr>",!
"RTN","C0PEWD2",87,0)
 I $D(req4) ZWRITE req4
"RTN","C0PEWD2",88,0)
 w "<hr>"
"RTN","C0PEWD2",89,0)
 W "DFN=",$G(req4("DFN",1)),"<br>"
"RTN","C0PEWD2",90,0)
 w "DUZ=",$G(req4("DUZ",1)),"<hr>"
"RTN","C0PEWD2",91,0)
 ;ZWR
"RTN","C0PEWD2",92,0)
 Q
"RTN","C0PEWD2",93,0)
 ;
"RTN","C0PEWD2",94,0)
gpltest(GPLV1) ; experiment with sending a CCR to an ewd page
"RTN","C0PEWD2",95,0)
 N ZI
"RTN","C0PEWD2",96,0)
 S ZI=""
"RTN","C0PEWD2",97,0)
 ;W "HELLO WORLD!",!
"RTN","C0PEWD2",98,0)
 ;Q
"RTN","C0PEWD2",99,0)
 F  S ZI=$O(^GPL(ZI)) Q:ZI=""  W ^GPL(ZI),!
"RTN","C0PEWD2",100,0)
 Q
"RTN","C0PEWD2",101,0)
 ;
"RTN","C0PEWD2",102,0)
TESTSSL ;
"RTN","C0PEWD2",103,0)
 s URL="https://preproduction.newcropaccounts.com/InterfaceV7/NewrxFDB.xml"
"RTN","C0PEWD2",104,0)
 D GET1URL(URL) ;
"RTN","C0PEWD2",105,0)
 Q
"RTN","C0PEWD2",106,0)
 ;
"RTN","C0PEWD2",107,0)
TEST2 ;
"RTN","C0PEWD2",108,0)
 ; httpPOST(url,payload,mimeType,html,headerArray,timeout,test,rawResponse,respHeaders,sslHost,sslPort)
"RTN","C0PEWD2",109,0)
 ;
"RTN","C0PEWD2",110,0)
 s URL="http://preproduction.newcropaccounts.com/InterfaceV7/Doctor.xml"
"RTN","C0PEWD2",111,0)
 D GET1URL(URL) ;
"RTN","C0PEWD2",112,0)
 s gpl4(2)="<NCScript xmlns=""http://secure.newcropaccounts.com/interfaceV7"""
"RTN","C0PEWD2",113,0)
 s g1="xmlns:NCStandard="
"RTN","C0PEWD2",114,0)
 s g2="""http://secure.newcropaccounts.com/interfaceV7:NCStandard"""
"RTN","C0PEWD2",115,0)
 s gpl4(2)=gpl4(2)_" "_g1_g2
"RTN","C0PEWD2",116,0)
 s gpl4(2)=gpl4(2)_" xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"">"
"RTN","C0PEWD2",117,0)
 k gpl4(0) ; array size node
"RTN","C0PEWD2",118,0)
 s gpl4(3)="<Account ID=""demo"">"
"RTN","C0PEWD2",119,0)
 s gpl4(40)="<Location ID=""DEMOLOC1"">"
"RTN","C0PEWD2",120,0)
 s gpl4(28)="<LicensedPrescriber ID=""DEMOLP1"">"
"RTN","C0PEWD2",121,0)
 s gpl4(55)="<Patient ID=""DEMOPT1"">"
"RTN","C0PEWD2",122,0)
 W $$OUTPUT^C0CXPATH("gpl4(1)","NewCropV7-DOCTOR.xml","/home/dev/CCR/"),!
"RTN","C0PEWD2",123,0)
 S ok=$$httpPOST^%zewdGTM("https://preproduction.newcropaccounts.com/InterfaceV7/RxEntry.aspx",.gpl4,"Content-Type: text/html",.gpl6,"","",.gpl5,.gpl7)
"RTN","C0PEWD2",124,0)
 ZWRITE gpl6
"RTN","C0PEWD2",125,0)
 q
"RTN","C0PEWD2",126,0)
 ;
"RTN","C0PEWD2",127,0)
TEST3 ;
"RTN","C0PEWD2",128,0)
 ; httpPOST(url,payload,mimeType,html,headerArray,timeout,test,rawResponse,respHeaders,sslHost,sslPort)
"RTN","C0PEWD2",129,0)
 ;
"RTN","C0PEWD2",130,0)
 s URL="http://preproduction.newcropaccounts.com/InterfaceV7/Doctor.xml"
"RTN","C0PEWD2",131,0)
 D GET1URL(URL) ;
"RTN","C0PEWD2",132,0)
 N I,J
"RTN","C0PEWD2",133,0)
 S J=$O(gpl(""),-1) ; count of things in gpl
"RTN","C0PEWD2",134,0)
 F I=1:1:J S gpl(I)=$$CLEAN^C0PEWDU(gpl(I))
"RTN","C0PEWD2",135,0)
 K gpl(0)
"RTN","C0PEWD2",136,0)
 S gpl(1)="RxInput="_gpl(1)
"RTN","C0PEWD2",137,0)
 S url="https://preproduction.newcropaccounts.com/InterfaceV7/RxEntry.aspx"
"RTN","C0PEWD2",138,0)
 W $$OUTPUT^C0CXPATH("gpl(1)","NewCropV7-DOCTOR2.xml","/home/dev/CCR/"),!
"RTN","C0PEWD2",139,0)
 ; S ok=$$httpPOST^%zewdGTM("https://preproduction.newcropaccounts.com/InterfaceV7/RxEntry.aspx",.gpl,"application/x-www-form-urlencoded",.gpl6,"","",.gpl5,.gpl7)
"RTN","C0PEWD2",140,0)
 S ok=$$httpPOST^%zewdGTM("https://preproduction.newcropaccounts.com/InterfaceV7/ComposeRX.aspx",.gpl,"application/x-www-form-urlencoded",.gpl6,"","",.gpl5,.gpl7)
"RTN","C0PEWD2",141,0)
 ZWRITE gpl6
"RTN","C0PEWD2",142,0)
 q
"RTN","C0PEWD2",143,0)
 ;
"RTN","C0PEWD2",144,0)
TEST ;
"RTN","C0PEWD2",145,0)
 ;s URL="https://preproduction.newcropaccounts.com/InterfaceV7/NewrxFDB.xml"
"RTN","C0PEWD2",146,0)
   ; D GET1URL(URL) ;
"RTN","C0PEWD2",147,0)
 ;Q
"RTN","C0PEWD2",148,0)
 S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NCScript-RegisterLP.xml"
"RTN","C0PEWD2",149,0)
 D GET1URL(URL)
"RTN","C0PEWD2",150,0)
 S URL="http://preproduction.newcropaccounts.com/InterfaceV7/GenTestRenewalFDB.xml"
"RTN","C0PEWD2",151,0)
 D GET1URL(URL)
"RTN","C0PEWD2",152,0)
 S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NewrxFDB.xml"
"RTN","C0PEWD2",153,0)
 D GET1URL(URL)
"RTN","C0PEWD2",154,0)
 S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NewrxRxNorm.xml"
"RTN","C0PEWD2",155,0)
 D GET1URL(URL)
"RTN","C0PEWD2",156,0)
 S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NewrxExternalDrugOpt1.xml"
"RTN","C0PEWD2",157,0)
 D GET1URL(URL)
"RTN","C0PEWD2",158,0)
 S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NewrxExternalDrugOpt2.xml"
"RTN","C0PEWD2",159,0)
 D GET1URL(URL)
"RTN","C0PEWD2",160,0)
 S URL="http://preproduction.newcropaccounts.com/InterfaceV7/RenewalResponseAccept.xml"
"RTN","C0PEWD2",161,0)
 D GET1URL(URL)
"RTN","C0PEWD2",162,0)
 S URL="http://preproduction.newcropaccounts.com/InterfaceV7/RenewalResponseDeny.xml"
"RTN","C0PEWD2",163,0)
 D GET1URL(URL)
"RTN","C0PEWD2",164,0)
 Q
"RTN","C0PEWD2",165,0)
 ;
"RTN","C0PEWD2",166,0)
GET1URL0(URL) ; 
"RTN","C0PEWD2",167,0)
 s ok=$$httpGET^%zewdGTM(URL,.gpl)
"RTN","C0PEWD2",168,0)
 D INDEX^C0CXPATH("gpl","gpl2")
"RTN","C0PEWD2",169,0)
 W !,"S URL=""",URL,"""",!
"RTN","C0PEWD2",170,0)
 S G=""
"RTN","C0PEWD2",171,0)
 F  S G=$O(gpl2(G)) Q:G=""  D  ;
"RTN","C0PEWD2",172,0)
 . W " S VDX(""",G,""")=""",gpl2(G),"""",!
"RTN","C0PEWD2",173,0)
 W !
"RTN","C0PEWD2",174,0)
 Q
"RTN","C0PEWD2",175,0)
 ;
"RTN","C0PEWD2",176,0)
GET1URL(URL) ;
"RTN","C0PEWD2",177,0)
 s ok=$$httpGET^%zewdGTM(URL,.gpl)
"RTN","C0PEWD2",178,0)
 W "XML retrieved from Web Service:",!
"RTN","C0PEWD2",179,0)
 ZWRITE gpl
"RTN","C0PEWD2",180,0)
 D INDEX^C0CXPATH("gpl","gpl2",-1,"gplTEMP")
"RTN","C0PEWD2",181,0)
 W "VDX array displayed as a prototype Mumps routine:",!
"RTN","C0PEWD2",182,0)
 W !,"S URL=""",URL,"""",!
"RTN","C0PEWD2",183,0)
 S G=""
"RTN","C0PEWD2",184,0)
 F  S G=$O(gpl2(G)) Q:G=""  D  ;
"RTN","C0PEWD2",185,0)
 . W " S VDX(""",G,""")=""",gpl2(G),"""",!
"RTN","C0PEWD2",186,0)
 W !
"RTN","C0PEWD2",187,0)
 D VDX2XPG^C0CXPATH("gpl3","gpl2")
"RTN","C0PEWD2",188,0)
 W "Conversion of VDX array to XPG format:",!
"RTN","C0PEWD2",189,0)
 ZWRITE gpl3
"RTN","C0PEWD2",190,0)
 W "Conversion of XPG array to XML:",!
"RTN","C0PEWD2",191,0)
 D XPG2XML^C0CXPATH("gpl4","gpl3")
"RTN","C0PEWD2",192,0)
 ZWRITE gpl4
"RTN","C0PEWD2",193,0)
 Q
"RTN","C0PEWD2",194,0)
 ;
"RTN","C0PEWD4")
0^13^B26192887
"RTN","C0PEWD4",1,0)
C0PEWD4   ; CCDCCR/GPL - ePrescription utilities; 4/24/09 ; 5/8/12 10:23pm
"RTN","C0PEWD4",2,0)
 ;;1.0;C0P;;Apr 25, 2012;Build 103
"RTN","C0PEWD4",3,0)
 ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"RTN","C0PEWD4",4,0)
 ;General Public License See attached copy of the License.
"RTN","C0PEWD4",5,0)
 ;
"RTN","C0PEWD4",6,0)
 ;This program is free software; you can redistribute it and/or modify
"RTN","C0PEWD4",7,0)
 ;it under the terms of the GNU General Public License as published by
"RTN","C0PEWD4",8,0)
 ;the Free Software Foundation; either version 2 of the License, or
"RTN","C0PEWD4",9,0)
 ;(at your option) any later version.
"RTN","C0PEWD4",10,0)
 ;
"RTN","C0PEWD4",11,0)
 ;This program is distributed in the hope that it will be useful,
"RTN","C0PEWD4",12,0)
 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0PEWD4",13,0)
 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"RTN","C0PEWD4",14,0)
 ;GNU General Public License for more details.
"RTN","C0PEWD4",15,0)
 ;
"RTN","C0PEWD4",16,0)
 ;You should have received a copy of the GNU General Public License along
"RTN","C0PEWD4",17,0)
 ;with this program; if not, write to the Free Software Foundation, Inc.,
"RTN","C0PEWD4",18,0)
 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
"RTN","C0PEWD4",19,0)
 ;
"RTN","C0PEWD4",20,0)
 Q
"RTN","C0PEWD4",21,0)
 ; TEST Lines below not intended for End Users. Programmers only.
"RTN","C0PEWD4",22,0)
 ; BEWARE ZWRITE SYNTAX. It may not work in other M Implementations.
"RTN","C0PEWD4",23,0)
gpltest ; experiment with sending a CCR to an ewd page
"RTN","C0PEWD4",24,0)
 N ZI
"RTN","C0PEWD4",25,0)
 S ZI=""
"RTN","C0PEWD4",26,0)
 W "HELLO WORLD!",!
"RTN","C0PEWD4",27,0)
 Q 1
"RTN","C0PEWD4",28,0)
 F  S ZI=$O(^GPL(ZI)) Q:ZI=""  W ^GPL(ZI)
"RTN","C0PEWD4",29,0)
 Q
"RTN","C0PEWD4",30,0)
 ;
"RTN","C0PEWD4",31,0)
TESTSSL ;
"RTN","C0PEWD4",32,0)
 s URL="https://preproduction.newcropaccounts.com/InterfaceV7/NewrxFDB.xml"
"RTN","C0PEWD4",33,0)
 D GET1URL(URL) ;
"RTN","C0PEWD4",34,0)
 Q
"RTN","C0PEWD4",35,0)
 ;
"RTN","C0PEWD4",36,0)
TEST2 ;
"RTN","C0PEWD4",37,0)
 ; httpPOST(url,payload,mimeType,html,headerArray,timeout,test,rawResponse,respHeaders,sslHost,sslPort)
"RTN","C0PEWD4",38,0)
 ;
"RTN","C0PEWD4",39,0)
 s URL="http://preproduction.newcropaccounts.com/InterfaceV7/Doctor.xml"
"RTN","C0PEWD4",40,0)
 D GET1URL(URL) ;
"RTN","C0PEWD4",41,0)
 s gpl4(2)="<NCScript xmlns=""http://secure.newcropaccounts.com/interfaceV7"""
"RTN","C0PEWD4",42,0)
 s g1="xmlns:NCStandard="
"RTN","C0PEWD4",43,0)
 s g2="""http://secure.newcropaccounts.com/interfaceV7:NCStandard"""
"RTN","C0PEWD4",44,0)
 s gpl4(2)=gpl4(2)_" "_g1_g2
"RTN","C0PEWD4",45,0)
 s gpl4(2)=gpl4(2)_" xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"">"
"RTN","C0PEWD4",46,0)
 k gpl4(0) ; array size node
"RTN","C0PEWD4",47,0)
 s gpl4(3)="<Account ID=""demo"">"
"RTN","C0PEWD4",48,0)
 s gpl4(40)="<Location ID=""DEMOLOC1"">"
"RTN","C0PEWD4",49,0)
 s gpl4(28)="<LicensedPrescriber ID=""DEMOLP1"">"
"RTN","C0PEWD4",50,0)
 s gpl4(55)="<Patient ID=""DEMOPT1"">"
"RTN","C0PEWD4",51,0)
 W $$OUTPUT^C0CXPATH("gpl4(1)","NewCropV7-DOCTOR.xml","/home/dev/CCR/"),!
"RTN","C0PEWD4",52,0)
 S ok=$$httpPOST^%zewdGTM("https://preproduction.newcropaccounts.com/InterfaceV7/RxEntry.aspx",.gpl4,"Content-Type: text/html",.gpl6,"","",.gpl5,.gpl7)
"RTN","C0PEWD4",53,0)
 ZWRITE gpl6
"RTN","C0PEWD4",54,0)
 q
"RTN","C0PEWD4",55,0)
 ;
"RTN","C0PEWD4",56,0)
TEST3 ;
"RTN","C0PEWD4",57,0)
 ; httpPOST(url,payload,mimeType,html,headerArray,timeout,test,rawResponse,respHeaders,sslHost,sslPort)
"RTN","C0PEWD4",58,0)
 ;
"RTN","C0PEWD4",59,0)
 s URL="http://preproduction.newcropaccounts.com/InterfaceV7/Doctor.xml"
"RTN","C0PEWD4",60,0)
 D GET1URL(URL) ;
"RTN","C0PEWD4",61,0)
 N I,J
"RTN","C0PEWD4",62,0)
 S J=$O(gpl(""),-1) ; count of things in gpl
"RTN","C0PEWD4",63,0)
 F I=1:1:J S gpl(I)=$$CLEAN^C0PEWDU(gpl(I))
"RTN","C0PEWD4",64,0)
 K gpl(0)
"RTN","C0PEWD4",65,0)
 S gpl(1)="RxInput="_gpl(1)
"RTN","C0PEWD4",66,0)
 S url="https://preproduction.newcropaccounts.com/InterfaceV7/RxEntry.aspx"
"RTN","C0PEWD4",67,0)
 W $$OUTPUT^C0CXPATH("gpl(1)","NewCropV7-DOCTOR2.xml","/home/dev/CCR/"),!
"RTN","C0PEWD4",68,0)
 ; S ok=$$httpPOST^%zewdGTM("https://preproduction.newcropaccounts.com/InterfaceV7/RxEntry.aspx",.gpl,"application/x-www-form-urlencoded",.gpl6,"","",.gpl5,.gpl7)
"RTN","C0PEWD4",69,0)
 S ok=$$httpPOST^%zewdGTM("https://preproduction.newcropaccounts.com/InterfaceV7/ComposeRX.aspx",.gpl,"application/x-www-form-urlencoded",.gpl6,"","",.gpl5,.gpl7)
"RTN","C0PEWD4",70,0)
 ZWRITE gpl6
"RTN","C0PEWD4",71,0)
 q
"RTN","C0PEWD4",72,0)
 ;
"RTN","C0PEWD4",73,0)
TEST ;
"RTN","C0PEWD4",74,0)
 ;s URL="https://preproduction.newcropaccounts.com/InterfaceV7/NewrxFDB.xml"
"RTN","C0PEWD4",75,0)
   ; D GET1URL(URL) ;
"RTN","C0PEWD4",76,0)
 ;Q
"RTN","C0PEWD4",77,0)
 S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NCScript-RegisterLP.xml"
"RTN","C0PEWD4",78,0)
 D GET1URL(URL)
"RTN","C0PEWD4",79,0)
 S URL="http://preproduction.newcropaccounts.com/InterfaceV7/GenTestRenewalFDB.xml"
"RTN","C0PEWD4",80,0)
 D GET1URL(URL)
"RTN","C0PEWD4",81,0)
 S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NewrxFDB.xml"
"RTN","C0PEWD4",82,0)
 D GET1URL(URL)
"RTN","C0PEWD4",83,0)
 S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NewrxRxNorm.xml"
"RTN","C0PEWD4",84,0)
 D GET1URL(URL)
"RTN","C0PEWD4",85,0)
 S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NewrxExternalDrugOpt1.xml"
"RTN","C0PEWD4",86,0)
 D GET1URL(URL)
"RTN","C0PEWD4",87,0)
 S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NewrxExternalDrugOpt2.xml"
"RTN","C0PEWD4",88,0)
 D GET1URL(URL)
"RTN","C0PEWD4",89,0)
 S URL="http://preproduction.newcropaccounts.com/InterfaceV7/RenewalResponseAccept.xml"
"RTN","C0PEWD4",90,0)
 D GET1URL(URL)
"RTN","C0PEWD4",91,0)
 S URL="http://preproduction.newcropaccounts.com/InterfaceV7/RenewalResponseDeny.xml"
"RTN","C0PEWD4",92,0)
 D GET1URL(URL)
"RTN","C0PEWD4",93,0)
 Q
"RTN","C0PEWD4",94,0)
 ;
"RTN","C0PEWD4",95,0)
GET1URL0(URL) ; 
"RTN","C0PEWD4",96,0)
 s ok=$$httpGET^%zewdGTM(URL,.gpl)
"RTN","C0PEWD4",97,0)
 D INDEX^C0CXPATH("gpl","gpl2")
"RTN","C0PEWD4",98,0)
 W !,"S URL=""",URL,"""",!
"RTN","C0PEWD4",99,0)
 S G=""
"RTN","C0PEWD4",100,0)
 F  S G=$O(gpl2(G)) Q:G=""  D  ;
"RTN","C0PEWD4",101,0)
 . W " S VDX(""",G,""")=""",gpl2(G),"""",!
"RTN","C0PEWD4",102,0)
 W !
"RTN","C0PEWD4",103,0)
 Q
"RTN","C0PEWD4",104,0)
 ;
"RTN","C0PEWD4",105,0)
GET1URL(URL) ;
"RTN","C0PEWD4",106,0)
 s ok=$$httpGET^%zewdGTM(URL,.gpl)
"RTN","C0PEWD4",107,0)
 W "XML retrieved from Web Service:",!
"RTN","C0PEWD4",108,0)
 ZWRITE gpl
"RTN","C0PEWD4",109,0)
 D INDEX^C0CXPATH("gpl","gpl2",-1,"gplTEMP")
"RTN","C0PEWD4",110,0)
 W "VDX array displayed as a prototype Mumps routine:",!
"RTN","C0PEWD4",111,0)
 W !,"S URL=""",URL,"""",!
"RTN","C0PEWD4",112,0)
 S G=""
"RTN","C0PEWD4",113,0)
 F  S G=$O(gpl2(G)) Q:G=""  D  ;
"RTN","C0PEWD4",114,0)
 . W " S VDX(""",G,""")=""",gpl2(G),"""",!
"RTN","C0PEWD4",115,0)
 W !
"RTN","C0PEWD4",116,0)
 D VDX2XPG^C0CXPATH("gpl3","gpl2")
"RTN","C0PEWD4",117,0)
 W "Conversion of VDX array to XPG format:",!
"RTN","C0PEWD4",118,0)
 ZWRITE gpl3
"RTN","C0PEWD4",119,0)
 W "Conversion of XPG array to XML:",!
"RTN","C0PEWD4",120,0)
 D XPG2XML^C0CXPATH("gpl4","gpl3")
"RTN","C0PEWD4",121,0)
 ZWRITE gpl4
"RTN","C0PEWD4",122,0)
 Q
"RTN","C0PEWD4",123,0)
 ;
"RTN","C0PEWDU")
0^12^B2700278
"RTN","C0PEWDU",1,0)
C0PEWDU ; WV/SMH - E-prescription utilities; Mar 3 2009 ; 5/4/12 4:25pm
"RTN","C0PEWDU",2,0)
 ;;1.0;C0P;;Apr 25, 2012;Build 103
"RTN","C0PEWDU",3,0)
 ;Copyright 2009 Sam Habiel.  Licensed under the terms of the GNU
"RTN","C0PEWDU",4,0)
 ;General Public License See attached copy of the License.
"RTN","C0PEWDU",5,0)
 ;
"RTN","C0PEWDU",6,0)
 ;This program is free software; you can redistribute it and/or modify
"RTN","C0PEWDU",7,0)
 ;it under the terms of the GNU General Public License as published by
"RTN","C0PEWDU",8,0)
 ;the Free Software Foundation; either version 2 of the License, or
"RTN","C0PEWDU",9,0)
 ;(at your option) any later version.
"RTN","C0PEWDU",10,0)
 ;
"RTN","C0PEWDU",11,0)
 ;This program is distributed in the hope that it will be useful,
"RTN","C0PEWDU",12,0)
 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0PEWDU",13,0)
 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"RTN","C0PEWDU",14,0)
 ;GNU General Public License for more details.
"RTN","C0PEWDU",15,0)
 ;
"RTN","C0PEWDU",16,0)
 ;You should have received a copy of the GNU General Public License along
"RTN","C0PEWDU",17,0)
 ;with this program; if not, write to the Free Software Foundation, Inc.,
"RTN","C0PEWDU",18,0)
 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
"RTN","C0PEWDU",19,0)
 ;
"RTN","C0PEWDU",20,0)
 Q
"RTN","C0PEWDU",21,0)
 ;
"RTN","C0PEWDU",22,0)
CLEAN(STR) ; extrinsic function; returns string
"RTN","C0PEWDU",23,0)
 ;; Removes all non printable characters from a string.
"RTN","C0PEWDU",24,0)
 ;; STR by Value
"RTN","C0PEWDU",25,0)
 N TR,I
"RTN","C0PEWDU",26,0)
 F I=0:1:31 S TR=$G(TR)_$C(I)
"RTN","C0PEWDU",27,0)
 S TR=TR_$C(127)
"RTN","C0PEWDU",28,0)
 QUIT $TR(STR,TR)
"RTN","C0PEWDU",29,0)
 ;
"RTN","C0PEWDU",30,0)
GETSOAP(ENTRY,REQUEST,RESULT) ; XML SOAP Spec for NewCrop
"RTN","C0PEWDU",31,0)
 ;; Gets world processing field from Fileman for Parsing
"RTN","C0PEWDU",32,0)
 ;; ENTRY Input by Value
"RTN","C0PEWDU",33,0)
 ;; REQUEST XML Output by Reference
"RTN","C0PEWDU",34,0)
 ;; RESULT XML Output by Reference
"RTN","C0PEWDU",35,0)
 ;; Example call: D GETSOAP^C0PEWDU("DrugAllergyInteraction",.REQ,.RES)
"RTN","C0PEWDU",36,0)
 ;
"RTN","C0PEWDU",37,0)
 N OK,ERR,IEN,F  ; if call is okay, Error, IEN, File
"RTN","C0PEWDU",38,0)
 S F=175.101
"RTN","C0PEWDU",39,0)
 S IEN=$$FIND1^DIC(F,"","",ENTRY,"B")
"RTN","C0PEWDU",40,0)
 S OK=$$GET1^DIQ(F,IEN,2,"","REQUEST","ERR")
"RTN","C0PEWDU",41,0)
 I OK=""!($D(ERR)) S REQUEST=""
"RTN","C0PEWDU",42,0)
 ; M ^CacheTempEWD($j)=REQUEST
"RTN","C0PEWDU",43,0)
 ; K REQUEST
"RTN","C0PEWDU",44,0)
 ; S ok=$$parseDocument^%zewdHTMLParser("REQUEST",0)
"RTN","C0PEWDU",45,0)
 ; S ok=$$outputDOM^%zewdDOM("REQUEST",1,1)
"RTN","C0PEWDU",46,0)
 ; Q  ; remove later
"RTN","C0PEWDU",47,0)
 K OK,ERR
"RTN","C0PEWDU",48,0)
 S OK=$$GET1^DIQ(F,IEN,3,"","RESULT","ERR")
"RTN","C0PEWDU",49,0)
 I OK=""!($D(ERR)) S RESULT=""
"RTN","C0PEWDU",50,0)
 QUIT
"RTN","C0PEWDU",51,0)
 ;
"RTN","C0PKIDS")
0^33^B189289667
"RTN","C0PKIDS",1,0)
C0PKIDS ; VEN/SMH - eRx KIDS Utilities ; 5/19/12 4:46pm
"RTN","C0PKIDS",2,0)
    ;;1.0;C0P;;Apr 25, 2012;Build 103
"RTN","C0PKIDS",3,0)
    ; (C) Sam Habiel 2012
"RTN","C0PKIDS",4,0)
    ;
"RTN","C0PKIDS",5,0)
    ;Copyright 2012 Sam Habiel.  Licensed under the terms of the GNU
"RTN","C0PKIDS",6,0)
    ;General Public License See attached copy of the License.
"RTN","C0PKIDS",7,0)
    ;
"RTN","C0PKIDS",8,0)
    ;This program is free software; you can redistribute it and/or modify
"RTN","C0PKIDS",9,0)
    ;it under the terms of the GNU General Public License as published by
"RTN","C0PKIDS",10,0)
    ;the Free Software Foundation; either version 2 of the License, or
"RTN","C0PKIDS",11,0)
    ;(at your option) any later version.
"RTN","C0PKIDS",12,0)
    ;
"RTN","C0PKIDS",13,0)
    ;This program is distributed in the hope that it will be useful,
"RTN","C0PKIDS",14,0)
    ;but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0PKIDS",15,0)
    ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"RTN","C0PKIDS",16,0)
    ;GNU General Public License for more details.
"RTN","C0PKIDS",17,0)
    ;
"RTN","C0PKIDS",18,0)
    ;You should have received a copy of the GNU General Public License along
"RTN","C0PKIDS",19,0)
    ;with this program; if not, write to the Free Software Foundation, Inc.,
"RTN","C0PKIDS",20,0)
    ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
"RTN","C0PKIDS",21,0)
    ;
"RTN","C0PKIDS",22,0)
    ; This routine contains utilities for KIDS distribution of E-Rx.
"RTN","C0PKIDS",23,0)
    ;
"RTN","C0PKIDS",24,0)
    ; PEPs:
"RTN","C0PKIDS",25,0)
    ; For RxNorm dist: RXNTRAN,RXNPOST
"RTN","C0PKIDS",26,0)
    ; For FDB files: FDBTRAN,FDBPOST
"RTN","C0PKIDS",27,0)
    ; For C0P 1.0: POST
"RTN","C0PKIDS",28,0)
    ;
"RTN","C0PKIDS",29,0)
    ;
"RTN","C0PKIDS",30,0)
ENV ; Environment Check
"RTN","C0PKIDS",31,0)
    ; If EWD version is less than 800, don't install
"RTN","C0PKIDS",32,0)
    I $$TRIM^XLFSTR($G(^%zewd("version")))<800 DO  QUIT
"RTN","C0PKIDS",33,0)
    . W "A recent version of EWD must be installed before installing ",!
"RTN","C0PKIDS",34,0)
    . W "e-Prescribing. Installation cannot continue.",!
"RTN","C0PKIDS",35,0)
    . S XPDQUIT=1
"RTN","C0PKIDS",36,0)
    ; Check if C0C 1.1 is installed
"RTN","C0PKIDS",37,0)
    QUIT
"RTN","C0PKIDS",38,0)
POST ; Main Post Installation routine
"RTN","C0PKIDS",39,0)
    ;
"RTN","C0PKIDS",40,0)
    ; KIDS will file the modified RPs ORWPS COVER and ORWPS DETAIL
"RTN","C0PKIDS",41,0)
    ; KIDS will install the Mail Group ERX HELP DESK
"RTN","C0PKIDS",42,0)
    ;
"RTN","C0PKIDS",43,0)
    D MES^XPDUTL("Adding E-Prescribing RPCs to CPRS Broker Context")
"RTN","C0PKIDS",44,0)
    D REGNMSP("C0P","OR CPRS GUI CHART") ; Register C0P RPs to the Broker Context
"RTN","C0PKIDS",45,0)
    ;
"RTN","C0PKIDS",46,0)
    ; Add two alerts to the OE/RR Notifications file
"RTN","C0PKIDS",47,0)
    D MES^XPDUTL("Adding E-Prescribing Notifications to the OE/RR Notification File")
"RTN","C0PKIDS",48,0)
    ;
"RTN","C0PKIDS",49,0)
    N C0PFDA
"RTN","C0PKIDS",50,0)
    ; Entry 1                                                                   
"RTN","C0PKIDS",51,0)
    S C0PFDA(100.9,"?+1,",.001)=11305                       ; NUMBER            
"RTN","C0PKIDS",52,0)
    S C0PFDA(100.9,"?+1,",.01)="C0P ERX REFILL REQUEST"     ; NAME              
"RTN","C0PKIDS",53,0)
    ; .02 is not filled out, but triggered by the .01                           
"RTN","C0PKIDS",54,0)
    S C0PFDA(100.9,"?+1,",.03)="ERX REFILL REQUEST"         ; MESSAGE TEXT      
"RTN","C0PKIDS",55,0)
    S C0PFDA(100.9,"?+1,",.04)="PKG"                        ; MESSAGE TYPE      
"RTN","C0PKIDS",56,0)
    S C0PFDA(100.9,"?+1,",.05)="R"                          ; ACTION FLAG       
"RTN","C0PKIDS",57,0)
    S C0PFDA(100.9,"?+1,",.06)="RUN"                        ; ENTRY POINT       
"RTN","C0PKIDS",58,0)
    S C0PFDA(100.9,"?+1,",.07)="C0PREFIL"                   ; ROUTINE NAME      
"RTN","C0PKIDS",59,0)
    S C0PFDA(100.9,"?+1,",1.5)="OR"                         ; RELATED PACKAGE   
"RTN","C0PKIDS",60,0)
    S C0PFDA(100.9,"?+1,",4)="Used by the C0P eRx package for eRx Refill Requests"
"RTN","C0PKIDS",61,0)
    ;                                                                           
"RTN","C0PKIDS",62,0)
    ; Entry 2                                                                   
"RTN","C0PKIDS",63,0)
    S C0PFDA(100.9,"?+2,",.001)=11306                       ; NUMBER            
"RTN","C0PKIDS",64,0)
    S C0PFDA(100.9,"?+2,",.01)="C0P ERX INCOMPLETE ORDER"   ; NAME              
"RTN","C0PKIDS",65,0)
    ; .02 is not filled out, but triggered by the .01                           
"RTN","C0PKIDS",66,0)
    S C0PFDA(100.9,"?+2,",.03)="ERX INCOMPLETE ORDER"       ; MESSAGE TEXT      
"RTN","C0PKIDS",67,0)
    S C0PFDA(100.9,"?+2,",.04)="PKG"                        ; MESSAGE TYPE      
"RTN","C0PKIDS",68,0)
    S C0PFDA(100.9,"?+2,",.05)="R"                          ; ACTION FLAG       
"RTN","C0PKIDS",69,0)
    S C0PFDA(100.9,"?+2,",.06)="STATUS"                     ; ENTRY POINT       
"RTN","C0PKIDS",70,0)
    S C0PFDA(100.9,"?+2,",.07)="C0PREFIL"                   ; ROUTINE NAME      
"RTN","C0PKIDS",71,0)
    S C0PFDA(100.9,"?+2,",1.5)="OR"                         ; RELATED PACKAGE   
"RTN","C0PKIDS",72,0)
    S C0PFDA(100.9,"?+2,",4)="Used by the C0P eRx package for eRx Incomplete Order Alerts"
"RTN","C0PKIDS",73,0)
    ;                                                                           
"RTN","C0PKIDS",74,0)
    N C0PERR           ; Errors go here.                                                         
"RTN","C0PKIDS",75,0)
    D UPDATE^DIE("","C0PFDA","","C0PERR") ; no flags, FDA, ien_root, msg_root   
"RTN","C0PKIDS",76,0)
    ;
"RTN","C0PKIDS",77,0)
    ; ew ew ew I hate $Q... still don't understand it.
"RTN","C0PKIDS",78,0)
    I $D(C0PERR) D
"RTN","C0PKIDS",79,0)
    . D MES^XPDUTL("WARNING: Updating the OE/RR Notification file failed.")
"RTN","C0PKIDS",80,0)
    . S C0PERR=$Q(C0PERR)
"RTN","C0PKIDS",81,0)
    . F  S C0PERR=$Q(@C0PERR) Q:C0PERR=""  D MES^XPDUTL(C0PERR_": "_@C0PERR)
"RTN","C0PKIDS",82,0)
    ;
"RTN","C0PKIDS",83,0)
    ; Done with that; now add the x-ref to file 200 on the NPI field.
"RTN","C0PKIDS",84,0)
    ; Thank you to D ^DIKCBLD for writing this for me!
"RTN","C0PKIDS",85,0)
    ;
"RTN","C0PKIDS",86,0)
    D MES^XPDUTL("Adding NPI Cross Reference to New Person File")
"RTN","C0PKIDS",87,0)
    N C0PXR,C0PRES,C0POUT,C0PERR
"RTN","C0PKIDS",88,0)
    S C0PXR("FILE")=200
"RTN","C0PKIDS",89,0)
    S C0PXR("NAME")="C0PNPI"
"RTN","C0PKIDS",90,0)
    S C0PXR("TYPE")="R"
"RTN","C0PKIDS",91,0)
    S C0PXR("USE")="LS"
"RTN","C0PKIDS",92,0)
    S C0PXR("EXECUTION")="F"
"RTN","C0PKIDS",93,0)
    S C0PXR("ACTIVITY")="IR"
"RTN","C0PKIDS",94,0)
    S C0PXR("SHORT DESCR")="Regular index on NPI for eRx"
"RTN","C0PKIDS",95,0)
    S C0PXR("VAL",1)=41.99
"RTN","C0PKIDS",96,0)
    S C0PXR("VAL",1,"SUBSCRIPT")=1
"RTN","C0PKIDS",97,0)
    S C0PXR("VAL",1,"LENGTH")=30
"RTN","C0PKIDS",98,0)
    S C0PXR("VAL",1,"COLLATION")="F"
"RTN","C0PKIDS",99,0)
    D CREIXN^DDMOD(.C0PXR,"S",.C0PRES,"C0POUT","C0PERR")
"RTN","C0PKIDS",100,0)
    I $D(C0PERR) D MES^XPDUTL("NPI Cross-Reference Creation on File 200 failed")
"RTN","C0PKIDS",101,0)
    ;
"RTN","C0PKIDS",102,0)
    ; Ditto: Add the x-ref to file 50 on the PSNDF VA PRODUCT NAME ENTRY
"RTN","C0PKIDS",103,0)
    D MES^XPDUTL("Adding PSNDF VA PRODUCT NAME ENTRY xref to Drug File")
"RTN","C0PKIDS",104,0)
    N C0PXR,C0PRES,C0POUT,C0PERR
"RTN","C0PKIDS",105,0)
    S C0PXR("FILE")=50
"RTN","C0PKIDS",106,0)
    S C0PXR("NAME")="AC0P"
"RTN","C0PKIDS",107,0)
    S C0PXR("TYPE")="R"
"RTN","C0PKIDS",108,0)
    S C0PXR("USE")="S"
"RTN","C0PKIDS",109,0)
    S C0PXR("EXECUTION")="F"
"RTN","C0PKIDS",110,0)
    S C0PXR("ACTIVITY")="IR"
"RTN","C0PKIDS",111,0)
    S C0PXR("SHORT DESCR")="For eRx - a sort only index on the VAPRODUCT number"
"RTN","C0PKIDS",112,0)
    S C0PXR("DESCR",1)="This index is used for the VISTA e-Rx project. This index enables a "
"RTN","C0PKIDS",113,0)
    S C0PXR("DESCR",2)="programmer to search for a drug using the VA Product. This index will"
"RTN","C0PKIDS",114,0)
    S C0PXR("DESCR",3)="be used to match drugs received from the remote service to the local drug"
"RTN","C0PKIDS",115,0)
    S C0PXR("DESCR",4)="file. Drugs received using the remote service are received using RxNorm"
"RTN","C0PKIDS",116,0)
    S C0PXR("DESCR",5)="CUI or First Databank MEDID. Either one of those will be translated to a"
"RTN","C0PKIDS",117,0)
    S C0PXR("DESCR",6)="VUID, which is matched against the VA Product file, which then is matched"
"RTN","C0PKIDS",118,0)
    S C0PXR("DESCR",7)="to the local drug pointing to the VA Product. "
"RTN","C0PKIDS",119,0)
    S C0PXR("VAL",1)=22
"RTN","C0PKIDS",120,0)
    S C0PXR("VAL",1,"SUBSCRIPT")=1
"RTN","C0PKIDS",121,0)
    S C0PXR("VAL",1,"COLLATION")="F"
"RTN","C0PKIDS",122,0)
    D CREIXN^DDMOD(.C0PXR,"S",.C0PRES,"C0POUT","C0PERR")
"RTN","C0PKIDS",123,0)
    I $D(C0PERR) D MES^XPDUTL("PSNDF VA PRODUCT NAME ENTRY xref Creation failed")
"RTN","C0PKIDS",124,0)
    ;
"RTN","C0PKIDS",125,0)
    ; Add Free Txt Entry to Pharmacy Orderable Item
"RTN","C0PKIDS",126,0)
    ; Again... this time file the Free Text Drug into Pharmacy Orderablem Items
"RTN","C0PKIDS",127,0)
    ; if it isn't already there!
"RTN","C0PKIDS",128,0)
    D MES^XPDUTL("Adding Free Txt Entry to Pharmacy Orderable Item file")
"RTN","C0PKIDS",129,0)
    ;
"RTN","C0PKIDS",130,0)
    N PSEDITNM S PSEDITNM=1                      ; Fileman gatekeeper for adding entries
"RTN","C0PKIDS",131,0)
    N C0PFDA
"RTN","C0PKIDS",132,0)
    S C0PFDA(50.7,"?+1,",.01)="FREE TXT DRUG"    ; Name
"RTN","C0PKIDS",133,0)
    S C0PFDA(50.7,"?+1,",.02)=40                 ; DOSAGE FORM: MISCELANEOUS
"RTN","C0PKIDS",134,0)
    S C0PFDA(50.7,"?+1,",.04)=3110428            ; INACTIVE DATE: (any value would do!)
"RTN","C0PKIDS",135,0)
    ;
"RTN","C0PKIDS",136,0)
    N C0PERR           ; Errors go here.                                                         
"RTN","C0PKIDS",137,0)
    D UPDATE^DIE("","C0PFDA","","C0PERR") ; no flags, FDA, ien_root, msg_root   
"RTN","C0PKIDS",138,0)
    ;
"RTN","C0PKIDS",139,0)
    I $D(C0PERR) D
"RTN","C0PKIDS",140,0)
    . D MES^XPDUTL("Couldn't add FREE TXT DRUG to Pharmacy Orderable Item File")
"RTN","C0PKIDS",141,0)
    . S C0PERR=$Q(C0PERR)
"RTN","C0PKIDS",142,0)
    . F  S C0PERR=$Q(@C0PERR) Q:C0PERR=""  D MES^XPDUTL(C0PERR_": "_@C0PERR)
"RTN","C0PKIDS",143,0)
    ;
"RTN","C0PKIDS",144,0)
    ; Add Mail Group ERX HELP DESK to bulletin C0P EXTERNAL DRUG NOT FOUND--not done by KIDS
"RTN","C0PKIDS",145,0)
    D MES^XPDUTL("Adding Mail Group ERX HELP DESK to bulletin C0P EXTERNAL DRUG NOT FOUND")
"RTN","C0PKIDS",146,0)
    N C0PIEN S C0PIEN=$O(^XMB(3.6,"B","C0P EXTERNAL DRUG NOT FOUND",""))  ; IEN in Bulletin File
"RTN","C0PKIDS",147,0)
    N C0PFDA S C0PFDA(3.62,"?+1,"_C0PIEN_",",.01)="ERX HELP DESK" ; Data we want to add to Mail Group Multiple (Laygo)
"RTN","C0PKIDS",148,0)
    N C0PERR ; Errors
"RTN","C0PKIDS",149,0)
    D UPDATE^DIE("E","C0PFDA","","C0PERR")
"RTN","C0PKIDS",150,0)
    ;
"RTN","C0PKIDS",151,0)
    I $D(C0PERR) D
"RTN","C0PKIDS",152,0)
    . D MES^XPDUTL("Couldn't add Mail Group ERX HELP DESK to bulletin C0P EXTERNAL DRUG NOT FOUND")
"RTN","C0PKIDS",153,0)
    . S C0PERR=$Q(C0PERR)
"RTN","C0PKIDS",154,0)
    . F  S C0PERR=$Q(@C0PERR) Q:C0PERR=""  D MES^XPDUTL(C0PERR_": "_@C0PERR)
"RTN","C0PKIDS",155,0)
    ;
"RTN","C0PKIDS",156,0)
    D MES^XPDUTL("")
"RTN","C0PKIDS",157,0)
    D MES^XPDUTL("Remember to install the following patches: ")
"RTN","C0PKIDS",158,0)
    D MES^XPDUTL("They may be legally protected; see documentation on how to")
"RTN","C0PKIDS",159,0)
    D MES^XPDUTL("acquire them. Contact Geroge Lilly at glilly@glilly.net for questions")
"RTN","C0PKIDS",160,0)
    D MES^XPDUTL(" - C0P*1.0*1 -> New Crop WebServices Data")
"RTN","C0PKIDS",161,0)
    D MES^XPDUTL(" - C0P*1.0*2 -> RxNorm Data 2012-04 Release")
"RTN","C0PKIDS",162,0)
    D MES^XPDUTL(" - C0P*1.0*3 -> First Databank Data 2012-03 Release")
"RTN","C0PKIDS",163,0)
    D MES^XPDUTL("")
"RTN","C0PKIDS",164,0)
    D MES^XPDUTL("Make sure to set-up the following after installation: ")
"RTN","C0PKIDS",165,0)
    D MES^XPDUTL(" - Account Info in C0P WS ACCT")
"RTN","C0PKIDS",166,0)
    D MES^XPDUTL(" - Institution address fields in file 4")
"RTN","C0PKIDS",167,0)
    D MES^XPDUTL(" - Hospital Location E-Rx fields")
"RTN","C0PKIDS",168,0)
    D MES^XPDUTL(" - New Person E-Rx fields")
"RTN","C0PKIDS",169,0)
    D MES^XPDUTL(" - Mail users to mail group: ERX HELP DESK")
"RTN","C0PKIDS",170,0)
    D MES^XPDUTL(" - Schedule C0P ERX BATCH to run every 15 min using an eRx user")
"RTN","C0PKIDS",171,0)
    D MES^XPDUTL("")
"RTN","C0PKIDS",172,0)
    D MES^XPDUTL("Most of these can be accomplished in C0PMENU. You need the C0PZMENU")
"RTN","C0PKIDS",173,0)
    D MES^XPDUTL("security key to enter the menu, and C0PZMGR to edit the account.")
"RTN","C0PKIDS",174,0)
    ;
"RTN","C0PKIDS",175,0)
    ; I think we are done!
"RTN","C0PKIDS",176,0)
    QUIT
"RTN","C0PKIDS",177,0)
    ; --> RxNorm Files
"RTN","C0PKIDS",178,0)
RXNTRAN ; Transportation Routine for RxNorm Files, PEP
"RTN","C0PKIDS",179,0)
    M @XPDGREF@("C0P","RXN")=^C0P("RXN")
"RTN","C0PKIDS",180,0)
    QUIT
"RTN","C0PKIDS",181,0)
RXNPOST ; Post Install Routine for RxNorm Files, PEP
"RTN","C0PKIDS",182,0)
    D MES^XPDUTL("Installing RxNorm Concepts File")
"RTN","C0PKIDS",183,0)
    K ^C0P("RXN")
"RTN","C0PKIDS",184,0)
    M ^C0P("RXN")=@XPDGREF@("C0P","RXN")
"RTN","C0PKIDS",185,0)
    QUIT
"RTN","C0PKIDS",186,0)
    ; <-- RxNorm Files
"RTN","C0PKIDS",187,0)
    ;
"RTN","C0PKIDS",188,0)
    ; --> FDB Files
"RTN","C0PKIDS",189,0)
FDBTRAN ; Unified Transportation EP for FDB Files, PEP
"RTN","C0PKIDS",190,0)
    D FDBDTRAN,FDBATRAN,IMPTRAN ; Drugs, Allergies, Import Templates
"RTN","C0PKIDS",191,0)
    QUIT
"RTN","C0PKIDS",192,0)
FDBPOST ; Unified Post Install Routine for FDB Files, PEP
"RTN","C0PKIDS",193,0)
    D FDBDPOST,FDBAPOST,IMPPOST ; Drugs, Allergies, Import Templates
"RTN","C0PKIDS",194,0)
    QUIT
"RTN","C0PKIDS",195,0)
    ; <-- FDB Files
"RTN","C0PKIDS",196,0)
    ; 
"RTN","C0PKIDS",197,0)
    ; Rest is private
"RTN","C0PKIDS",198,0)
FDBDTRAN    ; Transportation Routine for FDB Drug File, private
"RTN","C0PKIDS",199,0)
    M @XPDGREF@("C0P","FDBD")=^C0P("FDB")
"RTN","C0PKIDS",200,0)
    QUIT
"RTN","C0PKIDS",201,0)
FDBDPOST    ; Post Install Routine for FDB Drug File, private
"RTN","C0PKIDS",202,0)
    D MES^XPDUTL("Installing FDB Drug File")
"RTN","C0PKIDS",203,0)
    K ^C0P("FDB") ; Kill original file
"RTN","C0PKIDS",204,0)
    M ^C0P("FDB")=@XPDGREF@("C0P","FDBD") ; Merge from Global
"RTN","C0PKIDS",205,0)
    QUIT
"RTN","C0PKIDS",206,0)
FDBATRAN    ; Transportation Routine for FDB Allergies File, private
"RTN","C0PKIDS",207,0)
    M @XPDGREF@("C0P","FDBA")=^C0PALGY
"RTN","C0PKIDS",208,0)
    QUIT
"RTN","C0PKIDS",209,0)
FDBAPOST    ; Post Install Routine for FDB Allergies File, private
"RTN","C0PKIDS",210,0)
    D MES^XPDUTL("Installing FDB Allergy File")
"RTN","C0PKIDS",211,0)
    K ^C0PALGY ; Kill original file
"RTN","C0PKIDS",212,0)
    M ^C0PALGY=@XPDGREF@("C0P","FDBA") ; Merge from Global
"RTN","C0PKIDS",213,0)
    QUIT
"RTN","C0PKIDS",214,0)
    ;
"RTN","C0PKIDS",215,0)
    ; --> Import Templates
"RTN","C0PKIDS",216,0)
IMPTRAN ; Transport Import Template for loading FDB files, private
"RTN","C0PKIDS",217,0)
    ;
"RTN","C0PKIDS",218,0)
    ; Get the IEN of the import templates to transport off...
"RTN","C0PKIDS",219,0)
    N FDBDIEN S FDBDIEN=$O(^DIST(.46,"B","C0P FDB TBLCOMPOSITEDRUG",""))
"RTN","C0PKIDS",220,0)
    N FDBAIEN S FDBAIEN=$O(^DIST(.46,"B","C0P FDB TBLCOMPOSITEALLERGY",""))
"RTN","C0PKIDS",221,0)
    ;
"RTN","C0PKIDS",222,0)
    ; Put in transport global, remove creator DUZ (can't guarantee in dest sys)
"RTN","C0PKIDS",223,0)
    M @XPDGREF@("C0P","IMPFDBD")=^DIST(.46,FDBDIEN) ; Get first template
"RTN","C0PKIDS",224,0)
    S $P(@XPDGREF@("C0P","IMPFDBD",0),U,5)="" ; Remove Creator
"RTN","C0PKIDS",225,0)
    M @XPDGREF@("C0P","IMPFDBA")=^DIST(.46,FDBAIEN) ; Get second template
"RTN","C0PKIDS",226,0)
    S $P(@XPDGREF@("C0P","IMPFDBA",0),U,5)="" ; Remove Creator
"RTN","C0PKIDS",227,0)
    ;
"RTN","C0PKIDS",228,0)
    QUIT
"RTN","C0PKIDS",229,0)
    ;
"RTN","C0PKIDS",230,0)
IMPPOST ; Post init for Import Templates, private
"RTN","C0PKIDS",231,0)
    ; TODO: Before using as a general KIDS utility, this does not 
"RTN","C0PKIDS",232,0)
    ; check if the destination fields exist. Destination fields are 
"RTN","C0PKIDS",233,0)
    ; FREE TEXT fields in the Import Template.
"RTN","C0PKIDS",234,0)
    ;
"RTN","C0PKIDS",235,0)
    D MES^XPDUTL("Installing FDB Files' Import Templates")
"RTN","C0PKIDS",236,0)
    ; Part 1: Delete old entries if they already exist.
"RTN","C0PKIDS",237,0)
    ;
"RTN","C0PKIDS",238,0)
    ; Get IENs
"RTN","C0PKIDS",239,0)
    N FDBDIEN S FDBDIEN=$O(^DIST(.46,"B","C0P FDB TBLCOMPOSITEDRUG",""))
"RTN","C0PKIDS",240,0)
    N FDBAIEN S FDBAIEN=$O(^DIST(.46,"B","C0P FDB TBLCOMPOSITEALLERGY",""))
"RTN","C0PKIDS",241,0)
    ; 
"RTN","C0PKIDS",242,0)
    ; Kill off: Indexes first, then record. Lock before you do.
"RTN","C0PKIDS",243,0)
    N C0PNAME
"RTN","C0PKIDS",244,0)
    F C0PNAME="FDBDIEN","FDBAIEN" D  ; For each variable
"RTN","C0PKIDS",245,0)
    . I @C0PNAME D  ; If that entry is found (see $O above)
"RTN","C0PKIDS",246,0)
    . . L +^DIST(.46,@C0PNAME):0 ; Lock
"RTN","C0PKIDS",247,0)
    . . ; IX2: Fire all Kill x-refs for one record.
"RTN","C0PKIDS",248,0)
    . . N DIK,DA S DIK="^DIST(.46,",DA=@C0PNAME D IX2^DIK ; Kill Logic
"RTN","C0PKIDS",249,0)
    . . K ^DIST(.46,@C0PNAME) ; Remove record
"RTN","C0PKIDS",250,0)
    . . L -^DIST(.46,@C0PNAME) ; Unlock
"RTN","C0PKIDS",251,0)
    ;
"RTN","C0PKIDS",252,0)
    ; Part 2: Update New Entries into File
"RTN","C0PKIDS",253,0)
    ; Get next available IEN in Import Template File
"RTN","C0PKIDS",254,0)
    N LASTIEN S LASTIEN=$O(^DIST(.46," "),-1)          ; Last internal entry number in file
"RTN","C0PKIDS",255,0)
    ;
"RTN","C0PKIDS",256,0)
    N NEXTIEN S NEXTIEN=LASTIEN                        ; Use below... incrementer!
"RTN","C0PKIDS",257,0)
    ;
"RTN","C0PKIDS",258,0)
    ; Merge data into the next IEN for each of the refs in the transported global
"RTN","C0PKIDS",259,0)
    ; Block below gets next IEN available.
"RTN","C0PKIDS",260,0)
    ; Lock on ^DIST(.46,NEXTIEN) acquired below.
"RTN","C0PKIDS",261,0)
    F C0PNAME="IMPFDBD","IMPFDBA" DO
"RTN","C0PKIDS",262,0)
    . ;
"RTN","C0PKIDS",263,0)
    . ; Loop below to get an IEN for our new record number
"RTN","C0PKIDS",264,0)
    . N DONE ; control variable for mini loop below
"RTN","C0PKIDS",265,0)
    . F  D  Q:$G(DONE)  ; loop until done
"RTN","C0PKIDS",266,0)
    . . S NEXTIEN=NEXTIEN+1 ; Next IEN available, we guess
"RTN","C0PKIDS",267,0)
    . . L +^DIST(.46,NEXTIEN):0 ELSE  QUIT  ; Can we lock it? If not quit and try the next
"RTN","C0PKIDS",268,0)
    . . I $D(^DIST(.46,NEXTIEN)) L -^DIST(.46,NEXTIEN) QUIT  ; if we locked it, is it really empty? If not, unlock and try next
"RTN","C0PKIDS",269,0)
    . . S DONE=1 QUIT  ; ok. we are sure we got it. Tell the loop we are done.
"RTN","C0PKIDS",270,0)
    . ;
"RTN","C0PKIDS",271,0)
    . M ^DIST(.46,NEXTIEN)=@XPDGREF@("C0P",C0PNAME) ; Merge entry
"RTN","C0PKIDS",272,0)
    . ;
"RTN","C0PKIDS",273,0)
    . ; Fire off xrefs (IX1 fires SET for xrefs for one record)
"RTN","C0PKIDS",274,0)
    . N DIK,DA S DIK="^DIST(.46,",DA=NEXTIEN D IX1^DIK
"RTN","C0PKIDS",275,0)
    . ;
"RTN","C0PKIDS",276,0)
    . ; Update zero node
"RTN","C0PKIDS",277,0)
    . S $P(^DIST(.46,0),U,3)=NEXTIEN ; most recently assigned internal entry number
"RTN","C0PKIDS",278,0)
    . S $P(^DIST(.46,0),U,4)=NEXTIEN ; current total number of entries
"RTN","C0PKIDS",279,0)
    . ;
"RTN","C0PKIDS",280,0)
    . L -^DIST(.46,NEXTIEN) ; Unlock it
"RTN","C0PKIDS",281,0)
    QUIT
"RTN","C0PKIDS",282,0)
    ; <-- Import Templates
"RTN","C0PKIDS",283,0)
 ; 
"RTN","C0PKIDS",284,0)
 ; SMH: All Code below comes from FOIA RPMS from routine CIAURPC
"RTN","C0PKIDS",285,0)
 ; Written by Doug Martin.
"RTN","C0PKIDS",286,0)
 ;
"RTN","C0PKIDS",287,0)
 ; Register/unregister RPCs within a given namespace to a context
"RTN","C0PKIDS",288,0)
REGNMSP(NMSP,CTX,DEL) ;EP
"RTN","C0PKIDS",289,0)
 N RPC,IEN,LEN
"RTN","C0PKIDS",290,0)
 S LEN=$L(NMSP),CTX=+$$GETOPT(CTX)
"RTN","C0PKIDS",291,0)
 I $G(DEL) D
"RTN","C0PKIDS",292,0)
 .S IEN=0
"RTN","C0PKIDS",293,0)
 .F  S IEN=$O(^DIC(19,CTX,"RPC","B",IEN)) Q:'IEN  D
"RTN","C0PKIDS",294,0)
 ..I $E($G(^XWB(8994,IEN,0)),1,LEN)=NMSP,$$REGRPC(IEN,CTX,1)
"RTN","C0PKIDS",295,0)
 E  D
"RTN","C0PKIDS",296,0)
 .Q:LEN<2
"RTN","C0PKIDS",297,0)
 .S RPC=NMSP
"RTN","C0PKIDS",298,0)
 .F  D:$L(RPC)  S RPC=$O(^XWB(8994,"B",RPC)) Q:NMSP'=$E(RPC,1,LEN)
"RTN","C0PKIDS",299,0)
 ..F IEN=0:0 S IEN=$O(^XWB(8994,"B",RPC,IEN)) Q:'IEN  I $$REGRPC(IEN,.CTX)
"RTN","C0PKIDS",300,0)
 Q
"RTN","C0PKIDS",301,0)
 ; Register/unregister an RPC to/from a context
"RTN","C0PKIDS",302,0)
 ; RPC = IEN or name of RPC
"RTN","C0PKIDS",303,0)
 ; CTX = IEN or name of context
"RTN","C0PKIDS",304,0)
 ; DEL = If nonzero, the RPC is unregistered (defaults to 0)
"RTN","C0PKIDS",305,0)
 ; Returns -1 if already registered; 0 if failed; 1 if succeeded
"RTN","C0PKIDS",306,0)
REGRPC(RPC,CTX,DEL) ;EP
"RTN","C0PKIDS",307,0)
 S RPC=+$$GETRPC(RPC)
"RTN","C0PKIDS",308,0)
 Q $S(RPC<1:0,1:$$REGMULT(19.05,"RPC",RPC,.CTX,.DEL))
"RTN","C0PKIDS",309,0)
 ; Add/remove a context to/from the ITEM multiple of another context.
"RTN","C0PKIDS",310,0)
REGCTX(SRC,DST,DEL) ;EP
"RTN","C0PKIDS",311,0)
 S SRC=+$$GETOPT(SRC)
"RTN","C0PKIDS",312,0)
 Q $S('SRC:0,1:$$REGMULT(19.01,10,SRC,.DST,.DEL))
"RTN","C0PKIDS",313,0)
 ; Add/delete an entry to/from a specified OPTION multiple.
"RTN","C0PKIDS",314,0)
 ; SFN = Subfile #
"RTN","C0PKIDS",315,0)
 ; NOD = Subnode for multiple
"RTN","C0PKIDS",316,0)
 ; ITM = Item IEN to add
"RTN","C0PKIDS",317,0)
 ; CTX = Option to add to
"RTN","C0PKIDS",318,0)
 ; DEL = Delete flag (optional)
"RTN","C0PKIDS",319,0)
REGMULT(SFN,NOD,ITM,CTX,DEL) ;
"RTN","C0PKIDS",320,0)
 N FDA,IEN
"RTN","C0PKIDS",321,0)
 S CTX=+$$GETOPT(CTX)
"RTN","C0PKIDS",322,0)
 S DEL=+$G(DEL)
"RTN","C0PKIDS",323,0)
 S IEN=+$O(^DIC(19,CTX,NOD,"B",ITM,0))
"RTN","C0PKIDS",324,0)
 Q:'IEN=DEL -1
"RTN","C0PKIDS",325,0)
 K ^TMP("DIERR",$J)
"RTN","C0PKIDS",326,0)
 I DEL S FDA(SFN,IEN_","_CTX_",",.01)="@"
"RTN","C0PKIDS",327,0)
 E  S FDA(SFN,"+1,"_CTX_",",.01)=ITM
"RTN","C0PKIDS",328,0)
 D UPDATE^DIE("","FDA")
"RTN","C0PKIDS",329,0)
 S FDA='$D(^TMP("DIERR",$J)) K ^($J)
"RTN","C0PKIDS",330,0)
 Q FDA
"RTN","C0PKIDS",331,0)
 ; Register a protocol to an extended action protocol
"RTN","C0PKIDS",332,0)
 ; Input: P-Parent protocol
"RTN","C0PKIDS",333,0)
 ;        C-Child protocol
"RTN","C0PKIDS",334,0)
REGPROT(P,C,ERR) ;EP
"RTN","C0PKIDS",335,0)
 N IENARY,PIEN,AIEN,FDA
"RTN","C0PKIDS",336,0)
 D
"RTN","C0PKIDS",337,0)
 .I '$L(P)!('$L(C)) S ERR="Missing input parameter" Q
"RTN","C0PKIDS",338,0)
 .S IENARY(1)=$$FIND1^DIC(101,"","",P)
"RTN","C0PKIDS",339,0)
 .S AIEN=$$FIND1^DIC(101,"","",C)
"RTN","C0PKIDS",340,0)
 .I 'IENARY(1)!'AIEN S ERR="Unknown protocol name" Q
"RTN","C0PKIDS",341,0)
 .S FDA(101.01,"?+2,"_IENARY(1)_",",.01)=AIEN
"RTN","C0PKIDS",342,0)
 .D UPDATE^DIE("S","FDA","IENARY","ERR")
"RTN","C0PKIDS",343,0)
 Q:$Q $G(ERR)=""
"RTN","C0PKIDS",344,0)
 Q
"RTN","C0PKIDS",345,0)
 ; Remove nonexistent RPCs from context
"RTN","C0PKIDS",346,0)
CLNRPC(CTX) ;EP
"RTN","C0PKIDS",347,0)
 N IEN
"RTN","C0PKIDS",348,0)
 S CTX=+$$GETOPT(CTX)
"RTN","C0PKIDS",349,0)
 F IEN=0:0 S IEN=$O(^DIC(19,CTX,"RPC","B",IEN)) Q:'IEN  D:'$D(^XWB(8994,IEN)) REGRPC(IEN,CTX,1)
"RTN","C0PKIDS",350,0)
 Q
"RTN","C0PKIDS",351,0)
 ; Return IEN of option
"RTN","C0PKIDS",352,0)
GETOPT(X) ;EP
"RTN","C0PKIDS",353,0)
 N Y
"RTN","C0PKIDS",354,0)
 Q:X=+X X
"RTN","C0PKIDS",355,0)
 S Y=$$FIND1^DIC(19,"","X",X)
"RTN","C0PKIDS",356,0)
 W:'Y "Cannot find option "_X,!!
"RTN","C0PKIDS",357,0)
 Q Y
"RTN","C0PKIDS",358,0)
 ; Return IEN of RPC
"RTN","C0PKIDS",359,0)
GETRPC(X) ;EP
"RTN","C0PKIDS",360,0)
 N Y
"RTN","C0PKIDS",361,0)
 Q:X=+X X
"RTN","C0PKIDS",362,0)
 S Y=$$FIND1^DIC(8994,"","X",X)
"RTN","C0PKIDS",363,0)
 W:'Y "Cannot find RPC "_X,!!
"RTN","C0PKIDS",364,0)
 Q Y
"RTN","C0PLKUP")
0^9^B29450708
"RTN","C0PLKUP",1,0)
C0PLKUP ; VEN/SMH - Extrinsics to map med numbers ; 5/8/12 4:09pm
"RTN","C0PLKUP",2,0)
 ;;1.0;C0P;;Apr 25, 2012;Build 103
"RTN","C0PLKUP",3,0)
 ;Copyright 2009 Sam Habiel.  Licensed under the terms of the GNU
"RTN","C0PLKUP",4,0)
 ;General Public License See attached copy of the License.
"RTN","C0PLKUP",5,0)
 ;
"RTN","C0PLKUP",6,0)
 ;This program is free software; you can redistribute it and/or modify
"RTN","C0PLKUP",7,0)
 ;it under the terms of the GNU General Public License as published by
"RTN","C0PLKUP",8,0)
 ;the Free Software Foundation; either version 2 of the License, or
"RTN","C0PLKUP",9,0)
 ;(at your option) any later version.
"RTN","C0PLKUP",10,0)
 ;
"RTN","C0PLKUP",11,0)
 ;This program is distributed in the hope that it will be useful,
"RTN","C0PLKUP",12,0)
 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0PLKUP",13,0)
 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"RTN","C0PLKUP",14,0)
 ;GNU General Public License for more details.
"RTN","C0PLKUP",15,0)
 ;
"RTN","C0PLKUP",16,0)
 ;You should have received a copy of the GNU General Public License along
"RTN","C0PLKUP",17,0)
 ;with this program; if not, write to the Free Software Foundation, Inc.,
"RTN","C0PLKUP",18,0)
 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
"RTN","C0PLKUP",19,0)
 Q
"RTN","C0PLKUP",20,0)
FDBFN() Q 1130590010 ; First Databank Drugs file number
"RTN","C0PLKUP",21,0)
RXNFN() Q 1130590011.001 ; RxNorm Concepts file number
"RTN","C0PLKUP",22,0)
FULLNAME(MEDID) ; $$ Public - Get FDB full name for the drug
"RTN","C0PLKUP",23,0)
 ; Used in Bulletin
"RTN","C0PLKUP",24,0)
 ; Input: MEDID By Value
"RTN","C0PLKUP",25,0)
 ; Output: Extrinsic
"RTN","C0PLKUP",26,0)
 N C0PIEN S C0PIEN=$$FIND1^DIC($$FDBFN,"","QX",MEDID,"B")
"RTN","C0PLKUP",27,0)
 Q $$GET1^DIQ($$FDBFN,C0PIEN,"MED MEDID DESC")
"RTN","C0PLKUP",28,0)
GCN(MEDID) ; $$ Public - Get GCN given MEDID
"RTN","C0PLKUP",29,0)
 ; Input: MEDID by Value
"RTN","C0PLKUP",30,0)
 ; Output: Extrinsic
"RTN","C0PLKUP",31,0)
 ; MEDID is the .01 field in the First Databank Drug file
"RTN","C0PLKUP",32,0)
 ; GCN is the 1 field = Generic Code Number
"RTN","C0PLKUP",33,0)
 ; WS supplies MEDID in return. Need Generic Code Number to map to RxNorm.
"RTN","C0PLKUP",34,0)
 N X,Y,DTOUT,DUOUT,DLAYGO,DIC
"RTN","C0PLKUP",35,0)
 S DIC=$$FDBFN
"RTN","C0PLKUP",36,0)
 S X=MEDID
"RTN","C0PLKUP",37,0)
 S DIC(0)="OXZ" ; One entry only, Exact match, return zero node
"RTN","C0PLKUP",38,0)
 D ^DIC
"RTN","C0PLKUP",39,0)
 I Y<0 Q "" ; Failed match
"RTN","C0PLKUP",40,0)
 Q $P(Y(0),U,2) ; GCN is 2nd piece of zero node
"RTN","C0PLKUP",41,0)
 ;
"RTN","C0PLKUP",42,0)
RXNCUI(GCN) ; $$ Public - Get RxNorm CUI using GCN
"RTN","C0PLKUP",43,0)
 ; Input: GCN by Value
"RTN","C0PLKUP",44,0)
 ; Output: Extrinsic
"RTN","C0PLKUP",45,0)
 ; Seach GCN index for an exact match
"RTN","C0PLKUP",46,0)
 ; One match, quick lookup, Exact matching
"RTN","C0PLKUP",47,0)
 N C0PIEN S C0PIEN=$$FIND1^DIC($$RXNFN,"","QX",GCN,"GCN")
"RTN","C0PLKUP",48,0)
 Q $$GET1^DIQ($$RXNFN,C0PIEN,.01)
"RTN","C0PLKUP",49,0)
 ;
"RTN","C0PLKUP",50,0)
VUID(RXNCUI) ; $$ Public - Get VUID(s) for given RXNCUI for Clinical Drug
"RTN","C0PLKUP",51,0)
 ; Input: RXNCUI by Value
"RTN","C0PLKUP",52,0)
 ; Output: Caret delimited extrinsic. Should not be more than 2 entries.
"RTN","C0PLKUP",53,0)
 ; @;4 means return IEN and VUID.
"RTN","C0PLKUP",54,0)
 N C0POUT,C0PVUID
"RTN","C0PLKUP",55,0)
 I '$D(^DIC($$RXNFN,0,"GL")) Q ""  ; RXNORM UMLS NOT INSTALLED
"RTN","C0PLKUP",56,0)
 D FIND^DIC($$RXNFN,"","@;4","PXQ",RXNCUI,"","VUIDCD","","","C0POUT")
"RTN","C0PLKUP",57,0)
 ; Example output:
"RTN","C0PLKUP",58,0)
 ; SAM("DILIST",0)="2^*^0^"
"RTN","C0PLKUP",59,0)
 ; SAM("DILIST",0,"MAP")="IEN^4"
"RTN","C0PLKUP",60,0)
 ; SAM("DILIST",1,0)="112482^4010153"
"RTN","C0PLKUP",61,0)
 ; SAM("DILIST",2,0)="112484^4016607"
"RTN","C0PLKUP",62,0)
 I +$G(C0POUT("DILIST",0))=0 Q ""  ; no matches
"RTN","C0PLKUP",63,0)
 N I S I=0
"RTN","C0PLKUP",64,0)
 F  S I=$O(C0POUT("DILIST",I)) Q:I=""  S C0PVUID=$G(C0PVUID)_$P(C0POUT("DILIST",I,0),U,2)_"^"
"RTN","C0PLKUP",65,0)
 S C0PVUID=$E(C0PVUID,1,$L(C0PVUID)-1) ; remove trailing ^
"RTN","C0PLKUP",66,0)
 Q C0PVUID
"RTN","C0PLKUP",67,0)
VUID2(MEDID) ; $$ Public - Get VUID(s) for given MEDID
"RTN","C0PLKUP",68,0)
 Q $$VUID($$RXNCUI($$GCN(MEDID)))
"RTN","C0PLKUP",69,0)
VAPROD(VUID) ; $$ Public - Get VA Product IEN from VUID
"RTN","C0PLKUP",70,0)
 ; Input VUID by Value
"RTN","C0PLKUP",71,0)
 ; Output: Extrinsic
"RTN","C0PLKUP",72,0)
 Q $$FIND1^DIC(50.68,"","QX",VUID,"AVUID")
"RTN","C0PLKUP",73,0)
DRUG(VAPROD) ; $$ Public - Get Drug(s) using VA Product IEN
"RTN","C0PLKUP",74,0)
 ; Input: VA Product IEN By Value
"RTN","C0PLKUP",75,0)
 ; OUtput: Caret delimited extrinsic
"RTN","C0PLKUP",76,0)
 N C0POUT,C0PDRUG
"RTN","C0PLKUP",77,0)
 ;D FIND^DIC(50,"","@;4","PXQ",VAPROD,"","C0PVAPROD","","","C0POUT")
"RTN","C0PLKUP",78,0)
 ;D FIND^DIC(50,"","@;4","PXQ",VAPROD,"","AC0P","","","C0POUT") ;GPL 7/10
"RTN","C0PLKUP",79,0)
 I +VAPROD=0 Q 0 ;
"RTN","C0PLKUP",80,0)
 I '$D(^PSDRUG("AC0P",VAPROD)) Q 0 ;W "AC0P cross reference error" Q 0 ;
"RTN","C0PLKUP",81,0)
 ;S C0PDRUG=$O(^PSDRUG("AC0P",VAPROD,"")) ;GPL ABOVE FIND DOESN'T WORK
"RTN","C0PLKUP",82,0)
 N I S I=""
"RTN","C0PLKUP",83,0)
 S C0PDRUG=""
"RTN","C0PLKUP",84,0)
 F  S I=$O(^PSDRUG("AC0P",VAPROD,I)) Q:I=""  D  ;
"RTN","C0PLKUP",85,0)
 . S C0PDRUG=C0PDRUG_I_"^"
"RTN","C0PLKUP",86,0)
 S C0PDRUG=$E(C0PDRUG,1,$L(C0PDRUG)-1) ; remove trailing ^
"RTN","C0PLKUP",87,0)
 Q C0PDRUG
"RTN","C0PLKUP",88,0)
 ; Example output:
"RTN","C0PLKUP",89,0)
 ; C0POUT("DILIST",0)="2^*^0^"
"RTN","C0PLKUP",90,0)
 ; C0POUT("DILIST",0,"MAP")="IEN^4"
"RTN","C0PLKUP",91,0)
 ; C0POUT("DILIST",1,0)="1512^"
"RTN","C0PLKUP",92,0)
 ; C0POUT("DILIST",2,0)="21632^"
"RTN","C0PLKUP",93,0)
 ; or
"RTN","C0PLKUP",94,0)
 ; C0POUT("DILIST",0)="0^*^0^"
"RTN","C0PLKUP",95,0)
 ; C0POUT("DILIST",0,"MAP")="IEN^4"
"RTN","C0PLKUP",96,0)
 I +$G(C0POUT("DILIST",0))=0 Q ""  ; no matches
"RTN","C0PLKUP",97,0)
 N I S I=0
"RTN","C0PLKUP",98,0)
 F  S I=$O(C0POUT("DILIST",I)) Q:I=""  S C0PDRUG=$G(C0PDRUG)_$P(C0POUT("DILIST",I,0),U)_"^"
"RTN","C0PLKUP",99,0)
 S C0PDRUG=$E(C0PDRUG,1,$L(C0PDRUG)-1) ; remove trailing ^
"RTN","C0PLKUP",100,0)
 Q C0PDRUG
"RTN","C0PLKUP",101,0)
DRUG2(MEDID) ; $$ Public - Get Drugs for a FDB MEDID
"RTN","C0PLKUP",102,0)
 ; Input: MEDID by Value
"RTN","C0PLKUP",103,0)
 ; Output: Caret delimited extrinsic
"RTN","C0PLKUP",104,0)
 N OUT S OUT=""
"RTN","C0PLKUP",105,0)
 N C0PDRUGS  ; tmp holding space for drugs
"RTN","C0PLKUP",106,0)
 N C0PVUIDS S C0PVUIDS=$$VUID2(MEDID)
"RTN","C0PLKUP",107,0)
 N C0PI
"RTN","C0PLKUP",108,0)
 F C0PI=1:1:$L(C0PVUIDS,U) D  ; for each VUID
"RTN","C0PLKUP",109,0)
 . N C0PVUID S C0PVUID=$P(C0PVUIDS,U,C0PI)
"RTN","C0PLKUP",110,0)
 . N C0PVAPROD S C0PVAPROD=$$VAPROD(C0PVUID) ; get VA Product
"RTN","C0PLKUP",111,0)
 . S C0PDRUGS=$$DRUG(C0PVAPROD)
"RTN","C0PLKUP",112,0)
 . S:$L(C0PDRUGS) OUT=OUT_C0PDRUGS_"^"
"RTN","C0PLKUP",113,0)
 S OUT=$E(OUT,1,$L(OUT)-1) ; rm trailing ^
"RTN","C0PLKUP",114,0)
 Q OUT
"RTN","C0PLKUP",115,0)
RXNCUI2(BASE) ; $$ Public - Get RxNorm CUI for FDB Ingredient/Base
"RTN","C0PLKUP",116,0)
 ; Input: BASE By Value
"RTN","C0PLKUP",117,0)
 ; Output: RxNorm CUI
"RTN","C0PLKUP",118,0)
 N C0PIEN S C0PIEN=$$FIND1^DIC($$RXNFN,"","QX",BASE,"NDDFBASE")
"RTN","C0PLKUP",119,0)
 Q $$GET1^DIQ($$RXNFN,C0PIEN,.01)
"RTN","C0PLKUP",120,0)
VUIDIN(RXNCUI) ; $$ Public - Get VUID Ingredient for RxNorm CUI
"RTN","C0PLKUP",121,0)
 ; Input: RXNCUI By Value
"RTN","C0PLKUP",122,0)
 ; Output: VUID
"RTN","C0PLKUP",123,0)
 N C0PIEN S C0PIEN=$$FIND1^DIC($$RXNFN,"","QX",RXNCUI,"VUIDIN")
"RTN","C0PLKUP",124,0)
 Q $$GET1^DIQ($$RXNFN,C0PIEN,"CODE")
"RTN","C0PLKUP",125,0)
VAGEN(VUID) ; $$ Public - Get VA Generic for VUID Ingredient
"RTN","C0PLKUP",126,0)
 ; Input: VUID By Value
"RTN","C0PLKUP",127,0)
 ; Output: IEN^VA Generic Name (i.e. .01 field value)
"RTN","C0PLKUP",128,0)
 N C0PIEN S C0PIEN=$$FIND1^DIC(50.6,"","QX",VUID,"AVUID")
"RTN","C0PLKUP",129,0)
 N C0P01 S C0P01=$$GET1^DIQ(50.6,C0PIEN,.01)
"RTN","C0PLKUP",130,0)
 Q C0PIEN_"^"_C0P01
"RTN","C0PLKUP",131,0)
VAGEN2(BASE) ; $$ Public - Get VA Generic for FDB Ingredient/Base
"RTN","C0PLKUP",132,0)
 ; Input: BASE By Value
"RTN","C0PLKUP",133,0)
 ; Output: IEN^VA Generic Name (i.e. .01 field value)
"RTN","C0PLKUP",134,0)
 Q $$VAGEN($$VUIDIN($$RXNCUI2(BASE)))
"RTN","C0PLKUP",135,0)
DRUGING(VUID) ; $$ Public - Get Drug Ingredient for VUID Ingredient
"RTN","C0PLKUP",136,0)
 ; Input: VUID By Value
"RTN","C0PLKUP",137,0)
 ; Output: IEN^Drug Ingredient Name (i.e. .01 field value)
"RTN","C0PLKUP",138,0)
 N C0PIEN S C0PIEN=$$FIND1^DIC(50.416,"","QX",VUID,"AVUID")
"RTN","C0PLKUP",139,0)
 N C0P01 S C0P01=$$GET1^DIQ(50.416,C0PIEN,.01)
"RTN","C0PLKUP",140,0)
 Q C0PIEN_"^"_C0P01
"RTN","C0PLKUP",141,0)
DRUGING2(BASE) ; $$ Public - Get Drug Ingredient for FDB Ingredient/Base
"RTN","C0PLKUP",142,0)
 ; Input: BASE By Value
"RTN","C0PLKUP",143,0)
 ; Output: IEN^Drug Ingredient Name (i.e. .01 field value)
"RTN","C0PLKUP",144,0)
 Q $$DRUGING($$VUIDIN($$RXNCUI2(BASE)))
"RTN","C0PLKUP",145,0)
RXNCUI3(VUID) ; $$ Public - Get RXNCUI for VUID (any VUID)
"RTN","C0PLKUP",146,0)
 ; Input: VUID By Value
"RTN","C0PLKUP",147,0)
 ; Output: RXNCUI
"RTN","C0PLKUP",148,0)
 I $G(VUID)="" Q ""
"RTN","C0PLKUP",149,0)
 N C0PIEN ; S C0PIEN=$$FIND1^DIC($$RXNFN,"","QX",VUID,"VUID")
"RTN","C0PLKUP",150,0)
 S C0PIEN=$O(^C0P("RXN","VUID",VUID,"")) ;GPL FIX FOR MULTIPLES
"RTN","C0PLKUP",151,0)
 Q $$GET1^DIQ($$RXNFN,C0PIEN,.01)
"RTN","C0PLKUP",152,0)
NDDFBASE(RXNCUI) ; $$ Public - Get NDDF Ingredient for RXNCUI
"RTN","C0PLKUP",153,0)
 ; Input: RXNCUI By Value
"RTN","C0PLKUP",154,0)
 ; Output: NDDF Base code
"RTN","C0PLKUP",155,0)
 N C0PIEN S C0PIEN=$$FIND1^DIC($$RXNFN,"","QX",RXNCUI,"RNDDFBASE")
"RTN","C0PLKUP",156,0)
 Q +$$GET1^DIQ($$RXNFN,C0PIEN,"CODE") ; strip leading zeros
"RTN","C0PLKUP",157,0)
NDDFBAS2(VUID) ; $$ Public - Get NDDF Ingredient for VUID
"RTN","C0PLKUP",158,0)
 ; NB: WILL ONLY WORK IF VUID IS AN INGREDIENT VUID, NOT A CLINICAL DRUG
"RTN","C0PLKUP",159,0)
 ; Input: VUID By Value
"RTN","C0PLKUP",160,0)
 ; Output: NDDF Base code
"RTN","C0PLKUP",161,0)
 Q $$NDDFBASE($$RXNCUI3(VUID))
"RTN","C0PLKUP",162,0)
 ;
"RTN","C0PLKUP",163,0)
DRUGNAM(CURRENTMEDS,ZMED) ; EXTRINSIC WHICH RETURNS THE FULL NAME
"RTN","C0PLKUP",164,0)
 ; OF THE DRUG FROM CURRENTMEDS, PASSED BY REFERENCE
"RTN","C0PLKUP",165,0)
 ; ZMED IS THE NUMBER OF THE MED IN THE ARRAY
"RTN","C0PLKUP",166,0)
 ; IF THERE IS A DRUGID, IT IS USED TO LOOKUP THE NAME
"RTN","C0PLKUP",167,0)
 ; IF THERE IS NO DRUGID, IT IS A FREETEXT MED AND THE NAME IS
"RTN","C0PLKUP",168,0)
 ; PULLED FROM THE SIG, WHERE IS IT STORED WITH A "|" DELIMITER
"RTN","C0PLKUP",169,0)
 N ZD
"RTN","C0PLKUP",170,0)
 I $D(CURRENTMEDS(ZMED,"DRUG")) S ZD=$$FULLNAME(CURRENTMEDS(ZMED,"DRUG"))
"RTN","C0PLKUP",171,0)
 E  D  ; pull the name from the first piece of the sig
"RTN","C0PLKUP",172,0)
 . N ZDSIG
"RTN","C0PLKUP",173,0)
 . S ZDSIG=$G(CURRENTMEDS(ZMED,"SIG",1,0))
"RTN","C0PLKUP",174,0)
 .  S ZD=$P(ZDSIG,"|",1)
"RTN","C0PLKUP",175,0)
 Q ZD
"RTN","C0PLKUP",176,0)
 ;
"RTN","C0PLKUP",177,0)
CODES(MEDID) ; EXTRINSIC WHICH RETURNS A LINE OF CODES FOR THE MED
"RTN","C0PLKUP",178,0)
 ; FORMAT IS MEDID:XXX GCN:XXX RXNORM:XXX VUID:XXX DRUG:XXX
"RTN","C0PLKUP",179,0)
 N ZL
"RTN","C0PLKUP",180,0)
 S ZL="MEDID:"_MEDID_" "
"RTN","C0PLKUP",181,0)
 N ZG S ZG=$$GCN(MEDID) ; GCN (GENERIC CONCEPT NUMBER)
"RTN","C0PLKUP",182,0)
 S ZL=ZL_"GCN:"_ZG_" "
"RTN","C0PLKUP",183,0)
 N ZR S ZR=$$RXNCUI(ZG) ; RXNORM CONCEPT ID
"RTN","C0PLKUP",184,0)
 S ZL=ZL_"RXNORM:"_ZR_" "
"RTN","C0PLKUP",185,0)
 N ZV S ZV=$$VUID(ZR) ; VUID (VA UNIVERSAL ID)
"RTN","C0PLKUP",186,0)
 S ZL=ZL_"VUID:"_ZV_" "
"RTN","C0PLKUP",187,0)
 N ZD S ZD=$$DRUG2(MEDID) ; VISTA DRUG FILE IEN
"RTN","C0PLKUP",188,0)
 I ZD=0 S ZD=""
"RTN","C0PLKUP",189,0)
 S ZL=ZL_"DRUG:"_ZD_" "
"RTN","C0PLKUP",190,0)
 Q ZL
"RTN","C0PLKUP",191,0)
 ;
"RTN","C0PLOAD")
0^34^B81524055
"RTN","C0PLOAD",1,0)
C0PLOAD ; VEN/SMH - File Loading Utilties ; 5/8/12 4:53pm
"RTN","C0PLOAD",2,0)
 ;;1.0;C0P;;Apr 25, 2012;Build 103
"RTN","C0PLOAD",3,0)
 ; (C) Sam Habiel 2012
"RTN","C0PLOAD",4,0)
 ;
"RTN","C0PLOAD",5,0)
 ;Copyright 2012 Sam Habiel.  Licensed under the terms of the GNU
"RTN","C0PLOAD",6,0)
 ;General Public License See attached copy of the License.
"RTN","C0PLOAD",7,0)
 ;
"RTN","C0PLOAD",8,0)
 ;This program is free software; you can redistribute it and/or modify
"RTN","C0PLOAD",9,0)
 ;it under the terms of the GNU General Public License as published by
"RTN","C0PLOAD",10,0)
 ;the Free Software Foundation; either version 2 of the License, or
"RTN","C0PLOAD",11,0)
 ;(at your option) any later version.
"RTN","C0PLOAD",12,0)
 ;
"RTN","C0PLOAD",13,0)
 ;This program is distributed in the hope that it will be useful,
"RTN","C0PLOAD",14,0)
 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0PLOAD",15,0)
 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"RTN","C0PLOAD",16,0)
 ;GNU General Public License for more details.
"RTN","C0PLOAD",17,0)
 ;
"RTN","C0PLOAD",18,0)
 ;You should have received a copy of the GNU General Public License along
"RTN","C0PLOAD",19,0)
 ;with this program; if not, write to the Free Software Foundation, Inc.,
"RTN","C0PLOAD",20,0)
 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
"RTN","C0PLOAD",21,0)
    ; The routine contains utilities for Reading Files from 
"RTN","C0PLOAD",22,0)
    ; RxNorm and FDB into Fileman files
"RTN","C0PLOAD",23,0)
    ; 
"RTN","C0PLOAD",24,0)
    ; This is a pretty pretty alpha version. Right now it just has FDB.
"RTN","C0PLOAD",25,0)
    ;
"RTN","C0PLOAD",26,0)
    ; These files definitions will be existing already. They should
"RTN","C0PLOAD",27,0)
    ; be installed as part of the KIDS build containing this routine.
"RTN","C0PLOAD",28,0)
    ;
"RTN","C0PLOAD",29,0)
    ; The import templates will be also part of KIDS. They should
"RTN","C0PLOAD",30,0)
    ; already exist by the time you run this routine.
"RTN","C0PLOAD",31,0)
    ; 
"RTN","C0PLOAD",32,0)
    ; The drug file is produced by importing a table called 'tblCompositeDrugs' 
"RTN","C0PLOAD",33,0)
    ; provided in an access database from NewCrop accessed using parameter 
"RTN","C0PLOAD",34,0)
    ; '1' for desiredData from this webservice: 
"RTN","C0PLOAD",35,0)
    ; http://preproduction.newcropaccounts.com/V7/WebServices/Update1.asmx?op=GetMostRecentDownloadUrl 
"RTN","C0PLOAD",36,0)
    ;
"RTN","C0PLOAD",37,0)
    ; The webservice provides a URL to a zip file; when unzipped, it produces an
"RTN","C0PLOAD",38,0)
    ; access database with tables for allergies, drugs, pharamcies, healthplans, and
"RTN","C0PLOAD",39,0)
    ; diagnoses.  
"RTN","C0PLOAD",40,0)
    ; 
"RTN","C0PLOAD",41,0)
    ; The following command (from mdb-tools) was used to extract this into an RRF
"RTN","C0PLOAD",42,0)
    ; format (i.e. '|' delimited).| 
"RTN","C0PLOAD",43,0)
    ;  
"RTN","C0PLOAD",44,0)
    ;  mdb-sql -HFp -d'|' -i selecttblCompositeDrug.sql  NCFull-200910.mdb > Drug.rrf 
"RTN","C0PLOAD",45,0)
    ;
"RTN","C0PLOAD",46,0)
    ; The SQL was necessary to skip a word-processing field which I couldn't import
"RTN","C0PLOAD",47,0)
    ; into fileman using the fileman import tool (this is simply a technical
"RTN","C0PLOAD",48,0)
    ; restriction; if I hand wrote my import I could have used a word processing
"RTN","C0PLOAD",49,0)
    ; field and used WP^DIE to file it.) That's field's name is 'etc'.  
"RTN","C0PLOAD",50,0)
         
"RTN","C0PLOAD",51,0)
    ; The SQL statement is as follows: SELECT MEDID, GCN_SEQNO, MED_NAME_ID, 
"RTN","C0PLOAD",52,0)
    ; MED_NAME, MED_ROUTED_MED_ID_DESC, MED_ROUTED_DF_MED_ID_DESC, MED_MEDID_DESC, 
"RTN","C0PLOAD",53,0)
    ; MED_STATUS_CD, MED_ROUTE_ID, ROUTED_MED_ID, ROUTED_DOSAGE_FORM_MED_ID, 
"RTN","C0PLOAD",54,0)
    ; MED_STRENGTH, MED_STRENGTH_UOM, MED_ROUTE_ABBR, MED_ROUTE_DESC, 
"RTN","C0PLOAD",55,0)
    ; MED_DOSAGE_FORM_ABBR, MED_DOSAGE_FORM_DESC, GenericDrugName, 
"RTN","C0PLOAD",56,0)
    ; DosageFormOverride, MED_REF_DEA_CD, MED_REF_DEA_CD_DESC, 
"RTN","C0PLOAD",57,0)
    ; MED_REF_MULTI_SOURCE_CD, MED_REF_MULTI_SOURCE_CD_DESC, 
"RTN","C0PLOAD",58,0)
    ; MED_REF_GEN_DRUG_NAME_CD, MED_REF_GEN_DRUG_NAME_CD_DESC, 
"RTN","C0PLOAD",59,0)
    ; MED_REF_FED_LEGEND_IND, MED_REF_FED_LEGEND_IND_DESC, GENERIC_MEDID, 
"RTN","C0PLOAD",60,0)
    ; MED_NAME_TYPE_CD, GENERIC_MED_REF_GEN_DRUG_NAME_CD, MED_NAME_SOURCE_CD, 
"RTN","C0PLOAD",61,0)
    ; DrugInfo, GenericDrugNameOverride, FormularyDrugID, Manufacturer, Status, 
"RTN","C0PLOAD",62,0)
    ; TouchDate, DrugTypeID FROM tblCompositeDrug 
"RTN","C0PLOAD",63,0)
    ; 
"RTN","C0PLOAD",64,0)
    ; The allergies file is produced by importing the tblCompositeAllergy file
"RTN","C0PLOAD",65,0)
    ;
"RTN","C0PLOAD",66,0)
    ; Here's the mdb command to extract the file.
"RTN","C0PLOAD",67,0)
    ; mdb-export -HQ -d "|" NCFull-201203.mdb tblCompositeAllergy > tblCompositeAllergy.rrf
"RTN","C0PLOAD",68,0)
    ; 
"RTN","C0PLOAD",69,0)
    ; There is no SQL here.
"RTN","C0PLOAD",70,0)
    ;
"RTN","C0PLOAD",71,0)
    ; Once you have both files, you can adjust the routine to where the files are
"RTN","C0PLOAD",72,0)
    ; and then import them by calling the PEPs below.
"RTN","C0PLOAD",73,0)
    ;
"RTN","C0PLOAD",74,0)
    ; Update: I wrote a bash script to automate this: it's called:
"RTN","C0PLOAD",75,0)
    ;   drug_data_extract.sh
"RTN","C0PLOAD",76,0)
    ;
"RTN","C0PLOAD",77,0)
FDBIMP  ; FDB Drug File Import; PEP. Interactive (for now).
"RTN","C0PLOAD",78,0)
    ;
"RTN","C0PLOAD",79,0)
    ;
"RTN","C0PLOAD",80,0)
    N FILEPATH
"RTN","C0PLOAD",81,0)
    R "Enter RRF FDB Drug File with Full Path: ",FILEPATH:60,!
"RTN","C0PLOAD",82,0)
    I '$L(FILEPATH) QUIT
"RTN","C0PLOAD",83,0)
    ;
"RTN","C0PLOAD",84,0)
    ; NB: The following will only work on Unix
"RTN","C0PLOAD",85,0)
    N PATH,FILE
"RTN","C0PLOAD",86,0)
    N PIECES S PIECES=$L(FILEPATH,"/")
"RTN","C0PLOAD",87,0)
    S PATH=$P(FILEPATH,"/",1,PIECES-1)
"RTN","C0PLOAD",88,0)
    S FILE=$P(FILEPATH,"/",PIECES)
"RTN","C0PLOAD",89,0)
    ;
"RTN","C0PLOAD",90,0)
    ; Kill off the existing file
"RTN","C0PLOAD",91,0)
    N %1 S %1=^C0P("FDB",0)    ; save zero node
"RTN","C0PLOAD",92,0)
    S $P(%1,"^",3,4)=""        ; zero last record numbers
"RTN","C0PLOAD",93,0)
    K ^C0P("FDB")              ; kill file
"RTN","C0PLOAD",94,0)
    S ^C0P("FDB",0)=%1         ; restore zero node
"RTN","C0PLOAD",95,0)
    ;
"RTN","C0PLOAD",96,0)
    ; Import File from text extract (Please I want an ODBC driver!)
"RTN","C0PLOAD",97,0)
    ; 
"RTN","C0PLOAD",98,0)
    D CLEAN^DILF
"RTN","C0PLOAD",99,0)
    N CONTROL
"RTN","C0PLOAD",100,0)
    S CONTROL("FLAGS")="E"  ; External Values...
"RTN","C0PLOAD",101,0)
    S CONTROL("MSGS")=""   ; go as normal in ^TMP("DIERR",$J)
"RTN","C0PLOAD",102,0)
    S CONTROL("MAXERR")="100" ; abort if you can't file a hundred records
"RTN","C0PLOAD",103,0)
    ; S CONTROL("IOP")="HOME"    ; Send to home device ; smh - don't pass; API no like for HOME output
"RTN","C0PLOAD",104,0)
    S CONTROL("QTIME")=""  ; Don't Queue
"RTN","C0PLOAD",105,0)
    N SOURCE
"RTN","C0PLOAD",106,0)
    S SOURCE("FILE")=FILE               ; File Name
"RTN","C0PLOAD",107,0)
    S SOURCE("PATH")=PATH               ; Directory
"RTN","C0PLOAD",108,0)
    N FORMAT
"RTN","C0PLOAD",109,0)
    S FORMAT("FDELIM")="|"                 ; Delimiter
"RTN","C0PLOAD",110,0)
    S FORMAT("FIXED")=""                   ; Fixed Width?
"RTN","C0PLOAD",111,0)
    S FORMAT("QUOTED")=""                  ; Are strings quoted?
"RTN","C0PLOAD",112,0)
    ;
"RTN","C0PLOAD",113,0)
    D FILE^DDMP(1130590010,"[C0P FDB TBLCOMPOSITEDRUG]",.CONTROL,.SOURCE,.FORMAT)
"RTN","C0PLOAD",114,0)
    QUIT
"RTN","C0PLOAD",115,0)
    ;
"RTN","C0PLOAD",116,0)
FDBAIMP ; FDB Allergies Import; PEP. Interactive (for now)
"RTN","C0PLOAD",117,0)
    ; 
"RTN","C0PLOAD",118,0)
    ; 
"RTN","C0PLOAD",119,0)
    N FILEPATH
"RTN","C0PLOAD",120,0)
    R "Enter RRF FDB Allergy File with Full Path: ",FILEPATH:60,!
"RTN","C0PLOAD",121,0)
    I '$L(FILEPATH) QUIT
"RTN","C0PLOAD",122,0)
    ;
"RTN","C0PLOAD",123,0)
    ; NB: The following will only work on Unix
"RTN","C0PLOAD",124,0)
    N PATH,FILE
"RTN","C0PLOAD",125,0)
    N PIECES S PIECES=$L(FILEPATH,"/")
"RTN","C0PLOAD",126,0)
    S PATH=$P(FILEPATH,"/",1,PIECES-1)
"RTN","C0PLOAD",127,0)
    S FILE=$P(FILEPATH,"/",PIECES)
"RTN","C0PLOAD",128,0)
    ; 
"RTN","C0PLOAD",129,0)
    ; Kill off the existing file
"RTN","C0PLOAD",130,0)
    N %1 S %1=^C0PALGY(0)  ; save zero node
"RTN","C0PLOAD",131,0)
    S $P(%1,"^",3,4)=""    ; zero last record numbers
"RTN","C0PLOAD",132,0)
    K ^C0PALGY             ; kill file
"RTN","C0PLOAD",133,0)
    S ^C0PALGY(0)=%1       ; restore zero node
"RTN","C0PLOAD",134,0)
    ;
"RTN","C0PLOAD",135,0)
    ; Import file from text extract
"RTN","C0PLOAD",136,0)
    D CLEAN^DILF
"RTN","C0PLOAD",137,0)
    N CONTROL
"RTN","C0PLOAD",138,0)
    S CONTROL("FLAGS")="E"  ; External Values...
"RTN","C0PLOAD",139,0)
    S CONTROL("MSGS")=""   ; go as normal in ^TMP("DIERR",$J)
"RTN","C0PLOAD",140,0)
    S CONTROL("MAXERR")="100" ; abort if you can't file a hundred records
"RTN","C0PLOAD",141,0)
    ; S CONTROL("IOP")="HOME"    ; Send to home device ; smh - don't pass; API no like for HOME output
"RTN","C0PLOAD",142,0)
    S CONTROL("QTIME")=""  ; Don't Queue
"RTN","C0PLOAD",143,0)
    N SOURCE
"RTN","C0PLOAD",144,0)
    S SOURCE("FILE")=FILE                   ; File Name
"RTN","C0PLOAD",145,0)
    S SOURCE("PATH")=PATH                   ; Directory
"RTN","C0PLOAD",146,0)
    N FORMAT
"RTN","C0PLOAD",147,0)
    S FORMAT("FDELIM")="|"                 ; Delimiter
"RTN","C0PLOAD",148,0)
    S FORMAT("FIXED")=""                   ; Fixed Width?
"RTN","C0PLOAD",149,0)
    S FORMAT("QUOTED")=""                  ; Are strings quoted?
"RTN","C0PLOAD",150,0)
    ;
"RTN","C0PLOAD",151,0)
    D FILE^DDMP(113059005,"[C0P FDB TBLCOMPOSITEALLERGY]",.CONTROL,.SOURCE,.FORMAT)
"RTN","C0PLOAD",152,0)
    QUIT
"RTN","C0PLOAD",153,0)
RXNIMP ; Import RxNorm Concepts File; Modded from C0CRXNRD
"RTN","C0PLOAD",154,0)
    N FILEPATH
"RTN","C0PLOAD",155,0)
    R "Enter RRF RxNorm Conepts File with Full Path: ",FILEPATH:60,!
"RTN","C0PLOAD",156,0)
    I '$L(FILEPATH) QUIT
"RTN","C0PLOAD",157,0)
    ;
"RTN","C0PLOAD",158,0)
    ; NB: The following will only work on Unix
"RTN","C0PLOAD",159,0)
    N PATH,FILE
"RTN","C0PLOAD",160,0)
    N PIECES S PIECES=$L(FILEPATH,"/")
"RTN","C0PLOAD",161,0)
    S PATH=$P(FILEPATH,"/",1,PIECES-1)
"RTN","C0PLOAD",162,0)
    S FILE=$P(FILEPATH,"/",PIECES)
"RTN","C0PLOAD",163,0)
    ;
"RTN","C0PLOAD",164,0)
    N LINES S LINES=$$GETLINES(PATH,FILE)
"RTN","C0PLOAD",165,0)
    D OPEN^%ZISH("FILE",PATH,FILE,"R")
"RTN","C0PLOAD",166,0)
    ;
"RTN","C0PLOAD",167,0)
    IF POP D EN^DDIOL("Error reading file..., Please check...") G EX
"RTN","C0PLOAD",168,0)
    ;
"RTN","C0PLOAD",169,0)
    N %1 S %1=^C0P("RXN",0)
"RTN","C0PLOAD",170,0)
    S $P(%1,"^",3,4)=""
"RTN","C0PLOAD",171,0)
    K ^C0P("RXN")
"RTN","C0PLOAD",172,0)
    S ^C0P("RXN",0)=%1
"RTN","C0PLOAD",173,0)
    ; 
"RTN","C0PLOAD",174,0)
    N C0CCOUNT
"RTN","C0PLOAD",175,0)
    F C0CCOUNT=1:1 D  Q:$$STATUS^%ZISH
"RTN","C0PLOAD",176,0)
    . U IO
"RTN","C0PLOAD",177,0)
    . N LINE R LINE:1
"RTN","C0PLOAD",178,0)
    . IF $$STATUS^%ZISH QUIT
"RTN","C0PLOAD",179,0)
    . I '(C0CCOUNT#1000) U $P W C0CCOUNT," of ",LINES," read ",! U IO ; update every 1000
"RTN","C0PLOAD",180,0)
    . N RXCUI,RXAUI,SAB,TTY,CODE,STR  ; Fileman fields numbers below
"RTN","C0PLOAD",181,0)
    . S RXCUI=$P(LINE,"|",1)    ; .01
"RTN","C0PLOAD",182,0)
    . S RXAUI=$P(LINE,"|",8)    ; 1
"RTN","C0PLOAD",183,0)
    . S SAB=$P(LINE,"|",12) ; 2
"RTN","C0PLOAD",184,0)
    . ;
"RTN","C0PLOAD",185,0)
    . ; Following lines not applicable here:
"RTN","C0PLOAD",186,0)
    . ; If the source is a restricted source, decide what to do based on what's asked.
"RTN","C0PLOAD",187,0)
    . ; N SRCIEN S SRCIEN=$$FIND1^DIC(176.003,"","QX",SAB,"B") ; SrcIEN in RXNORM SOURCES file
"RTN","C0PLOAD",188,0)
    . ; N RESTRIC S RESTRIC=$$GET1^DIQ(176.003,SRCIEN,14,"I") ; 14 is restriction field; values 0-4
"RTN","C0PLOAD",189,0)
    . ; If RESTRIC is zero, then it's unrestricted. Everything else is restricted.
"RTN","C0PLOAD",190,0)
    . ; If user didn't ask to include restricted sources, and the source is restricted, then quit
"RTN","C0PLOAD",191,0)
    . ; I 'INCRES,RESTRIC QUIT
"RTN","C0PLOAD",192,0)
    . ;
"RTN","C0PLOAD",193,0)
    . S TTY=$P(LINE,"|",13) ; 3
"RTN","C0PLOAD",194,0)
    . S CODE=$P(LINE,"|",14)    ; 4
"RTN","C0PLOAD",195,0)
    . S STR=$P(LINE,"|",15) ; 5
"RTN","C0PLOAD",196,0)
    . ; Remove embedded "^"
"RTN","C0PLOAD",197,0)
    . S STR=$TR(STR,"^")
"RTN","C0PLOAD",198,0)
    . ; Convert STR into an array of 80 characters on each line
"RTN","C0PLOAD",199,0)
    . N STRLINE S STRLINE=$L(STR)\80+1
"RTN","C0PLOAD",200,0)
    . ; In each line, chop 80 characters off, reset STR to be the rest
"RTN","C0PLOAD",201,0)
    . N J F J=1:1:STRLINE S STR(J)=$E(STR,1,80) S STR=$E(STR,81,$L(STR))
"RTN","C0PLOAD",202,0)
    . ; Now, construct the FDA array
"RTN","C0PLOAD",203,0)
    . N RXNFDA
"RTN","C0PLOAD",204,0)
    . S RXNFDA(1130590011.001,"+1,",.01)=RXCUI
"RTN","C0PLOAD",205,0)
    . S RXNFDA(1130590011.001,"+1,",1)=RXAUI
"RTN","C0PLOAD",206,0)
    . S RXNFDA(1130590011.001,"+1,",2)=SAB
"RTN","C0PLOAD",207,0)
    . S RXNFDA(1130590011.001,"+1,",3)=TTY
"RTN","C0PLOAD",208,0)
    . S RXNFDA(1130590011.001,"+1,",4)=CODE
"RTN","C0PLOAD",209,0)
    . N RXNIEN S RXNIEN(1)=C0CCOUNT
"RTN","C0PLOAD",210,0)
    . D UPDATE^DIE("","RXNFDA","RXNIEN")
"RTN","C0PLOAD",211,0)
    . I $D(^TMP("DIERR",$J)) D EN^DDIOL("ERROR") G EX
"RTN","C0PLOAD",212,0)
    . ; Now, file WP field STR
"RTN","C0PLOAD",213,0)
    . D WP^DIE(1130590011.001,C0CCOUNT_",",5,,$NA(STR))
"RTN","C0PLOAD",214,0)
EX  D CLOSE^%ZISH("FILE")
"RTN","C0PLOAD",215,0)
    QUIT
"RTN","C0PLOAD",216,0)
GETLINES(PATH,FILENAME) ; Get number of lines in a file
"RTN","C0PLOAD",217,0)
    D OPEN^%ZISH("FILE",PATH,FILENAME,"R")
"RTN","C0PLOAD",218,0)
    U IO
"RTN","C0PLOAD",219,0)
    N I
"RTN","C0PLOAD",220,0)
    F I=1:1 R LINE:1 Q:$$STATUS^%ZISH
"RTN","C0PLOAD",221,0)
    D CLOSE^%ZISH("FILE")
"RTN","C0PLOAD",222,0)
    Q I-1
"RTN","C0PMAIN")
0^6^B53352632
"RTN","C0PMAIN",1,0)
C0PMAIN   ; ERX/GPL - Web Service main entry points; 9/24/09 ; 5/8/12 10:28pm
"RTN","C0PMAIN",2,0)
 ;;1.0;C0P;;Apr 25, 2012;Build 103
"RTN","C0PMAIN",3,0)
 ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"RTN","C0PMAIN",4,0)
 ;General Public License See attached copy of the License.
"RTN","C0PMAIN",5,0)
 ;
"RTN","C0PMAIN",6,0)
 ;This program is free software; you can redistribute it and/or modify
"RTN","C0PMAIN",7,0)
 ;it under the terms of the GNU General Public License as published by
"RTN","C0PMAIN",8,0)
 ;the Free Software Foundation; either version 2 of the License, or
"RTN","C0PMAIN",9,0)
 ;(at your option) any later version.
"RTN","C0PMAIN",10,0)
 ;
"RTN","C0PMAIN",11,0)
 ;This program is distributed in the hope that it will be useful,
"RTN","C0PMAIN",12,0)
 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0PMAIN",13,0)
 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"RTN","C0PMAIN",14,0)
 ;GNU General Public License for more details.
"RTN","C0PMAIN",15,0)
 ;
"RTN","C0PMAIN",16,0)
 ;You should have received a copy of the GNU General Public License along
"RTN","C0PMAIN",17,0)
 ;with this program; if not, write to the Free Software Foundation, Inc.,
"RTN","C0PMAIN",18,0)
 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
"RTN","C0PMAIN",19,0)
 ;
"RTN","C0PMAIN",20,0)
 Q
"RTN","C0PMAIN",21,0)
ACCOUNTF()  Q 113059002  ; file number for account file
"RTN","C0PMAIN",22,0)
F200C0P() Q 200.113059 ; Subfile number of C0P Subscription Multiple
"RTN","C0PMAIN",23,0)
WSFILE() Q 113059003 ; file number for web service file
"RTN","C0PMAIN",24,0)
WSROLEF() Q 113059003.04 ; Subfile for web service role map
"RTN","C0PMAIN",25,0)
 ;
"RTN","C0PMAIN",26,0)
EN(RTNXML,RTNURL,C0PDUZ,C0PDFN,TID,C0PVOR,WALGY) ; ERX Entry PEP ; Public
"RTN","C0PMAIN",27,0)
 ; IF WALGY=1, FREE FORM ALLERGIES WILL BE ADDED
"RTN","C0PMAIN",28,0)
 ; RETURNS THE XML PORTION OF THE RPC RESPONSE
"RTN","C0PMAIN",29,0)
 ; IN RTNXML, PASSED BY NAME 
"RTN","C0PMAIN",30,0)
 ; TODO: What's RTNURL used for? it's not referenced in the rest of the routine.
"RTN","C0PMAIN",31,0)
 ; C0PVOR IS A VARIABLE OVERRIDE ARRAY WITH IS APPLIED BEFORE MAPPING
"RTN","C0PMAIN",32,0)
 ;
"RTN","C0PMAIN",33,0)
 ; ERXSERVIEN is ERX Service IEN in Subfile C0P in file 200
"RTN","C0PMAIN",34,0)
 D SETACCT^C0PSUB("C0PVARS",C0PDUZ) ; INITIALIZE SUBSCRIBER VARIABLES
"RTN","C0PMAIN",35,0)
 I ERXSERVIEN="" Q  ; PERSON NOT SUBSCRIBED
"RTN","C0PMAIN",36,0)
 ;D SETUP() ; INITIALIZE SERVICE AND ACCOUNT VARIABLES
"RTN","C0PMAIN",37,0)
 ;S C0PROLE=$$GET1^DIQ($$F200C0P(),ERXSERVIEN_","_C0PDUZ_",",4,"I")
"RTN","C0PMAIN",38,0)
 ;I C0PROLE="" S C0PROLE="P" ; DEFAULT TO PRESCRIBER ROLE
"RTN","C0PMAIN",39,0)
 ; ROLE MAPPING TO TEMPLATE ID IS FOUND IN THE WEB SERVICE FILE
"RTN","C0PMAIN",40,0)
 ;N ROLEIEN S ROLEIEN=$O(^C0PW(C0PWS,5,"B",C0PROLE,"")) ; IEN OF ROLE MAP
"RTN","C0PMAIN",41,0)
 ;I '$D(TID) S TID=$$GET1^DIQ($$WSROLEF(),ROLEIEN_","_C0PWS_",",1,"I") ;
"RTN","C0PMAIN",42,0)
 I '$D(TID) D  ; SET TEMPLATE ACCORDING TO USER TYPE
"RTN","C0PMAIN",43,0)
 . I C0PROLE="D" S TID="ORDER" ; DEFAULT FOR PRESCRIBER
"RTN","C0PMAIN",44,0)
 . I C0PROLE="M" S TID="STAFF" ; DEFAULT FOR MANAGER
"RTN","C0PMAIN",45,0)
 . I C0PROLE="A" S TID="STAFF" ; DEFAULT FOR ADMIN
"RTN","C0PMAIN",46,0)
 . I C0PROLE="N" S TID="NURSE" ; DEFAULT FOR MIDLEVEL
"RTN","C0PMAIN",47,0)
 . I C0PTYPE="M" S TID="MIDLEVEL" ; DEFAULT FOR MIDLEVEL
"RTN","C0PMAIN",48,0)
 . I C0PTYPE="P" S TID="ORDER" ; OVERRIDE FOR PRESCRIBERS
"RTN","C0PMAIN",49,0)
 . I '$D(TID) S TID="ORDER" ; ALL OTHERS
"RTN","C0PMAIN",50,0)
 I TID="STAFF" S WALGY=0 ; DON'T SEND ALLERGIES WITH STAFF TEMPLATE
"RTN","C0PMAIN",51,0)
 N UTID ;TID TO USE
"RTN","C0PMAIN",52,0)
 I +TID=0 D  ; IF A TEMPLATE NAME WAS PASSED INSTEAD OF AN IEN
"RTN","C0PMAIN",53,0)
 . S UTID=$$RESTID^C0PWS1(C0PDUZ,TID) ;RESOLVE TEMPLATE IEN FROM NAME
"RTN","C0PMAIN",54,0)
 E  S UTID=TID ;
"RTN","C0PMAIN",55,0)
 D EN^C0PSUB("C0PVARS",C0PDUZ) ;INITIALIZE SUBSCRIBER VARIABLES
"RTN","C0PMAIN",56,0)
 I TID="MIDLEVEL" D  ; FOR MIDLEVELS
"RTN","C0PMAIN",57,0)
 . I $G(C0PRMODE)="" Q  ; NOT RENEWAL MODE 
"RTN","C0PMAIN",58,0)
 . ; IN RENEWAL MODE, THE SUPERVISING DOCTOR IS FOUND IN C0PSUPERV
"RTN","C0PMAIN",59,0)
 . ;N G
"RTN","C0PMAIN",60,0)
 . I $G(C0PSPRV)="" S C0PSPRV=$G(C0PVARS("SUPERVISING-DOCTOR-DUZ"))
"RTN","C0PMAIN",61,0)
 . I C0PSPRV="" Q  ; SUPERVISING DOCTOR IS NOT SET FOR THIS MIDLEVEL
"RTN","C0PMAIN",62,0)
 . D EN^C0PSUB("G",$G(C0PSPRV)) ; GET VARS FOR SUPERVISOR
"RTN","C0PMAIN",63,0)
 . S C0PVARS("SUPERVISING-NPI")=$G(G("SUBSCRIBER-NPI"))
"RTN","C0PMAIN",64,0)
 . S C0PVARS("SUPERVISING-DEA")=$G(G("SUBSCRIBER-DEA"))
"RTN","C0PMAIN",65,0)
 . S C0PVARS("SUPERVISING-SID")=$G(G("SUBSCRIBER-SID"))
"RTN","C0PMAIN",66,0)
 . S C0PVARS("SUPERVISING-FAMILY-NAME")=$G(G("SUBCRIBER-FAMILY-NAME"))
"RTN","C0PMAIN",67,0)
 . S C0PVARS("SUPERVISING-GIVEN-NAME")=$G(G("SUBCRIBER-GIVEN-NAME"))
"RTN","C0PMAIN",68,0)
 . S C0PVARS("SUPERVISING-LICENSE")=$G(G("SUBSCRIBER-LICENSE"))
"RTN","C0PMAIN",69,0)
 . S C0PVARS("SUPERVISING-LICENSE-STATE")=$G(G("SUBSCRIBER-LICENSE-STATE"))
"RTN","C0PMAIN",70,0)
 . ;K G
"RTN","C0PMAIN",71,0)
 I $D(C0PDFN) D EN^C0PPAT("C0PVARS",C0PDFN) ;INITIALIZE PATIENT VARIABLES
"RTN","C0PMAIN",72,0)
 I $G(C0PVOR)'="" M C0PVARS=@C0PVOR ; VARIABLE OVERRIDES APPLIED HERE
"RTN","C0PMAIN",73,0)
 N C0PXP ; NEW XPATH ARRAY
"RTN","C0PMAIN",74,0)
 D BIND("C0PXP","C0PVARS",UTID) ; BIND TO VARIABLES
"RTN","C0PMAIN",75,0)
 N ZZZXML S ZZZXML=RTNXML ; SYMBOL TABLE PROBLEMS
"RTN","C0PMAIN",76,0)
 K @RTNXML ; MAKE SURE WE HAVE A CLEAN SLATE 
"RTN","C0PMAIN",77,0)
 D MAP(ZZZXML,"C0PXP",UTID) ; MAP VARIABLE TO TEMPLATE
"RTN","C0PMAIN",78,0)
 I TID="MIDLEVEL" D  ; FOR MIDLEVELS
"RTN","C0PMAIN",79,0)
 . I $G(C0PRMODE)=1 Q  ; IN RENEWAL MODE 
"RTN","C0PMAIN",80,0)
 . D DELETE^C0CXPATH(ZZZXML,"//NCScript/SupervisingDoctor") ;only for rew
"RTN","C0PMAIN",81,0)
 . ;D REPLACE^C0CXPATH(ZZZXML,"","//NCScript/SupervisingDoctor") ;only for rew
"RTN","C0PMAIN",82,0)
 I $G(WALGY)=1 D  ; ADD ALLERGIES AND SENDMEDS FOR CLICKTHROUGH
"RTN","C0PMAIN",83,0)
 . D ADDALGY^C0PALGY3(ZZZXML,C0PDUZ,C0PDFN) ;ADD ALLERGIES 
"RTN","C0PMAIN",84,0)
 . N ZSMEDS ; SEND MEDS
"RTN","C0PMAIN",85,0)
 . D FREETXT^C0PSMEDS("ZSMEDS",C0PDUZ,C0PDFN) ; GET MEDS TO SEND
"RTN","C0PMAIN",86,0)
 . I +$D(ZSMEDS)'=0 D ADD^C0PSMEDS(ZZZXML,"ZSMEDS") ; ADD TO NCSCRIPT
"RTN","C0PMAIN",87,0)
 N TRIMI,J,DONE S DONE=0
"RTN","C0PMAIN",88,0)
 F TRIMI=0:0 D  Q:DONE  ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
"RTN","C0PMAIN",89,0)
 . S J=$$TRIM^C0CXPATH(RTNXML) ; DELETE EMPTY ELEMENTS
"RTN","C0PMAIN",90,0)
 . I DEBUG W "TRIMMED",J,!
"RTN","C0PMAIN",91,0)
 . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
"RTN","C0PMAIN",92,0)
 K @RTNXML@(0) ;GET RID OF LINE COUNT
"RTN","C0PMAIN",93,0)
 Q
"RTN","C0PMAIN",94,0)
 ;
"RTN","C0PMAIN",95,0)
SETUP() ;INITIALIZE SERVICE AND ACCOUNT VARIABLE
"RTN","C0PMAIN",96,0)
 ;I '$D(C0PDUZ) S C0PDUZ=$O(^VA(200,"B","BATCH,ERX","")) ; DUZ OF BATCH USER
"RTN","C0PMAIN",97,0)
 I '$D(C0PDUZ) S C0PDUZ=DUZ ; smh per gpl on 5/3/2012
"RTN","C0PMAIN",98,0)
 ;N ERXSERVIEN 
"RTN","C0PMAIN",99,0)
 S ERXSERVIEN=$$SUBINIT^C0PSUB(C0PDUZ)
"RTN","C0PMAIN",100,0)
 I ERXSERVIEN="" D ERROR(",U113059001,",$ST($ST,"PLACE"),"ERX-NOSUB","Provider Not Subscribed") Q  ;
"RTN","C0PMAIN",101,0)
 ; . ;W "ERROR, PROVIDER NOT SUBSCRIBED",! ;
"RTN","C0PMAIN",102,0)
 ; . ;S $EC=",U C0P ERROR - PROVIDER NOT SUBSCRIBED,"
"RTN","C0PMAIN",103,0)
 ; . ;S $EC=",U840201001," ;  
"RTN","C0PMAIN",104,0)
 ; N C0PVARS ; ARRAY TO HOLD CONTEXT VARIABLES FOR BINDING
"RTN","C0PMAIN",105,0)
 S C0PACCT=$$GET1^DIQ($$F200C0P(),ERXSERVIEN_","_C0PDUZ_",",1,"I")
"RTN","C0PMAIN",106,0)
 S C0PLOC=$$GET1^DIQ($$F200C0P(),ERXSERVIEN_","_C0PDUZ_",",2,"I")
"RTN","C0PMAIN",107,0)
 S C0PWS=$$GET1^DIQ($$ACCOUNTF(),C0PACCT_",",4,"I") ; WEB SERVICE POINTER
"RTN","C0PMAIN",108,0)
 Q
"RTN","C0PMAIN",109,0)
 ;
"RTN","C0PMAIN",110,0)
PRIMARY() ; EXTRINSIC WHICH RETURNS PRIMARY ERX SUBSCRIBER DUZ
"RTN","C0PMAIN",111,0)
 D SETUP() ; SET ACCOUNT VARIABLES
"RTN","C0PMAIN",112,0)
 N C0PPRI
"RTN","C0PMAIN",113,0)
 S C0PPRI=$$GET1^DIQ($$ACCOUNTF(),C0PACCT_",",6,"I") ; DUZ OF PRIMARY
"RTN","C0PMAIN",114,0)
 Q C0PPRI ; RETURN DUZ
"RTN","C0PMAIN",115,0)
 ;
"RTN","C0PMAIN",116,0)
WSURL(ZACCT) ; EXTRINSIC TO RETURN THE URL TO USE FOR WEB SERVICES
"RTN","C0PMAIN",117,0)
 ; IT WILL DETERMINE WHETHER THE PRODUCTION SWITCH IS ON IN THE
"RTN","C0PMAIN",118,0)
 ; ACCOUNT FILE AND IF YES RETURN THE PRODUCTION URL
"RTN","C0PMAIN",119,0)
 ; IF NOT RETURN THE PREPRODUCTION TEST URL
"RTN","C0PMAIN",120,0)
 N ZR,ZP,ZT
"RTN","C0PMAIN",121,0)
 S ZP=$$GET1^DIQ(113059002,ZACCT_",",7,"I") ; PRODUCTION FLAG
"RTN","C0PMAIN",122,0)
 I ZP="P" D  ; PRODUCTION FLAG SET
"RTN","C0PMAIN",123,0)
 . S ZT=$O(^C0PX("B","PRODUCTION WS URL","")) ; PRODUCION TEMPLATE
"RTN","C0PMAIN",124,0)
 . S ZR=$$GET1^DIQ(113059001,ZT_",",1) ; URL FIELD
"RTN","C0PMAIN",125,0)
 E  D  ; PRODUCTION FLAG NOT SET
"RTN","C0PMAIN",126,0)
 . S ZT=$O(^C0PX("B","TEST WS URL","")) ; TEST TEMPLATE
"RTN","C0PMAIN",127,0)
 . S ZR=$$GET1^DIQ(113059001,ZT_",",1) ; URL FIELD
"RTN","C0PMAIN",128,0)
 Q ZR
"RTN","C0PMAIN",129,0)
 ;
"RTN","C0PMAIN",130,0)
CTURL(ZACCT) ; EXTRINSIC TO RETURN THE URL TO USE FOR CLICKTHROUGH
"RTN","C0PMAIN",131,0)
 ; IT WILL DETERMINE WHETHER THE PRODUCTION SWITCH IS ON IN THE
"RTN","C0PMAIN",132,0)
 ; ACCOUNT FILE AND IF YES RETURN THE PRODUCTION URL
"RTN","C0PMAIN",133,0)
 ; IF NOT RETURN THE PREPRODUCTION TEST URL
"RTN","C0PMAIN",134,0)
 N ZR,ZP,ZT
"RTN","C0PMAIN",135,0)
 S ZP=$$GET1^DIQ(113059002,ZACCT_",",7,"I") ; PRODUCTION FLAG
"RTN","C0PMAIN",136,0)
 I ZP="P" D  ; PRODUCTION FLAG SET
"RTN","C0PMAIN",137,0)
 . S ZT=$O(^C0PX("B","PRODUCTION CLICKTHROUGH URL","")) ; PRODUCION TEMPLATE
"RTN","C0PMAIN",138,0)
 . S ZR=$$GET1^DIQ(113059001,ZT_",",1) ; URL FIELD
"RTN","C0PMAIN",139,0)
 E  D  ; PRODUCTION FLAG NOT SET
"RTN","C0PMAIN",140,0)
 . S ZT=$O(^C0PX("B","TEST CLICKTHROUGH URL","")) ; TEST TEMPLATE
"RTN","C0PMAIN",141,0)
 . S ZR=$$GET1^DIQ(113059001,ZT_",",1) ; URL FIELD
"RTN","C0PMAIN",142,0)
 Q ZR
"RTN","C0PMAIN",143,0)
 ;
"RTN","C0PMAIN",144,0)
MAP(RARY,IVARS,TPTR) ;RETURNS MAPPED XML IN RARY PASSED BY NAME
"RTN","C0PMAIN",145,0)
 ; IVARS IS AN XPATH ARRAY PASSED BY NAME
"RTN","C0PMAIN",146,0)
 ; TPTR IS A POINT TO THE C0P XML TEMPLATE FILE USED TO RETRIEVE THE TEMPLATE
"RTN","C0PMAIN",147,0)
 ;
"RTN","C0PMAIN",148,0)
 N ZT ;THE TEMPLATE
"RTN","C0PMAIN",149,0)
 K ZT,@RARY
"RTN","C0PMAIN",150,0)
 I $$GET1^DIQ(113059001,TPTR_",",3,,"ZT")'="ZT" D  Q  ; ERROR GETTING TEMPLATE
"RTN","C0PMAIN",151,0)
 . W "ERROR RETRIEVING TEMPLATE",!
"RTN","C0PMAIN",152,0)
 D MAP^C0CXPATH("ZT",IVARS,RARY) ;DO THE MAPPING
"RTN","C0PMAIN",153,0)
 Q
"RTN","C0PMAIN",154,0)
 ;
"RTN","C0PMAIN",155,0)
BIND(RARY,IVARS,TPTR) ;RETURNS AN XPATH ARRAY IN RARY FOR USE WITH MAP
"RTN","C0PMAIN",156,0)
 ; TO BUILD AN INSTANTIATED TEMPLATE
"RTN","C0PMAIN",157,0)
 ; TPTR IS THE IEN OF THE XML TEMPATE IN THE C0P XML TEMPLATE FILE
"RTN","C0PMAIN",158,0)
 ; LOOPS THROUGHT THE BINDING SUBFILE TO PULL OUT XPATHS AND 
"RTN","C0PMAIN",159,0)
 ; EITHER ASSIGNS VARIABLES OR DOES A FILEMAN CALL TO GET VALUES
"RTN","C0PMAIN",160,0)
 ; VARIABLES ARE IN IVARS WHICH IS PASSED BY NAME
"RTN","C0PMAIN",161,0)
 S C0PBF=113059001.04 ; BINDING SUBFILE NUMBER
"RTN","C0PMAIN",162,0)
 N ZI
"RTN","C0PMAIN",163,0)
 S ZI=""
"RTN","C0PMAIN",164,0)
 F  S ZI=$O(^C0PX(TPTR,5,"B",ZI)) Q:ZI=""  D  ; FOR EACH XPATH
"RTN","C0PMAIN",165,0)
 . N ZIEN,ZFILE,ZFIELD,ZVAR,ZIDX,ZINDEX ;
"RTN","C0PMAIN",166,0)
 . S ZIEN=$O(^C0PX(TPTR,5,"B",ZI,"")) ;IEN OF THE BINDING RECORD
"RTN","C0PMAIN",167,0)
 . S ZFILE=$$GET1^DIQ(C0PBF,ZIEN_","_TPTR_",",1.1,"I")
"RTN","C0PMAIN",168,0)
 . S ZFIELD=$$GET1^DIQ(C0PBF,ZIEN_","_TPTR_",",1.2,"I")
"RTN","C0PMAIN",169,0)
 . S ZVAR=$$GET1^DIQ(C0PBF,ZIEN_","_TPTR_",",2,"E")
"RTN","C0PMAIN",170,0)
 . S ZIDX=$$GET1^DIQ(C0PBF,ZIEN_","_TPTR_",",.05,"I")
"RTN","C0PMAIN",171,0)
 . S ZINDEX=""
"RTN","C0PMAIN",172,0)
 . I ZIDX="DUZ" S ZINDEX=C0PDUZ ; FILE IS INDEXED BY DUZ
"RTN","C0PMAIN",173,0)
 . I ZIDX="DFN" S ZINDEX=C0PDFN ; BY DFN
"RTN","C0PMAIN",174,0)
 . I ZIDX="ACCT" S ZINDEX=C0PACCT ; BY ACCOUNT RECORD POINT TO C0P WS ACCT
"RTN","C0PMAIN",175,0)
 . I ZIDX="LOC" S ZINDEX=C0PLOC ; BY LOCATION
"RTN","C0PMAIN",176,0)
 . I ZVAR'="" D  ; VARIABLES TAKE PRESCIDENCE OVER FILEMAN FIELDS
"RTN","C0PMAIN",177,0)
 . . S @RARY@(ZI)=$G(@IVARS@(ZVAR)) ; 
"RTN","C0PMAIN",178,0)
 . E  D  ; IF NO VARIABLE, TRY ACCESSING FROM FILEMAN
"RTN","C0PMAIN",179,0)
 . . I (ZFILE="")!(ZFIELD="") Q  ;QUIT IF FILE OR FIELD NOT THERE
"RTN","C0PMAIN",180,0)
 . . D CLEAN^DILF
"RTN","C0PMAIN",181,0)
 . . S @RARY@(ZI)=$$GET1^DIQ(ZFILE,ZINDEX_",",ZFIELD) ;GET THE VALUE
"RTN","C0PMAIN",182,0)
 . . I $D(^TMP("DIERR",$J,1)) D ERROR^C0PMAIN(",U113059006,",$ST($ST,"PLACE"),"ERX-DATA-NOTFOUND","Data Not Found.") QUIT
"RTN","C0PMAIN",183,0)
 Q
"RTN","C0PMAIN",184,0)
 ;
"RTN","C0PMAIN",185,0)
BLDXML(ARTN,AWS,TNAME) ; RETURNS AN XML ARRAY IN ARTN PASSED BY NAME ; AWS IS AN ENTRY IN THE C0P WEB SERVICE FILE, EXTERNAL FORMAT
"RTN","C0PMAIN",186,0)
 ; TNAME IS AN ENTRY IN THE C0P XML TEMPLATE FILE WHICH BELONG TO THE AWS
"RTN","C0PMAIN",187,0)
 ; IT IS ASSUMED THAT THE WS CONTEXT IS ESTABLISHED AND ALL VARIABLES
"RTN","C0PMAIN",188,0)
 ; NEEDED BY THE BINDINGS IN THE XML TEMPLATE ARE INITIALIZED
"RTN","C0PMAIN",189,0)
 Q
"RTN","C0PMAIN",190,0)
 ;
"RTN","C0PMAIN",191,0)
UPDIE   ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
"RTN","C0PMAIN",192,0)
 K ZERR
"RTN","C0PMAIN",193,0)
 D CLEAN^DILF
"RTN","C0PMAIN",194,0)
 D UPDATE^DIE("","C0PFDA","","ZERR")
"RTN","C0PMAIN",195,0)
 I $D(ZERR) D ERROR^C0PMAIN(",U113059008,",$ST($ST,"PLACE"),"ERX-UPDIE-FAIL","Fileman Data Update Failure") QUIT
"RTN","C0PMAIN",196,0)
 K C0PFDA
"RTN","C0PMAIN",197,0)
 Q
"RTN","C0PMAIN",198,0)
 ;
"RTN","C0PMAIN",199,0)
ERROR(EC,PLACE,ID,MSG) ; Private Proc - Set $EC for an error condition; 
"RTN","C0PMAIN",200,0)
 ; Errors the process and rolls back the stack by Invoking current error trap by setting $ECODE.
"RTN","C0PMAIN",201,0)
 ;Params: 
"RTN","C0PMAIN",202,0)
 ; EC - Error Code in ,Uxxx, syntax
"RTN","C0PMAIN",203,0)
 ; PLACE - Place where the error happened
"RTN","C0PMAIN",204,0)
 ; ID - Error ID
"RTN","C0PMAIN",205,0)
 ; MSG - Human understandable message
"RTN","C0PMAIN",206,0)
 S %ZTERR=EC
"RTN","C0PMAIN",207,0)
 S %ZTERR("PLACE")=PLACE
"RTN","C0PMAIN",208,0)
 S %ZTERR("ID")=ID
"RTN","C0PMAIN",209,0)
 S %ZTERR("MSG")=MSG
"RTN","C0PMAIN",210,0)
 S $EC=EC
"RTN","C0PMAIN",211,0)
 QUIT
"RTN","C0PNVA")
0^14^B26597924
"RTN","C0PNVA",1,0)
C0PNVA ; VEN/SMH - Non-VA Meds Utilities for e-Rx ; 5/8/12 4:32pm
"RTN","C0PNVA",2,0)
 ;;1.0;C0P;;Apr 25, 2012;Build 103
"RTN","C0PNVA",3,0)
 ;Copyright 2009 Sam Habiel.  Licensed under the terms of the GNU
"RTN","C0PNVA",4,0)
 ;General Public License See attached copy of the License.
"RTN","C0PNVA",5,0)
 ;
"RTN","C0PNVA",6,0)
 ;This program is free software; you can redistribute it and/or modify
"RTN","C0PNVA",7,0)
 ;it under the terms of the GNU General Public License as published by
"RTN","C0PNVA",8,0)
 ;the Free Software Foundation; either version 2 of the License, or
"RTN","C0PNVA",9,0)
 ;(at your option) any later version.
"RTN","C0PNVA",10,0)
 ;
"RTN","C0PNVA",11,0)
 ;This program is distributed in the hope that it will be useful,
"RTN","C0PNVA",12,0)
 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0PNVA",13,0)
 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"RTN","C0PNVA",14,0)
 ;GNU General Public License for more details.
"RTN","C0PNVA",15,0)
 ;
"RTN","C0PNVA",16,0)
 ;You should have received a copy of the GNU General Public License along
"RTN","C0PNVA",17,0)
 ;with this program; if not, write to the Free Software Foundation, Inc.,
"RTN","C0PNVA",18,0)
 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
"RTN","C0PNVA",19,0)
 Q
"RTN","C0PNVA",20,0)
 ;
"RTN","C0PNVA",21,0)
FILE(C0PDFN,OR,DRUG,DOSAGE,ROUTE,SCHEDULE,START,C0PDUZ,COMMENT) ; Private Proc - File NVA
"RTN","C0PNVA",22,0)
 ; Input:
"RTN","C0PNVA",23,0)
 ; - C0PDFN: Patient DFN
"RTN","C0PNVA",24,0)
 ; - OR: Pharmacy Orderable Item IEN
"RTN","C0PNVA",25,0)
 ; - DRUG: Drug IEN
"RTN","C0PNVA",26,0)
 ; - DOSAGE: Free Text Dosage
"RTN","C0PNVA",27,0)
 ; - ROUTE: Free Text Route
"RTN","C0PNVA",28,0)
 ; - SCHEDULE: Free Text Schedule
"RTN","C0PNVA",29,0)
 ; - START: Start date in Timson Format
"RTN","C0PNVA",30,0)
 ; - C0PDUZ: Provider documenting NVA DUZ
"RTN","C0PNVA",31,0)
 ; - COMMENT: Free Text Comment
"RTN","C0PNVA",32,0)
 ; NOTE: Right now, does nothing to file in CPRS order file.
"RTN","C0PNVA",33,0)
 ;
"RTN","C0PNVA",34,0)
 D CLEAN^DILF ; Kill DIERR etc
"RTN","C0PNVA",35,0)
 ; First Create parent file entry if it already doesn't exist
"RTN","C0PNVA",36,0)
 ; 
"RTN","C0PNVA",37,0)
 ; We will handle the case where there are subfile entries but no
"RTN","C0PNVA",38,0)
 ; zero node defined for the record. First, check to see if there is 
"RTN","C0PNVA",39,0)
 ; anything there at all for this patient
"RTN","C0PNVA",40,0)
 ;
"RTN","C0PNVA",41,0)
 N C0PEXIT S C0PEXIT=0 ; in case of errors
"RTN","C0PNVA",42,0)
 I '$D(^PS(55,C0PDFN)) D  Q:C0PEXIT  ; if nothing is there for this patient
"RTN","C0PNVA",43,0)
 . N C0PFDAPT
"RTN","C0PNVA",44,0)
 . N C0PPTIEN S C0PPTIEN(1)=C0PDFN ; bug? in Update-doesn't honor DINUM
"RTN","C0PNVA",45,0)
 . S C0PFDAPT(55,"+1,",.01)=C0PDFN
"RTN","C0PNVA",46,0)
 . D UPDATE^DIE("","C0PFDAPT","C0PPTIEN")
"RTN","C0PNVA",47,0)
 . I $G(DIERR) D ^%ZTER,CLEAN^DILF S C0PEXIT=1 Q  ; log error and signal q
"RTN","C0PNVA",48,0)
 E  I '$D(^PS(55,C0PDFN,0)) D  ; is there something there but not a zero node?
"RTN","C0PNVA",49,0)
 . S ^PS(55,C0PDFN,0)=C0PDFN ; set the zero node
"RTN","C0PNVA",50,0)
 . N DIK,DA
"RTN","C0PNVA",51,0)
 . S DIK="^PS(55,"
"RTN","C0PNVA",52,0)
 . S DA=C0PDFN
"RTN","C0PNVA",53,0)
 . S DIK(1)=".01"
"RTN","C0PNVA",54,0)
 . D EN^DIK ; cross reference the .01 field
"RTN","C0PNVA",55,0)
 ;
"RTN","C0PNVA",56,0)
 N C0PFDA
"RTN","C0PNVA",57,0)
 N C0PIENS ; Return value of IEN in the NVA multiple in file 55
"RTN","C0PNVA",58,0)
 ;
"RTN","C0PNVA",59,0)
 ; gpl. first, create the NVA subfile if none exists
"RTN","C0PNVA",60,0)
 ; these lines were copied from PSONVNEW, which creates non-VA meds
"RTN","C0PNVA",61,0)
 N ZIEN ; CREATING A NEW ENTRY, THE FIRST FOR THIS PATIENT
"RTN","C0PNVA",62,0)
 I '$D(^PS(55,C0PDFN,"NVA",0)) D  ; NO NVA SUBFILE
"RTN","C0PNVA",63,0)
 . S DFN=C0PDFN
"RTN","C0PNVA",64,0)
 . S DA(1)=DFN
"RTN","C0PNVA",65,0)
 . S X=OR
"RTN","C0PNVA",66,0)
 . S DR="1////"_DRUG
"RTN","C0PNVA",67,0)
 . S DIC("DR")=DR,DIC(0)="L",DIC="^PS(55,"_DFN_",""NVA"",",DLAYGO=55.05
"RTN","C0PNVA",68,0)
 . D FILE^DICN S ZIEN=+Y K DR,DIC,DD,DA,DO,DINUM
"RTN","C0PNVA",69,0)
 . ; I don't know why the following doesn't work
"RTN","C0PNVA",70,0)
 . ;S C0PFDA(55.05,"+1,"_C0PDFN_",",.01)=OR
"RTN","C0PNVA",71,0)
 . ;D UPDATE^DIE("","C0PFDA","C0PIENS")
"RTN","C0PNVA",72,0)
 . ;I $G(DIERR) D ^%ZTER QUIT  ; log error if update fails
"RTN","C0PNVA",73,0)
 . ;E  D  ; find the ien of the subfile
"RTN","C0PNVA",74,0)
 . S ZIEN=$O(^PS(55,C0PDFN,"NVA","B",OR,""))
"RTN","C0PNVA",75,0)
 . I ZIEN="" S ZIEN=1
"RTN","C0PNVA",76,0)
 . ;
"RTN","C0PNVA",77,0)
 . S C0PFDA(55.05,"?+"_ZIEN_","_C0PDFN_",",.01)=OR
"RTN","C0PNVA",78,0)
 . S C0PFDA(55.05,"?+"_ZIEN_","_C0PDFN_",",1)=DRUG
"RTN","C0PNVA",79,0)
 . S C0PFDA(55.05,"?+"_ZIEN_","_C0PDFN_",",2)=$E(DOSAGE,1,80) ; 80 char max
"RTN","C0PNVA",80,0)
 . S C0PFDA(55.05,"?+"_ZIEN_","_C0PDFN_",",3)=$E(ROUTE,1,40)
"RTN","C0PNVA",81,0)
 . S C0PFDA(55.05,"?+"_ZIEN_","_C0PDFN_",",4)=$E(SCHEDULE,1,50)
"RTN","C0PNVA",82,0)
 . S C0PFDA(55.05,"?+"_ZIEN_","_C0PDFN_",",8)=START ; Start Date
"RTN","C0PNVA",83,0)
 . S C0PFDA(55.05,"?+"_ZIEN_","_C0PDFN_",",11)=$$NOW^XLFDT()  ; Documentated Date
"RTN","C0PNVA",84,0)
 . S C0PFDA(55.05,"?+"_ZIEN_","_C0PDFN_",",12)=C0PDUZ
"RTN","C0PNVA",85,0)
 . ;
"RTN","C0PNVA",86,0)
 . D UPDATE^DIE("","C0PFDA","C0PIENS")
"RTN","C0PNVA",87,0)
 . I $G(DIERR) D ^%ZTER QUIT  ; log error if update fails
"RTN","C0PNVA",88,0)
 . ;
"RTN","C0PNVA",89,0)
 . D CLEAN^DILF ; Kill DIERR etc.
"RTN","C0PNVA",90,0)
 . ; File WP field
"RTN","C0PNVA",91,0)
 . N C0PWP ; comment is multi line
"RTN","C0PNVA",92,0)
 . M C0PWP=COMMENT
"RTN","C0PNVA",93,0)
 . ;D WP^DIE(55.05,C0PIENS(1)_","_C0PDFN_",",14,"","C0PWP")
"RTN","C0PNVA",94,0)
 . D WP^DIE(55.05,C0PIENS(ZIEN)_","_C0PDFN_",",14,"","C0PWP")
"RTN","C0PNVA",95,0)
 . I $G(DIERR) D ^%ZTER QUIT  ; log error if wp filling fails.
"RTN","C0PNVA",96,0)
 E  D  ; CREATING A NEW ENTRY, NOT THE FIRST
"RTN","C0PNVA",97,0)
 . S ZIEN=1 ; GOING TO USE +1 CONVENTION
"RTN","C0PNVA",98,0)
 . S C0PFDA(55.05,"+"_ZIEN_","_C0PDFN_",",.01)=OR
"RTN","C0PNVA",99,0)
 . S C0PFDA(55.05,"+"_ZIEN_","_C0PDFN_",",1)=DRUG
"RTN","C0PNVA",100,0)
 . S C0PFDA(55.05,"+"_ZIEN_","_C0PDFN_",",2)=$E(DOSAGE,1,80) ; 80 char max
"RTN","C0PNVA",101,0)
 . S C0PFDA(55.05,"+"_ZIEN_","_C0PDFN_",",3)=$E(ROUTE,1,40)
"RTN","C0PNVA",102,0)
 . S C0PFDA(55.05,"+"_ZIEN_","_C0PDFN_",",4)=$E(SCHEDULE,1,50)
"RTN","C0PNVA",103,0)
 . S C0PFDA(55.05,"+"_ZIEN_","_C0PDFN_",",8)=START ; Start Date
"RTN","C0PNVA",104,0)
 . S C0PFDA(55.05,"+"_ZIEN_","_C0PDFN_",",11)=$$NOW^XLFDT()  ; Documentated Date
"RTN","C0PNVA",105,0)
 . S C0PFDA(55.05,"+"_ZIEN_","_C0PDFN_",",12)=C0PDUZ
"RTN","C0PNVA",106,0)
 . ;
"RTN","C0PNVA",107,0)
 . D UPDATE^DIE("","C0PFDA","C0PIENS")
"RTN","C0PNVA",108,0)
 . ;I $D(GPLTEST) B  ;
"RTN","C0PNVA",109,0)
 . I $G(DIERR) D ^%ZTER QUIT  ; log error if update fails
"RTN","C0PNVA",110,0)
 . ;
"RTN","C0PNVA",111,0)
 . D CLEAN^DILF ; Kill DIERR etc.
"RTN","C0PNVA",112,0)
 . ; File WP field
"RTN","C0PNVA",113,0)
 . N C0PWP ;S C0PWP(1)=COMMENT
"RTN","C0PNVA",114,0)
 . M C0PWP=COMMENT ; comment is passed by reference and has multiple lines
"RTN","C0PNVA",115,0)
 . ;D WP^DIE(55.05,C0PIENS(1)_","_C0PDFN_",",14,"","C0PWP")
"RTN","C0PNVA",116,0)
 . D WP^DIE(55.05,C0PIENS(ZIEN)_","_C0PDFN_",",14,"","C0PWP")
"RTN","C0PNVA",117,0)
 . I $G(DIERR) D ^%ZTER QUIT  ; log error if wp filling fails.
"RTN","C0PNVA",118,0)
 QUIT
"RTN","C0PNVA",119,0)
 ;
"RTN","C0PNVA",120,0)
DC(C0PDFN,NVAIEN) ; Private Procedure - D/C Non-VA Med
"RTN","C0PNVA",121,0)
 ; Input:
"RTN","C0PNVA",122,0)
 ; C0PDFN - you should know what this is by now
"RTN","C0PNVA",123,0)
 ; NVAIEN - IEN of Non-VA in the non-VA subfile in file 55
"RTN","C0PNVA",124,0)
 ; Output:
"RTN","C0PNVA",125,0)
 ; None
"RTN","C0PNVA",126,0)
 ; Notes: Does not involve order file right now...
"RTN","C0PNVA",127,0)
 I $G(^TMP("C0PNODISC")) Q  ; DO NOT DISCONTINUE DRUGS SWITCH
"RTN","C0PNVA",128,0)
 ; FOR TESTING NEW CROP - MAINTAINS VISTA DRUGS
"RTN","C0PNVA",129,0)
 D CLEAN^DILF ; Kill DIERR etc
"RTN","C0PNVA",130,0)
 N C0PFDA
"RTN","C0PNVA",131,0)
 S C0PFDA(55.05,NVAIEN_","_C0PDFN_",",5)=1 ; Status = discontinued
"RTN","C0PNVA",132,0)
 S C0PFDA(55.05,NVAIEN_","_C0PDFN_",",6)=$$NOW^XLFDT() ; discontinued date
"RTN","C0PNVA",133,0)
 D UPDATE^DIE("","C0PFDA")
"RTN","C0PNVA",134,0)
 I $G(DIERR) D ^%ZTER QUIT
"RTN","C0PNVA",135,0)
 QUIT
"RTN","C0PPAT")
0^4^B8357096
"RTN","C0PPAT",1,0)
C0PPAT   ; ERX/GPL - ERX PATIENT utilities; 8/26/09 ; 12/10/09 6:46pm
"RTN","C0PPAT",2,0)
 ;;1.0;C0P;;Apr 25, 2012;Build 103
"RTN","C0PPAT",3,0)
 ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"RTN","C0PPAT",4,0)
 ;General Public License See attached copy of the License.
"RTN","C0PPAT",5,0)
 ;
"RTN","C0PPAT",6,0)
 ;This program is free software; you can redistribute it and/or modify
"RTN","C0PPAT",7,0)
 ;it under the terms of the GNU General Public License as published by
"RTN","C0PPAT",8,0)
 ;the Free Software Foundation; either version 2 of the License, or
"RTN","C0PPAT",9,0)
 ;(at your option) any later version.
"RTN","C0PPAT",10,0)
 ;
"RTN","C0PPAT",11,0)
 ;This program is distributed in the hope that it will be useful,
"RTN","C0PPAT",12,0)
 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0PPAT",13,0)
 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"RTN","C0PPAT",14,0)
 ;GNU General Public License for more details.
"RTN","C0PPAT",15,0)
 ;
"RTN","C0PPAT",16,0)
 ;You should have received a copy of the GNU General Public License along
"RTN","C0PPAT",17,0)
 ;with this program; if not, write to the Free Software Foundation, Inc.,
"RTN","C0PPAT",18,0)
 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
"RTN","C0PPAT",19,0)
 ;
"RTN","C0PPAT",20,0)
 Q
"RTN","C0PPAT",21,0)
 ;
"RTN","C0PPAT",22,0)
 ; THIS ROUTINE IS CALLED AS PART OF ERX WEB SERVICES PROCESSING
"RTN","C0PPAT",23,0)
 ; TO POPULATE INFORMATION ABOUT THE PATIENT TO BE MAPPED INTO XML
"RTN","C0PPAT",24,0)
 ; AND SENT TO THE EPRESCRIBING PROVIDER TO DEFINE THE PATIENT ON THEIR
"RTN","C0PPAT",25,0)
 ; SYSTEM. ALL WEB SERVICE CALLS REGARDING A PATIENT WILL USE THIS ROUTINE
"RTN","C0PPAT",26,0)
 ; AND SEND A COMPLETE REPRESENTATION OF THE PATIENT.
"RTN","C0PPAT",27,0)
 ; GPL JUN 2010
"RTN","C0PPAT",28,0)
 ;
"RTN","C0PPAT",29,0)
EN(RTNVAR,C0PDFN) ; INITIALIZE PATIENT VARIABLE ARRAY FOR PATIENT C0PDFN
"RTN","C0PPAT",30,0)
 ; RTNVAR IS PASSED BY NAME. VARIABLES ARE PREFIXED WITH "PATIENT-"
"RTN","C0PPAT",31,0)
 ; HERE IS A LIST OF THE VARIABLES THAT ARE POPULATED FOR THE PATIENT:
"RTN","C0PPAT",32,0)
 ;GPL("PATIENT-ACTORADDRESSCITY")="ALTON"
"RTN","C0PPAT",33,0)
 ;GPL("PATIENT-ACTORADDRESSLINE1")="1234 Somewhere Lane"
"RTN","C0PPAT",34,0)
 ;GPL("PATIENT-ACTORADDRESSLINE2")=""
"RTN","C0PPAT",35,0)
 ;GPL("PATIENT-ACTORADDRESSSOURCEID")="WS_PATIENT2"
"RTN","C0PPAT",36,0)
 ;GPL("PATIENT-ACTORADDRESSSTATE")="KANSAS"
"RTN","C0PPAT",37,0)
 ;GPL("PATIENT-ACTORADDRESSTYPE")="Home"
"RTN","C0PPAT",38,0)
 ;GPL("PATIENT-ACTORADDRESSZIPCODE")=67623
"RTN","C0PPAT",39,0)
 ;GPL("PATIENT-ACTORCELLTEL")=""
"RTN","C0PPAT",40,0)
 ;GPL("PATIENT-ACTORCELLTELTEXT")=""
"RTN","C0PPAT",41,0)
 ;GPL("PATIENT-ACTORDATEOFBIRTH")="1957-12-25"
"RTN","C0PPAT",42,0)
 ;GPL("PATIENT-ACTOREMAIL")=""
"RTN","C0PPAT",43,0)
 ;GPL("PATIENT-ACTORFAMILYNAME")="ZZ PATIENT"
"RTN","C0PPAT",44,0)
 ;GPL("PATIENT-ACTORGENDER")="MALE"
"RTN","C0PPAT",45,0)
 ;GPL("PATIENT-ACTORGIVENNAME")="TEST"
"RTN","C0PPAT",46,0)
 ;GPL("PATIENT-ACTORIEN")=2
"RTN","C0PPAT",47,0)
 ;GPL("PATIENT-ACTORMIDDLENAME")="TWO"
"RTN","C0PPAT",48,0)
 ;GPL("PATIENT-ACTOROBJECTID")="WS_PATIENT2"
"RTN","C0PPAT",49,0)
 ;GPL("PATIENT-ACTORRESTEL")="888-555-1212"
"RTN","C0PPAT",50,0)
 ;GPL("PATIENT-ACTORRESTELTEXT")="Residential Telephone"
"RTN","C0PPAT",51,0)
 ;GPL("PATIENT-ACTORSOURCEID")="ACTORSYSTEM_1"
"RTN","C0PPAT",52,0)
 ;GPL("PATIENT-ACTORSSN")="769122557P"
"RTN","C0PPAT",53,0)
 ;GPL("PATIENT-ACTORSSNSOURCEID")="WS_PATIENT2"
"RTN","C0PPAT",54,0)
 ;GPL("PATIENT-ACTORSSNTEXT")="SSN"
"RTN","C0PPAT",55,0)
 ;GPL("PATIENT-ACTORSUFFIXNAME")=""
"RTN","C0PPAT",56,0)
 ;GPL("PATIENT-ACTORWORKTEL")="888-121-1212"
"RTN","C0PPAT",57,0)
 ;GPL("PATIENT-ACTORWORKTELTEXT")="Work Telephone"
"RTN","C0PPAT",58,0)
 ;GPL("PATIENTID")="PATIENT2"
"RTN","C0PPAT",59,0)
 N C0PTMP
"RTN","C0PPAT",60,0)
 D PEXTRACT^C0CACTOR("C0PTMP",C0PDFN,"WS_PATIENT_"_C0PDFN)
"RTN","C0PPAT",61,0)
 ; todo: for state, use extended syntax
"RTN","C0PPAT",62,0)
 N ZG
"RTN","C0PPAT",63,0)
 S C0PTMP("PATIENTID")="PATIENT"_C0PDFN ; PATIENT ID BASED ON DFN
"RTN","C0PPAT",64,0)
 S C0PTMP("IDTYPE")="" ; DON'T KNOW WHAT SHOULD GO HERE
"RTN","C0PPAT",65,0)
 S C0PTMP("STARTHISTORY")="2004-01-01T00:00:00" ; DEFAULT... CHANGE THIS
"RTN","C0PPAT",66,0)
 S C0PTMP("ENDHISTORY")="2010-01-01T00:00:00" ; DEFAULT... CHANGE THIS
"RTN","C0PPAT",67,0)
 S C0PTMP("PRESCRIPTIONSTATUS")="C" ; DEFAULT... CHANGE THIS
"RTN","C0PPAT",68,0)
 S C0PTMP("PRESCRIPTIONSUBSTATUS")="S" ; DEFAULT... CHANGE THIS
"RTN","C0PPAT",69,0)
 S C0PTMP("ARCHIVESTATUS")="N" ; DEFAULT... CHANGE THIS
"RTN","C0PPAT",70,0)
 S ZG=$$GET1^DIQ(2,C0PDFN,.115,"I") ;NEED ABBREVIATION
"RTN","C0PPAT",71,0)
 S C0PTMP("ACTORADDRESSSTATE")=$$GET1^DIQ(5,ZG_",",1) ;STATE ABBREVIATION
"RTN","C0PPAT",72,0)
 I C0PTMP("ACTORGENDER")="MALE" S C0PTMP("ACTORGENDER")="M"
"RTN","C0PPAT",73,0)
 I C0PTMP("ACTORGENDER")="FEMALE" S C0PTMP("ACTORGENDER")="F"
"RTN","C0PPAT",74,0)
 S C0PTMP("ACTORDATEOFBIRTH")=$TR(C0PTMP("ACTORDATEOFBIRTH"),"-") ;REMOVE DASHES FROM DOB
"RTN","C0PPAT",75,0)
 S C0PTMP("ACTORSSN")=$TR(C0PTMP("ACTORSSN"),"P","") ;REMOVE P FROM TEST SSN
"RTN","C0PPAT",76,0)
 N ZI
"RTN","C0PPAT",77,0)
 S ZI=""
"RTN","C0PPAT",78,0)
 F  S ZI=$O(C0PTMP(ZI)) Q:ZI=""  D  ; FOR EACH VARIABLE RETURNED
"RTN","C0PPAT",79,0)
 . S @RTNVAR@("PATIENT-"_ZI)=C0PTMP(ZI) ; RETURN PREFIXED VARIABLE
"RTN","C0PPAT",80,0)
 S @RTNVAR@("PATIENT-ACTORADDRESSCOUNTRY")="US" ;FIX THIS FOR INTERNATIONAL
"RTN","C0PPAT",81,0)
 S @RTNVAR@("PATIENT-ACTORMEMO")="" ; DON'T KNOW WHAT TO PUT HERE GPL
"RTN","C0PPAT",82,0)
 Q
"RTN","C0PPAT",83,0)
 ;
"RTN","C0PRECON")
0^11^B81626600
"RTN","C0PRECON",1,0)
C0PRECON ; VEN/SMH - Utilities for Medication Reconciliation; 5/8/12 4:34pm
"RTN","C0PRECON",2,0)
 ;;1.0;C0P;;Apr 25, 2012;Build 103
"RTN","C0PRECON",3,0)
 ;Copyright 2009 Sam Habiel.  Licensed under the terms of the GNU
"RTN","C0PRECON",4,0)
 ;General Public License See attached copy of the License.
"RTN","C0PRECON",5,0)
 ;
"RTN","C0PRECON",6,0)
 ;This program is free software; you can redistribute it and/or modify
"RTN","C0PRECON",7,0)
 ;it under the terms of the GNU General Public License as published by
"RTN","C0PRECON",8,0)
 ;the Free Software Foundation; either version 2 of the License, or
"RTN","C0PRECON",9,0)
 ;(at your option) any later version.
"RTN","C0PRECON",10,0)
 ;
"RTN","C0PRECON",11,0)
 ;This program is distributed in the hope that it will be useful,
"RTN","C0PRECON",12,0)
 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0PRECON",13,0)
 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"RTN","C0PRECON",14,0)
 ;GNU General Public License for more details.
"RTN","C0PRECON",15,0)
 ;
"RTN","C0PRECON",16,0)
 ;You should have received a copy of the GNU General Public License along
"RTN","C0PRECON",17,0)
 ;with this program; if not, write to the Free Software Foundation, Inc.,
"RTN","C0PRECON",18,0)
 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
"RTN","C0PRECON",19,0)
 Q
"RTN","C0PRECON",20,0)
 ;
"RTN","C0PRECON",21,0)
GETMEDS(C0PDUZ,C0PDFN,ZRTN) ; Public Proc
"RTN","C0PRECON",22,0)
 ; Retreives meds from WebService, matches them against VistA, 
"RTN","C0PRECON",23,0)
 ; compares them with current meds, saves into Non-Va multiple in file 55
"RTN","C0PRECON",24,0)
 ; (pharmacy patient)
"RTN","C0PRECON",25,0)
 ;   
"RTN","C0PRECON",26,0)
 ; Input:
"RTN","C0PRECON",27,0)
 ; - C0PDUZ: DUZ
"RTN","C0PRECON",28,0)
 ; - C0PDFN: DFN
"RTN","C0PRECON",29,0)
 ; 
"RTN","C0PRECON",30,0)
 I $G(^TMP("C0PNOPULLBACK")) Q  ; TURNS OFF PULLBACK PROCESSING
"RTN","C0PRECON",31,0)
 ; FOR TESTING NEW CROP OPTIONS - KEEPS VISTA ERX DRUGS INTACT AND ADDS NO
"RTN","C0PRECON",32,0)
 ; NEW DRUGS
"RTN","C0PRECON",33,0)
 N C0PWSMEDS
"RTN","C0PRECON",34,0)
 D SOAP^C0PWS1("C0PWSMEDS","GETMEDS",C0PDUZ,C0PDFN) ; soap call for WS meds
"RTN","C0PRECON",35,0)
 I C0PWSMEDS(1,"Status")'="OK" Q  ; bad return from ws call 
"RTN","C0PRECON",36,0)
 N CURRENTMEDS
"RTN","C0PRECON",37,0)
 D GET^C0PCUR(.CURRENTMEDS,C0PDFN) ; current meds in VistA
"RTN","C0PRECON",38,0)
 N ZDUPS ; ARRAY TO KEEP TRACK OF DUPLICATES SO THAT WE CAN
"RTN","C0PRECON",39,0)
 ; DISCONTINUE ERX MEDS THAT ARE NOT IN THE WEB SERVICE LIST
"RTN","C0PRECON",40,0)
 N I
"RTN","C0PRECON",41,0)
 FOR I=1:1:C0PWSMEDS(1,"RowCount") DO
"RTN","C0PRECON",42,0)
 . N MEDTOADD M MEDTOADD=C0PWSMEDS(I)
"RTN","C0PRECON",43,0)
 . N DUPID S DUPID=$$DUP(MEDTOADD("DrugID"),.CURRENTMEDS) ; check for dups
"RTN","C0PRECON",44,0)
 . N MEDTXT S MEDTXT=$$FULLNAME^C0PLKUP(MEDTOADD("DrugID"))
"RTN","C0PRECON",45,0)
 . I 'DUPID S DUPID=$$FREMAT(MEDTXT,.CURRENTMEDS) ;check
"RTN","C0PRECON",46,0)
 . ; for free text drug match gpl
"RTN","C0PRECON",47,0)
 . I DUPID S ZDUPS(DUPID,I)="" ; INDEX BY CURRENT MED NUMBER
"RTN","C0PRECON",48,0)
 . I DUPID D  ; if indeed duplicate, check if WS Drug is newer drug
"RTN","C0PRECON",49,0)
 . . N RXDATENOTIME
"RTN","C0PRECON",50,0)
 . . S RXDATENOTIME=$P($$FMDATE(MEDTOADD("PrescriptionDate")),".")
"RTN","C0PRECON",51,0)
 . . I RXDATENOTIME>CURRENTMEDS(DUPID,"START") D  ; if newer
"RTN","C0PRECON",52,0)
 . . . ;D DC^C0PNVA(C0PDFN,$P(CURRENTMEDS(DUPID,0),U)) ;dc old one
"RTN","C0PRECON",53,0)
 . . . D DC^C0PNVA(C0PDFN,CURRENTMEDS(DUPID,"NVAIEN")) ; gpl
"RTN","C0PRECON",54,0)
 . . . D ADD(.MEDTOADD,C0PDFN,C0PDUZ) ; add new one
"RTN","C0PRECON",55,0)
 . . E  ; do nothing here: Current med in Vista is newer or equivalent one
"RTN","C0PRECON",56,0)
 . E  D ADD(.MEDTOADD,C0PDFN,C0PDUZ) ; not a duplicate med
"RTN","C0PRECON",57,0)
 ; NOW LOOK THROUGH CURRENT MEDS TO SEE WHICH NEED TO BE DISCONTINUED
"RTN","C0PRECON",58,0)
 S I=""
"RTN","C0PRECON",59,0)
 F  S I=$O(CURRENTMEDS(I)) Q:I=""  D  ; FOR EACH CURRENT MED
"RTN","C0PRECON",60,0)
 . I $O(ZDUPS(I,""))="" D  ; DUPLICATE DRUG NOT FOUND
"RTN","C0PRECON",61,0)
 . . I $P(CURRENTMEDS(I,0),U,9)'="ACTIVE" Q  ; might be discontinued
"RTN","C0PRECON",62,0)
 . . S ZT=$$DRUGNAM^C0PLKUP(.CURRENTMEDS,I)
"RTN","C0PRECON",63,0)
 . . I ZT="" S ZT=$P(CURRENTMEDS(I,0),U,2)
"RTN","C0PRECON",64,0)
 . . N ZN S ZN=$P($G(CURRENTMEDS(I,0)),U,1)
"RTN","C0PRECON",65,0)
 . . S ZT=ZN_" "_ZT
"RTN","C0PRECON",66,0)
 . . ;S ZT=$P(CURRENTMEDS(I,0),U,1)_" "_$P(CURRENTMEDS(I,0),U,2)
"RTN","C0PRECON",67,0)
 . . I ZN["N;" D  ; DISCONTINUE THE NONVA MED
"RTN","C0PRECON",68,0)
 . . . I $G(CURRENTMEDS(I,"COMMENTS",1))["Received from E-Rx Web Service" D  ;
"RTN","C0PRECON",69,0)
 . . . . D DC^C0PNVA(C0PDFN,CURRENTMEDS(I,"NVAIEN")) ;dc the med
"RTN","C0PRECON",70,0)
 . . . . S ZT="Discontinued "_ZT
"RTN","C0PRECON",71,0)
 . . E  S ZT="Can't Discontinue "_ZT
"RTN","C0PRECON",72,0)
 . . D MAPERR(.ZRTN,"DRUGS",ZT)
"RTN","C0PRECON",73,0)
 QUIT
"RTN","C0PRECON",74,0)
ADD(MEDTOADD,C0PDFN,C0PDUZ) ; Private Proc - Add med to VistA
"RTN","C0PRECON",75,0)
 ; Input:
"RTN","C0PRECON",76,0)
 ; - MEDTOADD: WebService Drug information, by Reference
"RTN","C0PRECON",77,0)
 ; - C0PDFN: DFN, by Value
"RTN","C0PRECON",78,0)
 ; - C0PDUZ: DUZ, By Value
"RTN","C0PRECON",79,0)
 ; Output:
"RTN","C0PRECON",80,0)
 ; - None
"RTN","C0PRECON",81,0)
 N DRUGS S DRUGS=$$DRUG2^C0PLKUP(MEDTOADD("DrugID"))
"RTN","C0PRECON",82,0)
 N ZR,ZII ; GPL NEED TO FIND A NON-ZERO MATCH 
"RTN","C0PRECON",83,0)
 F ZII=1:1:10 S ZR=$P(DRUGS,U,ZII) Q:ZR>0  ; $$DRUG2 RETURNS a^b^c FOR MATCHES
"RTN","C0PRECON",84,0)
 S DRUGS=ZR ; WE WANT THE FIRST NON-ZERO MATCH
"RTN","C0PRECON",85,0)
 I +DRUGS=0 DO  QUIT
"RTN","C0PRECON",86,0)
 . D SENDMSG(.MEDTOADD,C0PDFN)
"RTN","C0PRECON",87,0)
 . D NFADD(.MEDTOADD,C0PDFN,C0PDUZ)
"RTN","C0PRECON",88,0)
 . N ZT
"RTN","C0PRECON",89,0)
 . S ZT="Error Mapping Drug: "_MEDTOADD("DrugName")_" ID: "_MEDTOADD("DrugID")
"RTN","C0PRECON",90,0)
 . D MAPERR(.ZRTN,"DRUGS",ZT) ; CALL ERROR ROUTINE TO RECORD NO MATCH FOR DRUG
"RTN","C0PRECON",91,0)
 N DRUG S DRUG=+DRUGS ; grab the first entry; as good as any for now
"RTN","C0PRECON",92,0)
 N ORDIEN S ORDIEN=$$GET1^DIQ(50,DRUG,"PHARMACY ORDERABLE ITEM","I")
"RTN","C0PRECON",93,0)
 N DOSAGE S DOSAGE=MEDTOADD("DosageNumberDescription")_" "_MEDTOADD("DosageForm")
"RTN","C0PRECON",94,0)
 ; ****** ADDED BY GPL 10/5/10 TO ALWAYS CAPTURE FDB NAME IN SIG
"RTN","C0PRECON",95,0)
 N MEDTXT S MEDTXT=$$FULLNAME^C0PLKUP(MEDTOADD("DrugID"))
"RTN","C0PRECON",96,0)
 I MEDTXT="" S MEDTXT=MEDTOADD("DrugName") ; drug not found condition gpl
"RTN","C0PRECON",97,0)
 S DOSAGE=MEDTXT_"| "_MEDTOADD("DosageNumberDescription")_"  "_MEDTOADD("DosageForm") ; | delimiter added by gpl 2/5/2010
"RTN","C0PRECON",98,0)
 ; ****** END MOD
"RTN","C0PRECON",99,0)
 N ROUTE S ROUTE=MEDTOADD("Route")
"RTN","C0PRECON",100,0)
 N SCHEDULE S SCHEDULE=MEDTOADD("DosageFrequencyDescription")
"RTN","C0PRECON",101,0)
 I MEDTOADD("TakeAsNeeded")="Y" S SCHEDULE=SCHEDULE_" PRN" ; Vista stores PRN in schedule
"RTN","C0PRECON",102,0)
 N START S START=$$FMDATE(MEDTOADD("PrescriptionDate"))
"RTN","C0PRECON",103,0)
 N COMMENT
"RTN","C0PRECON",104,0)
 S COMMENT(1)="Received from E-Rx Web Service" ;todo: move to dialog file
"RTN","C0PRECON",105,0)
 S COMMENT(2)="Order Guid: "_$G(MEDTOADD("OrderGuid"))
"RTN","C0PRECON",106,0)
 S COMMENT(3)="Physician Name: "_$G(MEDTOADD("PhysicianName"))
"RTN","C0PRECON",107,0)
 S COMMENT(4)="Prescription Date: "_$G(MEDTOADD("PrescriptionDate"))
"RTN","C0PRECON",108,0)
 S COMMENT(5)="Prescription Guid: "_$G(MEDTOADD("PrescriptionGuid"))
"RTN","C0PRECON",109,0)
 S COMMENT(6)="Notes: "_$G(MEDTOADD("PrescriptionNotes"))
"RTN","C0PRECON",110,0)
 ; add codes for Certification and Free Txt repair processing - gpl
"RTN","C0PRECON",111,0)
 S COMMENT(7)=$$CODES^C0PLKUP(MEDTOADD("DrugID")) ;
"RTN","C0PRECON",112,0)
 D FILE^C0PNVA(C0PDFN,ORDIEN,DRUG,DOSAGE,ROUTE,SCHEDULE,START,C0PDUZ,.COMMENT)
"RTN","C0PRECON",113,0)
 QUIT
"RTN","C0PRECON",114,0)
MAPERR(ZRTN,ZTYP,ZTXT) ; ZTYP IS THE TYPE OF MAPPING ERROR 
"RTN","C0PRECON",115,0)
 ; (IE DRUGS OR ALLERGY)
"RTN","C0PRECON",116,0)
 ; ZRTN IS PASSED BY REFERENCE AND IS THE ARRAY OF ERROR MESSAGES
"RTN","C0PRECON",117,0)
 ; THIS ROUTINE ADDS THE ERROR MESSAGE TO THE END OF THE ARRAY
"RTN","C0PRECON",118,0)
 ; ZTXT IS THE ERROR MESSAGE
"RTN","C0PRECON",119,0)
 ; 
"RTN","C0PRECON",120,0)
 N ZI
"RTN","C0PRECON",121,0)
 I $G(^TMP("C0PDEBUG"))="" Q  ; ONLY SHOW MAPPING ERRORS ON DEBUG
"RTN","C0PRECON",122,0)
 I '$D(ZRTN) S ZI=1
"RTN","C0PRECON",123,0)
 E  S ZI=$O(ZRTN(""),-1)+1 ;ONE PASSED THE END OF ZRTN
"RTN","C0PRECON",124,0)
 S ZRTN(ZI)=ZTXT
"RTN","C0PRECON",125,0)
 Q
"RTN","C0PRECON",126,0)
 ;
"RTN","C0PRECON",127,0)
FMDATE(C0PD) ; Public $$ - Get fileman date from dates formatted like 11/7/09 10:22:34 PM
"RTN","C0PRECON",128,0)
 ; Input: Date like 11/7/09 10:22:34 PM
"RTN","C0PRECON",129,0)
 ; Output: Timson date precise up to seconds
"RTN","C0PRECON",130,0)
 S $E(C0PD,$F(C0PD," ")-1)="@" ; put @ b/n date and time for fm
"RTN","C0PRECON",131,0)
 N %DT S %DT="TS" ; seconds are required
"RTN","C0PRECON",132,0)
 N X,Y
"RTN","C0PRECON",133,0)
 S X=C0PD D ^%DT
"RTN","C0PRECON",134,0)
 I Y<0 D ^%ZTER ; Problem converting date... wake up programmer
"RTN","C0PRECON",135,0)
 QUIT Y
"RTN","C0PRECON",136,0)
 ;
"RTN","C0PRECON",137,0)
DUP(FDBDRUGID,CURRENTMEDS) ; Private $$ - Is Drug already documented for patient?
"RTN","C0PRECON",138,0)
 ; Input: 
"RTN","C0PRECON",139,0)
 ; FDBDRUGID By Value
"RTN","C0PRECON",140,0)
 ; CURRENTMEDS By Reference
"RTN","C0PRECON",141,0)
 ; Output:
"RTN","C0PRECON",142,0)
 ; "" if no duplicate
"RTN","C0PRECON",143,0)
 ; CURRENTMEDS ien if duplicate
"RTN","C0PRECON",144,0)
 N DRUGS S DRUGS=$$DRUG2^C0PLKUP(FDBDRUGID)
"RTN","C0PRECON",145,0)
 ; add a check for the CODES in Comment(6) - to update if not there
"RTN","C0PRECON",146,0)
 N C0PCODES S C0PCODES=$$CODES^C0PLKUP(FDBDRUGID)
"RTN","C0PRECON",147,0)
 N I S I=""
"RTN","C0PRECON",148,0)
 N FOUND S FOUND=0
"RTN","C0PRECON",149,0)
 F  Q:FOUND=1  S I=$O(CURRENTMEDS(I)) Q:I=""   D  ; loop through current meds
"RTN","C0PRECON",150,0)
 . I '$D(CURRENTMEDS(I,"DRUG")) QUIT  ; continue if no drug id
"RTN","C0PRECON",151,0)
 . I $G(CURRENTMEDS(I,"COMMENTS",1))'["Received from E-Rx Web Service" Q  ;
"RTN","C0PRECON",152,0)
 . ; DON'T MATCH ON DRUGS THAT ARE NOT ERX
"RTN","C0PRECON",153,0)
 . ; check for CODES in COMMENTS(6)
"RTN","C0PRECON",154,0)
 . I $G(CURRENTMEDS(I,"COMMENTS",6))'=C0PCODES D  ; add codes
"RTN","C0PRECON",155,0)
 . . ;S ^PS(55,C0PDFN,"NVA",I,1,7,0)=C0PCODES ; right into the global
"RTN","C0PRECON",156,0)
 . I $P(CURRENTMEDS(I,0),U,9)'["ACTIVE" QUIT  ; quit if not active
"RTN","C0PRECON",157,0)
 . I ("^"_DRUGS_"^")[("^"_CURRENTMEDS(I,"DRUG")_"^") S FOUND=1
"RTN","C0PRECON",158,0)
 QUIT I  ; entry if Found, "" if not found
"RTN","C0PRECON",159,0)
 ;
"RTN","C0PRECON",160,0)
FREMAT(FDBDNAME,CURRENTMEDS,ZMED) ;MATCH A FREE TEXT DRUG EXTRINSIC
"RTN","C0PRECON",161,0)
 ; THE DRUG ID HAS BEEN STORED IN THE COMMENT OF EACH ERX NONVA DRUG
"RTN","C0PRECON",162,0)
 ; ZMED IS WHICH DRUG IN CURRENTMEDS WHICH IS PASSED BY REF
"RTN","C0PRECON",163,0)
 ; FDBDNAME IS THE DRUG NAME AND IS PASSED BY VALUE ; GPL
"RTN","C0PRECON",164,0)
 N I S I=""
"RTN","C0PRECON",165,0)
 ; add a check for the CODES in Comment(6) - to update if not there
"RTN","C0PRECON",166,0)
 N C0PCODES S C0PCODES=$$CODES^C0PLKUP(MEDTOADD("DrugID"))
"RTN","C0PRECON",167,0)
 N FOUND S FOUND=0
"RTN","C0PRECON",168,0)
 F  Q:FOUND=1  S I=$O(CURRENTMEDS(I)) Q:I=""   D  ; loop through current meds
"RTN","C0PRECON",169,0)
 . I $D(CURRENTMEDS(I,"DRUG")) QUIT  ; SKIP OVER MAPPED DRUGS
"RTN","C0PRECON",170,0)
 . I $P(CURRENTMEDS(I,0),U,9)'["ACTIVE" QUIT  ; quit if not active
"RTN","C0PRECON",171,0)
 . I FDBDNAME=$$DRUGNAM^C0PLKUP(.CURRENTMEDS,I) S FOUND=1
"RTN","C0PRECON",172,0)
 I FOUND=1 D  ;
"RTN","C0PRECON",173,0)
 . S ZT="Drug Dup Found: "_MEDTOADD("DrugName")_" ID: "_MEDTOADD("DrugID")
"RTN","C0PRECON",174,0)
 . ; check for CODES in COMMENTS(6)
"RTN","C0PRECON",175,0)
 . I $G(CURRENTMEDS(I,"COMMENTS",6))'=C0PCODES D  ; add codes
"RTN","C0PRECON",176,0)
 . . ;S ^PS(55,C0PDFN,"NVA",I,1,7,0)=C0PCODES ; right into the global
"RTN","C0PRECON",177,0)
 . D MAPERR(.ZRTN,"DRUGS",ZT) ; CALL ERROR ROUTINE TO RECORD NO MATCH FOR DRUG
"RTN","C0PRECON",178,0)
 Q I  ; entry if Found, "" if not found
"RTN","C0PRECON",179,0)
 ;
"RTN","C0PRECON",180,0)
SENDMSG(MEDTOADD,C0PDFN) ; Private EP - Send Bulletin saying drug not found
"RTN","C0PRECON",181,0)
 ; Input:
"RTN","C0PRECON",182,0)
 ; - MEDTOADD: WS Med entry By Reference
"RTN","C0PRECON",183,0)
 ; - C0PDFN: DFN by Value
"RTN","C0PRECON",184,0)
 ; Output:
"RTN","C0PRECON",185,0)
 ; - None
"RTN","C0PRECON",186,0)
 ; info: tested 12/14/09
"RTN","C0PRECON",187,0)
 ; todo: move this to a background call - it takes too long!
"RTN","C0PRECON",188,0)
 N DUZ ; remove old value to make the postmaster the sender
"RTN","C0PRECON",189,0)
 N XMDUZ S XMDUZ="E-Rx WebService" ; supposed sender
"RTN","C0PRECON",190,0)
 N XMTEXT ; unused
"RTN","C0PRECON",191,0)
 N XMY ; unused
"RTN","C0PRECON",192,0)
 N XMBTMP ; unused
"RTN","C0PRECON",193,0)
 N XMDF ; unused
"RTN","C0PRECON",194,0)
 N XMDT ; unused - will send message now
"RTN","C0PRECON",195,0)
 N XMYBLOB ; unused
"RTN","C0PRECON",196,0)
 N XMB
"RTN","C0PRECON",197,0)
 S XMB="C0P EXTERNAL DRUG NOT FOUND" ; bulletin name
"RTN","C0PRECON",198,0)
 S (XMB(1),XMB(5))=$$GET1^DIQ(2,C0PDFN,"PRIMARY LONG ID") ; chart #
"RTN","C0PRECON",199,0)
 S (XMB(2),XMB(3))=$$FULLNAME^C0PLKUP(MEDTOADD("DrugID")) ; drug not matched
"RTN","C0PRECON",200,0)
 S XMB(4)=$$GET1^DIQ(2,C0PDFN,.01) ; patient name
"RTN","C0PRECON",201,0)
 D ^XMB
"RTN","C0PRECON",202,0)
 QUIT
"RTN","C0PRECON",203,0)
 ;
"RTN","C0PRECON",204,0)
NFADD(MEDTOADD,C0PDFN,C0PDUZ) ; Private Proc - Add free text med to VistA
"RTN","C0PRECON",205,0)
 ; Input:
"RTN","C0PRECON",206,0)
 ; - MEDTOADD: WebService Drug information, by Reference
"RTN","C0PRECON",207,0)
 ; - C0PDFN: DFN, by Value
"RTN","C0PRECON",208,0)
 ; - C0PDUZ: DUZ, By Value
"RTN","C0PRECON",209,0)
 ; Output:
"RTN","C0PRECON",210,0)
 ; - None
"RTN","C0PRECON",211,0)
 ; info: tested 12/16/09
"RTN","C0PRECON",212,0)
 ; Stores med along side dosage in dosage field as free text
"RTN","C0PRECON",213,0)
 N ORDIEN S ORDIEN=$$FIND1^DIC(50.7,"","QX","FREE TXT DRUG","B") ; todo: change to a parameter
"RTN","C0PRECON",214,0)
 N DOSAGE
"RTN","C0PRECON",215,0)
 N MEDTXT S MEDTXT=$$FULLNAME^C0PLKUP(MEDTOADD("DrugID"))
"RTN","C0PRECON",216,0)
 I MEDTXT="" S MEDTXT=MEDTOADD("DrugName") ; drug not found condition gpl
"RTN","C0PRECON",217,0)
 S DOSAGE=MEDTXT_"| "_MEDTOADD("DosageNumberDescription")_"  "_MEDTOADD("DosageForm") ; | delimiter added by gpl 2/5/2010
"RTN","C0PRECON",218,0)
 N ROUTE S ROUTE=MEDTOADD("Route")
"RTN","C0PRECON",219,0)
 N SCHEDULE S SCHEDULE=MEDTOADD("DosageFrequencyDescription")
"RTN","C0PRECON",220,0)
 I MEDTOADD("TakeAsNeeded")="Y" S SCHEDULE=SCHEDULE_" PRN" ;
"RTN","C0PRECON",221,0)
 N START S START=$$FMDATE(MEDTOADD("PrescriptionDate"))
"RTN","C0PRECON",222,0)
 N COMMENT
"RTN","C0PRECON",223,0)
 S COMMENT(1)="Received from E-Rx Web Service" ;todo: move to dialog file
"RTN","C0PRECON",224,0)
 S COMMENT(2)="Order Guid: "_$G(MEDTOADD("OrderGuid"))
"RTN","C0PRECON",225,0)
 S COMMENT(3)="Physician Name: "_$G(MEDTOADD("PhysicianName"))
"RTN","C0PRECON",226,0)
 S COMMENT(4)="Prescription Date: "_$G(MEDTOADD("PrescriptionDate"))
"RTN","C0PRECON",227,0)
 S COMMENT(5)="Prescription Guid: "_$G(MEDTOADD("PrescriptionGuid"))
"RTN","C0PRECON",228,0)
 S COMMENT(6)="Notes: "_$G(MEDTOADD("PrescriptionNotes"))
"RTN","C0PRECON",229,0)
 ; add codes for Certification and Free Txt repair processing - gpl
"RTN","C0PRECON",230,0)
 S COMMENT(7)=$$CODES^C0PLKUP(MEDTOADD("DrugID")) ;
"RTN","C0PRECON",231,0)
 D FILE^C0PNVA(C0PDFN,ORDIEN,"",DOSAGE,ROUTE,SCHEDULE,START,C0PDUZ,.COMMENT)
"RTN","C0PRECON",232,0)
 ;N COMMENT ;added DrugID to comment 1/27/2010 gpl
"RTN","C0PRECON",233,0)
 ;S COMMENT="Received from E-Rx Web Service (DrugID:"_MEDTOADD("DrugID")_")"
"RTN","C0PRECON",234,0)
 ;D FILE^C0PNVA(C0PDFN,ORDIEN,"",DOSAGE,ROUTE,SCHEDULE,START,C0PDUZ,COMMENT)
"RTN","C0PRECON",235,0)
 QUIT
"RTN","C0PREFIL")
0^20^B176149670
"RTN","C0PREFIL",1,0)
C0PREFIL   ; ERX/GPL - eRx Refill utilities ; 5/9/12 12:03am
"RTN","C0PREFIL",2,0)
 ;;1.0;C0P;;Apr 25, 2012;Build 103
"RTN","C0PREFIL",3,0)
 ;Copyright 2009,2010 George Lilly.  Licensed under the terms of the GNU
"RTN","C0PREFIL",4,0)
 ;General Public License See attached copy of the License.
"RTN","C0PREFIL",5,0)
 ;
"RTN","C0PREFIL",6,0)
 ;This program is free software; you can redistribute it and/or modify
"RTN","C0PREFIL",7,0)
 ;it under the terms of the GNU General Public License as published by
"RTN","C0PREFIL",8,0)
 ;the Free Software Foundation; either version 2 of the License, or
"RTN","C0PREFIL",9,0)
 ;(at your option) any later version.
"RTN","C0PREFIL",10,0)
 ;
"RTN","C0PREFIL",11,0)
 ;This program is distributed in the hope that it will be useful,
"RTN","C0PREFIL",12,0)
 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0PREFIL",13,0)
 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"RTN","C0PREFIL",14,0)
 ;GNU General Public License for more details.
"RTN","C0PREFIL",15,0)
 ;
"RTN","C0PREFIL",16,0)
 ;You should have received a copy of the GNU General Public License along
"RTN","C0PREFIL",17,0)
 ;with this program; if not, write to the Free Software Foundation, Inc.,
"RTN","C0PREFIL",18,0)
 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
"RTN","C0PREFIL",19,0)
 ;
"RTN","C0PREFIL",20,0)
 Q
"RTN","C0PREFIL",21,0)
 ;
"RTN","C0PREFIL",22,0)
 ; TEST Lines below not intended for End Users. Programmers only.
"RTN","C0PREFIL",23,0)
 ; BEWARE ZWRITE SYNTAX. It may not work in other M Implementations.
"RTN","C0PREFIL",24,0)
TESTREQ(ZDUZ,ZDFN) ; TEST REFILL REQUEST
"RTN","C0PREFIL",25,0)
 I '$D(ZDFN) S ZDFN=""
"RTN","C0PREFIL",26,0)
 D REFREQ("ZG",ZDUZ,ZDFN)
"RTN","C0PREFIL",27,0)
 W !
"RTN","C0PREFIL",28,0)
 ZWRITE C0PRXML
"RTN","C0PREFIL",29,0)
 Q
"RTN","C0PREFIL",30,0)
 ;
"RTN","C0PREFIL",31,0)
REFREQ(GRTN,IDUZ,IDFN) ; MAKE A WEB SERVICE CALL TO GENERATE A REFIL REQUEST
"RTN","C0PREFIL",32,0)
 ; 
"RTN","C0PREFIL",33,0)
 N GPL,C0PFARY,GVOR
"RTN","C0PREFIL",34,0)
 D ENCREQ("GPL",IDUZ,IDFN)
"RTN","C0PREFIL",35,0)
 S GVOR("XMLIN")=GPL
"RTN","C0PREFIL",36,0)
 S GVOR("ORIG-FILL-DATE")=""
"RTN","C0PREFIL",37,0)
 S GVOR("CREATE-MED-YN")="0"
"RTN","C0PREFIL",38,0)
 ;D EN^C0PMAIN("GG","GURL",IDUZ,IDFN,"GENREFILL","GVOR")
"RTN","C0PREFIL",39,0)
 D INITXPF^C0PWS2("C0PFARY")
"RTN","C0PREFIL",40,0)
 D SOAP^C0PWS2("GRTN","GENREFILL",IDUZ,IDFN,"GVOR")
"RTN","C0PREFIL",41,0)
 ;D SOAP^C0CSOAP("GRTN","GENREFILL",,,"GG","C0PFARY") ;
"RTN","C0PREFIL",42,0)
 Q
"RTN","C0PREFIL",43,0)
 ;
"RTN","C0PREFIL",44,0)
ENCREQ(ZRTN,ZDUZ,ZDFN) ; ENCODE AN NCSCRIPT RENEWAL REQUEST
"RTN","C0PREFIL",45,0)
 ;
"RTN","C0PREFIL",46,0)
 D GENTEST("GPL","GURL",ZDUZ,ZDFN,1)
"RTN","C0PREFIL",47,0)
 ;S ZI=""
"RTN","C0PREFIL",48,0)
 ;S GPL(1)="RxInput="_GPL(1)
"RTN","C0PREFIL",49,0)
 S ZI=0 ; 
"RTN","C0PREFIL",50,0)
 ;F  S ZI=$O(GPL(ZI)) Q:ZI=""  D  ; MAKE IT XML SAFE
"RTN","C0PREFIL",51,0)
 ;. S GPL(ZI)=$$SYMENC^MXMLUTL(GPL(ZI))
"RTN","C0PREFIL",52,0)
 ;. W !,GPL(ZI)
"RTN","C0PREFIL",53,0)
 S ZI=0
"RTN","C0PREFIL",54,0)
 S G=""
"RTN","C0PREFIL",55,0)
 K GPL(0) ; GET RID OF LINE COUNT
"RTN","C0PREFIL",56,0)
 F  S ZI=$O(GPL(ZI)) Q:ZI=""  D  ;
"RTN","C0PREFIL",57,0)
 . S G=G_GPL(ZI)
"RTN","C0PREFIL",58,0)
 S @ZRTN=$$ENCODE^RGUTUU(G)
"RTN","C0PREFIL",59,0)
 ;S @ZRTN=G
"RTN","C0PREFIL",60,0)
 Q
"RTN","C0PREFIL",61,0)
 ;
"RTN","C0PREFIL",62,0)
CERTTEST ; GENERATE XML FILES FOR NEWCROP CERTIFICATION
"RTN","C0PREFIL",63,0)
 ;
"RTN","C0PREFIL",64,0)
 N ZII
"RTN","C0PREFIL",65,0)
 S ZDFN=18 ; TEST PATIENT TO USE
"RTN","C0PREFIL",66,0)
 F ZII=154,155,156,157 D  ; IENS OF SUBSCRIBER PROFILES
"RTN","C0PREFIL",67,0)
 . D CERTONE(ZII,ZDFN)
"RTN","C0PREFIL",68,0)
 Q
"RTN","C0PREFIL",69,0)
 ;
"RTN","C0PREFIL",70,0)
CERTONE(ZI,ZDFN) ; GENERATE ONE XML FILE 
"RTN","C0PREFIL",71,0)
 N ZN
"RTN","C0PREFIL",72,0)
 D EN^C0PMAIN("C0PG1","G2",ZI,ZDFN) ; GET THE NCSCRIPT
"RTN","C0PREFIL",73,0)
 S ZN=$P($P(^VA(200,ZI,0),U,1),",",2) ; GIVEN NAME OF USER
"RTN","C0PREFIL",74,0)
 ; ON OUR SYSTEM THESE ARE ERX,DOCTOR ERX,MID-LEVEL ERX,NURSE AND ERX,MANAGER
"RTN","C0PREFIL",75,0)
 S ZN=ZN_".xml" ; APPEND .xml extension
"RTN","C0PREFIL",76,0)
 K C0PG1(0)
"RTN","C0PREFIL",77,0)
 S ZDIR=^TMP("C0CCCR","ODIR")
"RTN","C0PREFIL",78,0)
 W !,$$OUTPUT^C0CXPATH("C0PG1(1)",ZN,ZDIR)
"RTN","C0PREFIL",79,0)
 Q
"RTN","C0PREFIL",80,0)
 ;
"RTN","C0PREFIL",81,0)
GENTEST(RTNXML,RTNURL,ZDUZ,ZDFN,ZFILE) ; GENERATE A TEST 
"RTN","C0PREFIL",82,0)
 ; CLICK-THROUGH HTLM FILE FOR
"RTN","C0PREFIL",83,0)
 ; GENERATING REFILL REQUESTS , XML IS RETURNED IN RTN,PASSED BY NAME
"RTN","C0PREFIL",84,0)
 ; IF ZFILE IS 1, THE FILE IS WRITTEN TO HOST FILE
"RTN","C0PREFIL",85,0)
 D EN^C0PMAIN("C0PG1","G2",ZDUZ,ZDFN) ; GET THE NCSCRIPT
"RTN","C0PREFIL",86,0)
 ;D GETMEDS("G6",ZDFN) ;GET MEDICATIONS
"RTN","C0PREFIL",87,0)
 ;D QUERY^C0CXPATH("G6","//NewPrescription[1]","G7") ;JUST THE FIRST ONE
"RTN","C0PREFIL",88,0)
 ;D INSERT^C0CXPATH("C0PG1","G7","//NCScript")
"RTN","C0PREFIL",89,0)
 K C0PG1(0)
"RTN","C0PREFIL",90,0)
 M @RTNXML=C0PG1 ;
"RTN","C0PREFIL",91,0)
 S ZDIR=^TMP("C0CCCR","ODIR")
"RTN","C0PREFIL",92,0)
 I $G(ZFILE)=1 W $$OUTPUT^C0CXPATH("C0PG1(1)","REFILL-"_ZDFN_".xml",ZDIR)
"RTN","C0PREFIL",93,0)
 Q
"RTN","C0PREFIL",94,0)
 ;
"RTN","C0PREFIL",95,0)
GETMEDS(OUTARY,ZDFN) ; GET THE PATIENT'S MEDS AND PUT INTO XML
"RTN","C0PREFIL",96,0)
 ;
"RTN","C0PREFIL",97,0)
 N ZG,ZG2,ZB,ZN
"RTN","C0PREFIL",98,0)
 S DEBUG=0
"RTN","C0PREFIL",99,0)
 D GETTEMP^C0PWS2("ZG","OUTMEDS") ;GET THE MEDICATIONS TEMPLATE
"RTN","C0PREFIL",100,0)
 D SOAP^C0PWS2("ZG2","GETMEDS",$$PRIMARY^C0PMAIN(),ZDFN) ; GET MEDS 
"RTN","C0PREFIL",101,0)
 I '$D(ZG2) Q  ; SHOULDN'T HAPPEN
"RTN","C0PREFIL",102,0)
 I ZG2(1,"Status")'="OK" D  Q  ; BAD RETURN FROM WEB SERVER
"RTN","C0PREFIL",103,0)
 . W $G(ZG2(1,"Message")),!
"RTN","C0PREFIL",104,0)
 N ZI S ZI=""
"RTN","C0PREFIL",105,0)
 S ZN=$NA(^TMP("C0PREFIL",$J))
"RTN","C0PREFIL",106,0)
 K @ZN
"RTN","C0PREFIL",107,0)
 F  S ZI=$O(ZG2(ZI)) Q:ZI=""  D  ; FOR EACH MED
"RTN","C0PREFIL",108,0)
 . N ZV
"RTN","C0PREFIL",109,0)
 . S ZV=$NA(@ZN@("DATA",ZI))
"RTN","C0PREFIL",110,0)
 . S ZX=$NA(@ZN@("XML",ZI))
"RTN","C0PREFIL",111,0)
 . S @ZV@("dispenseNumber")=$G(ZG2(ZI,"Dispense"))
"RTN","C0PREFIL",112,0)
 . S @ZV@("dosage")="Take "_$G(ZG2(ZI,"DosageNumberDescription"))_" "_$G(ZG2(ZI,"Route"))_" "_$G(ZG2(ZI,"DosageFrequencyDescription"))
"RTN","C0PREFIL",113,0)
 . S @ZV@("drugIdentifier")=ZG2(ZI,"DrugID")
"RTN","C0PREFIL",114,0)
 . S @ZV@("drugIdentifierType")="FDB"
"RTN","C0PREFIL",115,0)
 . S @ZV@("pharmacistMessage")="No childproof caps please"
"RTN","C0PREFIL",116,0)
 . S @ZV@("pharmacyIdentifier")=1231212
"RTN","C0PREFIL",117,0)
 . S @ZV@("refillCount")=ZG2(ZI,"Refills")
"RTN","C0PREFIL",118,0)
 . S @ZV@("substitution")="SubstitutionAllowed"
"RTN","C0PREFIL",119,0)
 . D MAP^C0CXPATH("ZG",ZV,ZX)
"RTN","C0PREFIL",120,0)
 . D QUEUE^C0CXPATH("ZB",ZX,2,$O(@ZX@(""),-1))
"RTN","C0PREFIL",121,0)
 D BUILD^C0CXPATH("ZB",OUTARY)
"RTN","C0PREFIL",122,0)
 K @ZN ;CLEAN UP
"RTN","C0PREFIL",123,0)
 Q
"RTN","C0PREFIL",124,0)
 ;
"RTN","C0PREFIL",125,0)
 ;B
"RTN","C0PREFIL",126,0)
 ;
"RTN","C0PREFIL",127,0)
 ;D GET^C0PCUR(.ZG2,ZDFN) ; GET THE MEDS FOR THIS PATIENT
"RTN","C0PREFIL",128,0)
 ;D EXTRACT^C0CALERT("ZG",ZDFN,"ZG2","ALGYCBK^C0PALGY3(ALTVMAP,A1)")
"RTN","C0PREFIL",129,0)
 S ZN=$O(ZR(""),-1) ;NUMBER OF LINES IN OUTPUT
"RTN","C0PREFIL",130,0)
 D QUEUE^C0CXPATH("ZB","ZG2",2,ZN-1)
"RTN","C0PREFIL",131,0)
 D BUILD^C0CXPATH("ZB",OUTARY)
"RTN","C0PREFIL",132,0)
 Q
"RTN","C0PREFIL",133,0)
 ; 
"RTN","C0PREFIL",134,0)
RGUIDS(ZARY,ZDUZ) ; RETURNS AN ARRAY OF ALL REFILL REQUEST GUIDS FOR 
"RTN","C0PREFIL",135,0)
 ; DUZ ZDUZ. ZARY IS PASSED BY NAME
"RTN","C0PREFIL",136,0)
 ; FORMAT IS @ZARY@("GUID")=IEN
"RTN","C0PREFIL",137,0)
 ; THIS ROUTINE IS REUSED FOR THE STATUS ROUTINE - INCOMPLETE ORDERS
"RTN","C0PREFIL",138,0)
 N ZI,ZJ,ZK,ZL,ZM,ZN
"RTN","C0PREFIL",139,0)
 S ZI=0
"RTN","C0PREFIL",140,0)
 ;F  S ZI=$O(^XTV(8992.1,"R",ZDUZ,ZI)) Q:ZI=""  D  ; ALL ALERT FOR DUZ
"RTN","C0PREFIL",141,0)
 F  S ZI=$O(^XTV(8992,ZDUZ,"XQA",ZI)) Q:ZI=""  D  ; USE XQA MULTIPLE
"RTN","C0PREFIL",142,0)
 . S ZL=^XTV(8992,ZDUZ,"XQA",ZI,0) ; 
"RTN","C0PREFIL",143,0)
 . S ZM=$P(ZL,U,2) ; RECORD ID
"RTN","C0PREFIL",144,0)
 . S ZN=$O(^XTV(8992.1,"B",ZM,"")) ;IEN OF ALERT TRACKING RECORD
"RTN","C0PREFIL",145,0)
 . S ZK=$$GET1^DIQ(8992.1,ZN_",",.03)
"RTN","C0PREFIL",146,0)
 . I ZK'["OR,1130" Q  ; NOT OUR PACKAGE - ALL ERX ALERTS START WITH 1130
"RTN","C0PREFIL",147,0)
 . ; 11305 IS FOR REFILLS
"RTN","C0PREFIL",148,0)
 . ; 11306 IS FOR INCOMPLETE ORDERS
"RTN","C0PREFIL",149,0)
 . S ZJ=""
"RTN","C0PREFIL",150,0)
 . S ZJ=$$GET1^DIQ(8992.1,ZN_",",2)
"RTN","C0PREFIL",151,0)
 . I ZJ="" Q
"RTN","C0PREFIL",152,0)
 . ; FOR RENEWALS (11305) NEED TO PULL THE GUID OUT - IT IS THE FIRST PIECE
"RTN","C0PREFIL",153,0)
 . ; OTHERWISE USE THE ENTIRE STRING. FOR INCOMPLETE ORDERS THIS WILL
"RTN","C0PREFIL",154,0)
 . ; INCLUDE THE MED AND PRESCRIPTION DATE
"RTN","C0PREFIL",155,0)
 . I ZK["OR,11305" S ZJ=$P(ZJ,"^",1) ; FIRST PIECE IS THE GUILD GUID^DOB^SEX
"RTN","C0PREFIL",156,0)
 . S @ZARY@(ZJ)=ZN
"RTN","C0PREFIL",157,0)
 Q
"RTN","C0PREFIL",158,0)
 ;
"RTN","C0PREFIL",159,0)
EN ; BATCH ENTRY POINT FOR REFILL (RENEWAL) STATUS AND FAILEDFAX CHECKING
"RTN","C0PREFIL",160,0)
 D REFILL
"RTN","C0PREFIL",161,0)
 K ZRSLT
"RTN","C0PREFIL",162,0)
 ;D STATUS ; ALSO RUN CHECK FOR INCOMPLETE ORDERS
"RTN","C0PREFIL",163,0)
 D FAILFAX ; ALSO RUN CHECK FOR FAILED FAXES
"RTN","C0PREFIL",164,0)
 ; smh - C0PTRAK depends on code that's not available... won't use.
"RTN","C0PREFIL",165,0)
 ; D RUNAWAY^C0PTRAK ; kill runaway jobs gpl 4/19/2012; smh comment out 5/9/2012
"RTN","C0PREFIL",166,0)
 Q
"RTN","C0PREFIL",167,0)
 ;
"RTN","C0PREFIL",168,0)
 ; TEST Lines below not intended for End Users. Programmers only.
"RTN","C0PREFIL",169,0)
 ; BEWARE ZWRITE SYNTAX. It may not work in other M Implementations.
"RTN","C0PREFIL",170,0)
SHOW ; SHOW THE CURRENT REFILL ALERTS ON THE SYSTEM
"RTN","C0PREFIL",171,0)
 ZWRITE ^XTV(8992,"AXQAN","OR,0,11305",*)
"RTN","C0PREFIL",172,0)
 Q
"RTN","C0PREFIL",173,0)
 ;
"RTN","C0PREFIL",174,0)
REFILL ; PULL REFILL REQUESTS AND POST ALERTS
"RTN","C0PREFIL",175,0)
 ;
"RTN","C0PREFIL",176,0)
 N ZDUZ ; USER NUMBER UNDER WHICH WE BUILD THE WEB SERVICE CALL
"RTN","C0PREFIL",177,0)
 N ZDFN ; PATIENT NUMBER USED TO BUILD THE WEB SERVICE CALL
"RTN","C0PREFIL",178,0)
 S ZDUZ=$$PRIMARY^C0PMAIN() ; PRIMARY ERX USER FOR BATCH CALLS
"RTN","C0PREFIL",179,0)
 ;S ZDUZ=DUZ ; SHOULD CHANGE THIS FOR PRODUCTION TO A "BATCH" USER
"RTN","C0PREFIL",180,0)
 S ZDFN="" ; NO PATIENT NEEDED FOR THESE CALLS
"RTN","C0PREFIL",181,0)
 ; S ZDFN=18 ; SHOULD NOT NEED THIS BE MAKE THE CALL - FIX IN EN^C0PMAIN
"RTN","C0PREFIL",182,0)
 N ZRSLT
"RTN","C0PREFIL",183,0)
 D SOAP^C0PWS2("ZRSLT","REFILLS",ZDUZ,ZDFN) ; WS CALL TO RETURN REFILS
"RTN","C0PREFIL",184,0)
 ;S XXX=YYY  ;
"RTN","C0PREFIL",185,0)
 I $G(ZRSLT(1,"Status"))'="OK" Q  ; NO ROWS WERE RETURNED
"RTN","C0PREFIL",186,0)
 I $G(ZRSLT(1,"RowCount"))=0 Q  ; NO ROWS WERE RETURNED
"RTN","C0PREFIL",187,0)
 D NOTIPURG^XQALBUTL(11305) ; DELETE ALL CURRENT REFILL ALERTS
"RTN","C0PREFIL",188,0)
 S C0PNPIF=$$GET1^DIQ(C0PAF,C0PACCT_",",8,"I") ; LEGACY FLAG TO USE NPI FOR SID
"RTN","C0PREFIL",189,0)
 N ZI S ZI=0
"RTN","C0PREFIL",190,0)
 N ZAPACK S ZAPACK="OR" ; ALERT PACKAGE CODE
"RTN","C0PREFIL",191,0)
 N ZADFN S ZADFN=0 ; DFN TO ASSOCIATE ALERT WITH - WE DON'T KNOW THIS
"RTN","C0PREFIL",192,0)
 N ZACODE S ZACODE=11305 ; IEN TO OE/RR NOTIFICATIONS file for eRx Refills
"RTN","C0PREFIL",193,0)
 F  S ZI=$O(ZRSLT(ZI)) Q:+ZI=0  D  ; FOR EACH RETURNED REFILL REQUEST
"RTN","C0PREFIL",194,0)
 . N ZSID S ZSID=ZRSLT(ZI,"ExternalDoctorId") ; NPI FOR SUBSCRIBER
"RTN","C0PREFIL",195,0)
 . I C0PNPIF'=1 S ZDUZ=$O(^VA(200,"AC0PSID",ZSID,"")) ; GUID SID
"RTN","C0PREFIL",196,0)
 . E  S ZDUZ=$O(^VA(200,"C0PNPI",ZSID,"")) ; DUZ FOR SUBSCRIBER
"RTN","C0PREFIL",197,0)
 . S ZRSLT("DUZ",ZDUZ,ZI)=""
"RTN","C0PREFIL",198,0)
 N ZJ S ZJ=""
"RTN","C0PREFIL",199,0)
 F  S ZJ=$O(ZRSLT("DUZ",ZJ)) Q:ZJ=""  D  ; FOR EACH PROVIDER
"RTN","C0PREFIL",200,0)
 . N ZGUIDS
"RTN","C0PREFIL",201,0)
 . D RGUIDS("ZGUIDS",ZJ) ; GET ARRAY OF CURRENT ACTIVE GUIDS
"RTN","C0PREFIL",202,0)
 . S ZI=""
"RTN","C0PREFIL",203,0)
 . F  S ZI=$O(ZRSLT("DUZ",ZJ,ZI)) Q:ZI=""  D  ; FOR EACH REQUEST
"RTN","C0PREFIL",204,0)
 . . N ZRRG S ZRRG=ZRSLT(ZI,"RenewalRequestGuid") ;renewal request number
"RTN","C0PREFIL",205,0)
 . . I $D(ZGUIDS(ZRRG)) D  Q  ; THIS REQUEST IS A DUPLICATE, SKIP IT 
"RTN","C0PREFIL",206,0)
 . . . W ZRRG_" IS A DUP",!
"RTN","C0PREFIL",207,0)
 . . N ZDATE S ZDATE=$P(ZRSLT(ZI,"ReceivedTimestamp")," ",1) ;DATE RECEIVED
"RTN","C0PREFIL",208,0)
 . . I $G(^TMP("C0P","TestNoMatch"))=1 D  ;
"RTN","C0PREFIL",209,0)
 . . . S ZRSLT(ZI,"PatientMiddleName")="XXX" ;TESTING NO MATCH  REMOVE ME
"RTN","C0PREFIL",210,0)
 . . ;I DUZ=135 S ZRSLT(ZI,"PatientMiddleName")="Uta" ;TESTING NO MATCH REMOVE
"RTN","C0PREFIL",211,0)
 . . N ZPAT S ZPAT=$G(ZRSLT(ZI,"PatientLastName"))_","_$G(ZRSLT(ZI,"PatientFirstName")) ; PATIENT NAME LAST,FIRST
"RTN","C0PREFIL",212,0)
 . . I $G(ZRSLT(ZI,"PatientMiddleName"))'="" S ZPAT=ZPAT_" "_$G(ZRSLT(ZI,"PatientMiddleName"))
"RTN","C0PREFIL",213,0)
 . . S ZDOB=$G(ZRSLT(ZI,"PatientDOB")) ;patient date of birth
"RTN","C0PREFIL",214,0)
 . . S ZSEX=$G(ZRSLT(ZI,"PatientGender")) ;patient gender
"RTN","C0PREFIL",215,0)
 . . S ZADFN=$$PATMAT(ZPAT,ZDOB,ZSEX) ; TRY AND MATCH THE PATIENT
"RTN","C0PREFIL",216,0)
 . . ;W "DFN="_ZADFN," ",ZI,!
"RTN","C0PREFIL",217,0)
 . . N ZXQAID S ZXQAID=ZAPACK_","_ZADFN_","_ZACODE ; FORMAT FOR P1 OF XQAID
"RTN","C0PREFIL",218,0)
 . . N ZMED S ZMED=ZRSLT(ZI,"DrugInfo")
"RTN","C0PREFIL",219,0)
 . . ;S XQA(ZDUZ)="" ; WHO TO SEND THE ALERT TO
"RTN","C0PREFIL",220,0)
 . . I '$D(^TMP("C0P","AlertVerify")) S XQA(ZJ)="" ; WHO TO SEND THE ALERT TO
"RTN","C0PREFIL",221,0)
 . . E  D  ; AlertVerify sends alerts only to testers, not recipients
"RTN","C0PREFIL",222,0)
 . . . ; use this when installing eRx to verify ewd installation
"RTN","C0PREFIL",223,0)
 . . . N ZZZ S ZZZ=""
"RTN","C0PREFIL",224,0)
 . . . F  S ZZZ=$O(^TMP("C0P","AlertVerify",ZZZ)) Q:ZZZ=""  D  ; WHICH DUZ 
"RTN","C0PREFIL",225,0)
 . . . . S XQA(ZZZ)="" ; MARK THIS USER TO RECIEVE ALERTS
"RTN","C0PREFIL",226,0)
 . . ;S XQA(135)="" ; ALWAYS SEND TO GPL
"RTN","C0PREFIL",227,0)
 . . ;S XQA(148)="" ; ALWAYS SEND TO RICH
"RTN","C0PREFIL",228,0)
 . . N ZP6 ; STRING THAT CPRS WILL RETURN FOR MATCHING 
"RTN","C0PREFIL",229,0)
 . . I ZADFN=0 D  ; NO MATCH
"RTN","C0PREFIL",230,0)
 . . . S XQAMSG="no match: ): [eRx] "_ZPAT_" Renewal request for "_ZMED
"RTN","C0PREFIL",231,0)
 . . . S ZP6=ZPAT_" Renewal request for "_ZMED
"RTN","C0PREFIL",232,0)
 . . E  D  ;
"RTN","C0PREFIL",233,0)
 . . . S XQAMSG=ZPAT_": ): [eRx] Renewal request for "_ZMED
"RTN","C0PREFIL",234,0)
 . . . S ZP6="Renewal request for "_ZMED
"RTN","C0PREFIL",235,0)
 . . ;S XQAMSG=$E(XQAMSG,1,70) ; TRUNCATE TO 70 CHARS
"RTN","C0PREFIL",236,0)
 . . S XQAID=ZXQAID ; PACKAGE IDENTIFIER 
"RTN","C0PREFIL",237,0)
 . . ;S XQADATA=ZRRG ; THE GUID OF THE REQUEST. NEEDED TO PROCESS THE ALERT
"RTN","C0PREFIL",238,0)
 . . S XQADATA=ZRRG_"^"_ZDOB_"^"_ZSEX ; SAVE DOB AND SEX WITH GUID
"RTN","C0PREFIL",239,0)
 . . W "SENDING",XQAID_" "_XQADATA,!
"RTN","C0PREFIL",240,0)
 . . D SETUP^XQALERT ; MAKE THE CALL TO SET THE ALERT
"RTN","C0PREFIL",241,0)
 . . HANG 1 ; NEED TO MAKE SURE TIME STAMP IS UNIQUE
"RTN","C0PREFIL",242,0)
 K ZRSLT
"RTN","C0PREFIL",243,0)
 ;D STATUS ; ALSO RUN CHECK FOR INCOMPLETE ORDERS
"RTN","C0PREFIL",244,0)
 ;D FAILFAX ; ALSO RUN CHECK FOR FAILED FAXES
"RTN","C0PREFIL",245,0)
 Q
"RTN","C0PREFIL",246,0)
 ;
"RTN","C0PREFIL",247,0)
PATMAT(ZNAME,INDOB,INSEX) ;EXTRINSIC TO TRY AND MATCH THE PATIENT 
"RTN","C0PREFIL",248,0)
 ; RETURNS ZERO IF NO EXACT MATCH IS FOUND
"RTN","C0PREFIL",249,0)
 N ZP
"RTN","C0PREFIL",250,0)
 S ZP=$O(^DPT("B",ZNAME,""))
"RTN","C0PREFIL",251,0)
 I ZP="" Q 0 ; EXACT MATCH NOT FOUND ON NAME
"RTN","C0PREFIL",252,0)
 ; CHECK DATE OF BIRTH
"RTN","C0PREFIL",253,0)
 ;W "CHECKING DATE OF BIRTH",!
"RTN","C0PREFIL",254,0)
 N DOB
"RTN","C0PREFIL",255,0)
 S DOB=$$GET1^DIQ(2,ZP_",",.03,"I") ; PATIENT'S DATE OF BIRTH IN VISTA
"RTN","C0PREFIL",256,0)
 N ZD ;INCOMING DATE OF BIRTH IS IN YYYYMMDD FORMAT
"RTN","C0PREFIL",257,0)
 S ZD=($E(INDOB,1,4)-1700)_$E(INDOB,5,8) ; DATE OF BIRTH CONVERTED TO FM FORMAT
"RTN","C0PREFIL",258,0)
 ;W ZD_" "_DOB,!
"RTN","C0PREFIL",259,0)
 I +ZD'=+DOB Q 0 ; DATE OF BIRTH DOES NOT MATCH
"RTN","C0PREFIL",260,0)
 ;
"RTN","C0PREFIL",261,0)
 ; CHECK GENDER
"RTN","C0PREFIL",262,0)
 ;W "CHECKING GENDER",!
"RTN","C0PREFIL",263,0)
 N GENDER
"RTN","C0PREFIL",264,0)
 S GENDER=$$GET1^DIQ(2,ZP_",",.02,"I") ; PATIENT'S GENDER IN VISTA
"RTN","C0PREFIL",265,0)
 ;W GENDER_INSEX,!
"RTN","C0PREFIL",266,0)
 I GENDER'=INSEX Q 0 ;GENDER DOESN'T MATCH
"RTN","C0PREFIL",267,0)
 Q ZP
"RTN","C0PREFIL",268,0)
 ;
"RTN","C0PREFIL",269,0)
STATUS ; BATCH CALL TO RETRIEVE ERX ACCOUNT STATUS
"RTN","C0PREFIL",270,0)
 ; RETURNS UNFINISHED ORDERS FOR ALL PROVIDERS
"RTN","C0PREFIL",271,0)
 ; AND SENDS STATUS ALERTS
"RTN","C0PREFIL",272,0)
 N VOR
"RTN","C0PREFIL",273,0)
 S VOR("STATUS-SECTION-TYPE")="AllDoctorReview"
"RTN","C0PREFIL",274,0)
 S VOR("SORT-ORDER")="A"
"RTN","C0PREFIL",275,0)
 S VOR("INCLUDE-SCHEMA")="N"
"RTN","C0PREFIL",276,0)
 S ZDUZ=$$PRIMARY^C0PMAIN() ; PRIMARY ERX USER FOR BATCH CALLS
"RTN","C0PREFIL",277,0)
 K ZRSLT
"RTN","C0PREFIL",278,0)
 ; D SOAP^C0PWS1("ZRSLT","STATUS",ZDUZ,"","VOR")
"RTN","C0PREFIL",279,0)
 D SOAP^C0PWS2("ZRSLT","STATUS",ZDUZ,"","VOR")
"RTN","C0PREFIL",280,0)
 I '$D(ZRSLT) Q  ; SHOULDN'T HAPPEN
"RTN","C0PREFIL",281,0)
 I $G(ZRSLT(1,"DrugInfo"))="" Q  ; NO ROWS
"RTN","C0PREFIL",282,0)
 S C0PNPIF=$$GET1^DIQ(C0PAF,C0PACCT_",",8,"I") ; LEGACY FLAG TO USE NPI FOR SID
"RTN","C0PREFIL",283,0)
 N ZI S ZI=0
"RTN","C0PREFIL",284,0)
 N ZAPACK S ZAPACK="OR" ; ALERT PACKAGE CODE
"RTN","C0PREFIL",285,0)
 N ZADFN S ZADFN=0 ; DFN TO ASSOCIATE ALERT WITH - WE DON'T KNOW THIS
"RTN","C0PREFIL",286,0)
 N ZACODE S ZACODE=11306 ; IEN TO OE/RR NOTIFICATIONS file for eRx incomplete
"RTN","C0PREFIL",287,0)
 ; orders
"RTN","C0PREFIL",288,0)
 F  S ZI=$O(ZRSLT(ZI)) Q:+ZI=0  D  ; FOR EACH RETURNED REFILL REQUEST
"RTN","C0PREFIL",289,0)
 . N ZSID S ZSID=$G(ZRSLT(ZI,"ExternalDoctorId")) ; NPI FOR SUBSCRIBER
"RTN","C0PREFIL",290,0)
 . I ZSID="" Q  ; NO EXTERNAL ID FOR THIS STATUS
"RTN","C0PREFIL",291,0)
 . I C0PNPIF'=1 S ZDUZ=$O(^VA(200,"AC0PSID",ZSID,"")) ; GUID SID
"RTN","C0PREFIL",292,0)
 . E  S ZDUZ=$O(^VA(200,"C0PNPI",ZSID,"")) ; DUZ FOR SUBSCRIBER
"RTN","C0PREFIL",293,0)
 . S ZRSLT("DUZ",ZDUZ,ZI)=""
"RTN","C0PREFIL",294,0)
 N ZJ S ZJ=""
"RTN","C0PREFIL",295,0)
 D RMSTATUS ; REMOVE ALL STATUS ALERTS
"RTN","C0PREFIL",296,0)
 F  S ZJ=$O(ZRSLT("DUZ",ZJ)) Q:ZJ=""  D  ; FOR EACH PROVIDER
"RTN","C0PREFIL",297,0)
 . N ZGUIDS
"RTN","C0PREFIL",298,0)
 . D RGUIDS("ZGUIDS",ZJ) ; GET ARRAY OF CURRENT ACTIVE ALERTS
"RTN","C0PREFIL",299,0)
 . S ZI=""
"RTN","C0PREFIL",300,0)
 . F  S ZI=$O(ZRSLT("DUZ",ZJ,ZI)) Q:ZI=""  D  ; FOR EACH REQUEST
"RTN","C0PREFIL",301,0)
 . . N ZRRG S ZRRG=$G(ZRSLT(ZI,"DrugInfo")) ; first piece of XQDATA
"RTN","C0PREFIL",302,0)
 . . S $P(ZRRG,"^",2)=$G(ZRSLT(ZI,"PrescriptionDate")) ; second piece
"RTN","C0PREFIL",303,0)
 . . I $D(ZGUIDS(ZRRG)) D  Q  ; THIS REQUEST IS A DUPLICATE, SKIP IT 
"RTN","C0PREFIL",304,0)
 . . . ;W ZRRG_" IS A DUP",!
"RTN","C0PREFIL",305,0)
 . . I ZRRG="^" D ERROR^C0PMAIN(",U113059004,",$ST($ST,"PLACE"),"ERX-NOT","Notification Error") QUIT
"RTN","C0PREFIL",306,0)
 . . N ZDATE S ZDATE=$P($G(ZRSLT(ZI,"PrescriptionDate"))," ",1) ;
"RTN","C0PREFIL",307,0)
 . . N ZPAT S ZPAT=$G(ZRSLT(ZI,"ExternalPatientId")) ; format PATIENTDFN
"RTN","C0PREFIL",308,0)
 . . I ZPAT="" Q  ;THIS IS AN ERROR
"RTN","C0PREFIL",309,0)
 . . S ZADFN=$P(ZPAT,"PATIENT",2) ; EXTRACT THE DFN
"RTN","C0PREFIL",310,0)
 . . S ZPAT=$$GET1^DIQ(2,ZADFN_",",.01) ;PATIENT'S NAME
"RTN","C0PREFIL",311,0)
 . . ;W "DFN="_ZADFN," ",ZI,!
"RTN","C0PREFIL",312,0)
 . . N ZXQAID S ZXQAID=ZAPACK_","_ZADFN_","_ZACODE ; FORMAT FOR P1 OF XQAID
"RTN","C0PREFIL",313,0)
 . . N ZMED S ZMED=ZRSLT(ZI,"DrugInfo")
"RTN","C0PREFIL",314,0)
 . . ;S XQA(ZDUZ)="" ; WHO TO SEND THE ALERT TO
"RTN","C0PREFIL",315,0)
 . . S XQA(ZJ)="" ; WHO TO SEND THE ALERT TO
"RTN","C0PREFIL",316,0)
 . . ;S XQA(135)="" ; ALWAYS SEND TO GPL
"RTN","C0PREFIL",317,0)
 . . ;S XQA(148)="" ; ALWAYS SEND TO RICH
"RTN","C0PREFIL",318,0)
 . . N ZP6 ; STRING THAT CPRS WILL RETURN FOR MATCHING 
"RTN","C0PREFIL",319,0)
 . . I ZADFN=0 D  ; NO MATCH
"RTN","C0PREFIL",320,0)
 . . . S XQAMSG="no match: ): [eRx] "_ZPAT_" Incomplete Order for "_ZMED
"RTN","C0PREFIL",321,0)
 . . . S ZP6=ZPAT_" Incomplete Order for "_ZMED
"RTN","C0PREFIL",322,0)
 . . E  D  ;
"RTN","C0PREFIL",323,0)
 . . . S XQAMSG=ZPAT_": ): [eRx] Incomplete Order for "_ZMED
"RTN","C0PREFIL",324,0)
 . . . S ZP6="Incomplete Order for "_ZMED
"RTN","C0PREFIL",325,0)
 . . ;S XQAMSG=$E(XQAMSG,1,70) ; TRUNCATE TO 70 CHARS
"RTN","C0PREFIL",326,0)
 . . S XQAID=ZXQAID ; PACKAGE IDENTIFIER
"RTN","C0PREFIL",327,0)
 . . S XQADATA=ZRRG ; THE GUID OF THE REQUEST. NEEDED TO PROCESS THE ALERT
"RTN","C0PREFIL",328,0)
 . . D SETUP^XQALERT ; MAKE THE CALL TO SET THE ALERT
"RTN","C0PREFIL",329,0)
 Q
"RTN","C0PREFIL",330,0)
 ;
"RTN","C0PREFIL",331,0)
RMSTATUS ; DELETES ALL STATUS ALERTS FOR ALL USERS (THEY WILL BE
"RTN","C0PREFIL",332,0)
 ; RESTORED NEXT TIME STATUS^C0PREFIL IS RUN - IN ERX BATCH
"RTN","C0PREFIL",333,0)
 D NOTIPURG^XQALBUTL(11306) ;
"RTN","C0PREFIL",334,0)
 W !,"ALL ERX STATUS ALERTS HAVE BEEN DELETED"
"RTN","C0PREFIL",335,0)
 Q
"RTN","C0PREFIL",336,0)
 ;
"RTN","C0PREFIL",337,0)
FAILFAX ; BATCH CALL TO RETRIEVE ERX FAILED FAX STATUS
"RTN","C0PREFIL",338,0)
 ; RETURNS A COUNT OF FAILED FAXES AND AN ARRAY OF PATIENTS
"RTN","C0PREFIL",339,0)
 N VOR,ZRSLT
"RTN","C0PREFIL",340,0)
 S VOR("STATUS-SECTION-TYPE")="FailedFax"
"RTN","C0PREFIL",341,0)
 ;S VOR("ACCOUNT-PARTNERNAME")="demo"
"RTN","C0PREFIL",342,0)
 S VOR("SORT-ORDER")="A"
"RTN","C0PREFIL",343,0)
 S VOR("INCLUDE-SCHEMA")="N"
"RTN","C0PREFIL",344,0)
 S ZDUZ=$$PRIMARY^C0PMAIN() ; PRIMARY ERX USER FOR BATCH CALLS
"RTN","C0PREFIL",345,0)
 D SOAP^C0PWS1("ZRSLT","STATUS",ZDUZ,"","VOR")
"RTN","C0PREFIL",346,0)
 N ZCOUNT
"RTN","C0PREFIL",347,0)
 S ZCOUNT=$O(ZRSLT(""),-1) ; HOW MANY FAILED FAXES
"RTN","C0PREFIL",348,0)
 I +ZCOUNT=0 Q  ; NO FAILED FAXES
"RTN","C0PREFIL",349,0)
 ;I $G(ZRSLT(1,"RowCount"))=0 Q  ; NO FAILED FAXES
"RTN","C0PREFIL",350,0)
 ;I $G(ZRSLT(1,"RowCount"))="" Q  ; SHOULD NOT HAPPEN
"RTN","C0PREFIL",351,0)
 N XQA,XQAMSG,XQAID,XQAKILL
"RTN","C0PREFIL",352,0)
 S XQAID="C0P" ; GOING TO FIRST KILL ALL FAILED FAX ALERTS
"RTN","C0PREFIL",353,0)
 D DELETEA^XQALERT ; KILL ALL FAILED FAX ALERTS
"RTN","C0PREFIL",354,0)
 S XQA("G.ERX HELP DESK")=""
"RTN","C0PREFIL",355,0)
 ;S XQA(135)=""
"RTN","C0PREFIL",356,0)
 S XQAID="C0P"
"RTN","C0PREFIL",357,0)
 S XQAMSG="eRx: "_ZCOUNT_" Failed Faxes on ePrescribing"
"RTN","C0PREFIL",358,0)
 D SETUP^XQALERT ; CREATE NEW FAILED FAX ALERTS TO THE MAILGROUP
"RTN","C0PREFIL",359,0)
 Q
"RTN","C0PREFIL",360,0)
 ;
"RTN","C0PREFIL",361,0)
RUN ; USED TO PROCESS AN ALERT. THIS ROUTINE IS LISTED IN
"RTN","C0PREFIL",362,0)
 ; 0E/RR CPRS NOTIFICATIONS AS THE ROUTINE TO RUN TO PROCESS
"RTN","C0PREFIL",363,0)
 ; A C0P ERX ALERT
"RTN","C0PREFIL",364,0)
 W "MADE IT TO RUN C0PREFIL",!
"RTN","C0PREFIL",365,0)
 W XQADATA
"RTN","C0PREFIL",366,0)
 ; B
"RTN","C0PREFIL",367,0)
 Q
"RTN","C0PREFIL",368,0)
 ;
"RTN","C0PREFIL",369,0)
GETALRT(ZARY,ZID) ; LOOKS UP AN ALERT BY USING THE "RECORDID" FROM CPRS,
"RTN","C0PREFIL",370,0)
 ; PASSED BY VALUE IN ZID. RESULTS ARE RETURNED IN ZARY, PASSED BY NAME
"RTN","C0PREFIL",371,0)
 ;N ZIEN
"RTN","C0PREFIL",372,0)
 ;S ZIEN=$O(^XTV(8992.1,"B",ZID,"")) ;IEN IN THE ALERT TRACKING FILE
"RTN","C0PREFIL",373,0)
 ;I ZIEN="" W "ERROR RETRIEVING ALERT",! Q  ;
"RTN","C0PREFIL",374,0)
 D GETN^C0CRNF(ZARY,8992.1,ZID,"B") ; GET ALL THE ALERT FIELDS
"RTN","C0PREFIL",375,0)
 ; THE FORMAT IS @ZARY@("DATA FOR PROCESSING")="FILE^FIELD^VALUE"
"RTN","C0PREFIL",376,0)
 ; ALL POPULATED FIELDS (BUT NOT SUBFILES) ARE RETURNED
"RTN","C0PREFIL",377,0)
 Q
"RTN","C0PREFIL",378,0)
 ; 
"RTN","C0PREFIL",379,0)
UPDIE   ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
"RTN","C0PREFIL",380,0)
 K ZERR
"RTN","C0PREFIL",381,0)
 D CLEAN^DILF
"RTN","C0PREFIL",382,0)
 D UPDATE^DIE("","C0PFDA","","ZERR")
"RTN","C0PREFIL",383,0)
 I $D(ZERR) D ERROR^C0PMAIN(",U113059008,",$ST($ST,"PLACE"),"ERX-UPDIE-FAIL","Fileman Data Update Failure") QUIT
"RTN","C0PREFIL",384,0)
 K C0PFDA
"RTN","C0PREFIL",385,0)
 Q
"RTN","C0PRXNRD")
1^7
"RTN","C0PSMEDS")
0^31^B9112048
"RTN","C0PSMEDS",1,0)
C0PSMEDS   ; ERX/GPL - Utilities for eRx SendMeds; 3/1/11
"RTN","C0PSMEDS",2,0)
 ;;1.0;C0P;;Apr 25, 2012;Build 103
"RTN","C0PSMEDS",3,0)
 ;Copyright 2011 George Lilly.  Licensed under the terms of the GNU
"RTN","C0PSMEDS",4,0)
 ;General Public License See attached copy of the License.
"RTN","C0PSMEDS",5,0)
 ;
"RTN","C0PSMEDS",6,0)
 ;This program is free software; you can redistribute it and/or modify
"RTN","C0PSMEDS",7,0)
 ;it under the terms of the GNU General Public License as published by
"RTN","C0PSMEDS",8,0)
 ;the Free Software Foundation; either version 2 of the License, or
"RTN","C0PSMEDS",9,0)
 ;(at your option) any later version.
"RTN","C0PSMEDS",10,0)
 ;
"RTN","C0PSMEDS",11,0)
 ;This program is distributed in the hope that it will be useful,
"RTN","C0PSMEDS",12,0)
 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0PSMEDS",13,0)
 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"RTN","C0PSMEDS",14,0)
 ;GNU General Public License for more details.
"RTN","C0PSMEDS",15,0)
 ;
"RTN","C0PSMEDS",16,0)
 ;You should have received a copy of the GNU General Public License along
"RTN","C0PSMEDS",17,0)
 ;with this program; if not, write to the Free Software Foundation, Inc.,
"RTN","C0PSMEDS",18,0)
 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
"RTN","C0PSMEDS",19,0)
 ;
"RTN","C0PSMEDS",20,0)
 Q
"RTN","C0PSMEDS",21,0)
 ;
"RTN","C0PSMEDS",22,0)
ADD(RTNXML,G6) ; ADD SENDMEDS TO THE NCSCRIPT XML
"RTN","C0PSMEDS",23,0)
 N GEND,ZG1,G5,GBLD
"RTN","C0PSMEDS",24,0)
 M ZG1=@RTNXML
"RTN","C0PSMEDS",25,0)
 S GEND=$O(ZG1(""),-1)-1
"RTN","C0PSMEDS",26,0)
 D QUEUE^C0CXPATH("GBLD","ZG1",1,GEND) ; NCSCRIPT.. UP TO </NCScript>
"RTN","C0PSMEDS",27,0)
 D QUEUE^C0CXPATH("GBLD",G6,1,$O(@G6@(""),-1)) ; ADD THE MEDS
"RTN","C0PSMEDS",28,0)
 D QUEUE^C0CXPATH("GBLD","ZG1",GEND+1,GEND+1) ;END OF NCSCRIPT
"RTN","C0PSMEDS",29,0)
 D BUILD^C0CXPATH("GBLD","G5") ; BUILD THE CONTENTS FROM THE BUILD LIST
"RTN","C0PSMEDS",30,0)
 K @RTNXML
"RTN","C0PSMEDS",31,0)
 M @RTNXML=G5 ;
"RTN","C0PSMEDS",32,0)
 Q
"RTN","C0PSMEDS",33,0)
 ;
"RTN","C0PSMEDS",34,0)
FREETXT(RXML,ZDUZ,ZDFN) ; ADD FREE TEXT MEDS FOR PATIENT ZDFN TO RXML, 
"RTN","C0PSMEDS",35,0)
 ; PASSED BY NAME; ZDUZ IS PASSED TO RESOLVE THE TEMPLATE
"RTN","C0PSMEDS",36,0)
 N ZTID,ZMEDS,ZI,ZN,ZTMP,ZVARS,ZBLD,ZNM
"RTN","C0PSMEDS",37,0)
 S ZTID=$$RESTID^C0PWS1(ZDUZ,"FREE TEXT MEDS") ;GET TEMPLATE ID
"RTN","C0PSMEDS",38,0)
 D GET^C0PCUR(.ZMEDS,ZDFN) ; GET THE PATIENT'S CURRENT MEDS
"RTN","C0PSMEDS",39,0)
 S ZN=$O(ZMEDS(""),-1) ; COUNT OF MEDS
"RTN","C0PSMEDS",40,0)
 I +ZN=0 Q  ; NO MEDS, QUIT
"RTN","C0PSMEDS",41,0)
 F ZI=1:1:ZN D  ; FOR EACH MED
"RTN","C0PSMEDS",42,0)
 . N ZCMT
"RTN","C0PSMEDS",43,0)
 . S ZCMT=$G(ZMEDS(ZI,"COMMENTS",1))
"RTN","C0PSMEDS",44,0)
 . I ZCMT["E-Rx" Q  ; SKIP eRx MEDS
"RTN","C0PSMEDS",45,0)
 . I ZCMT["Received by" Q  ; SKIP eRx Meds
"RTN","C0PSMEDS",46,0)
 . I $P(ZMEDS(ZI,0),"^",9)'="ACTIVE" Q  ; ONLY WANT ACTIVE DRUGS
"RTN","C0PSMEDS",47,0)
 . ; GET TYPE OF DRUG
"RTN","C0PSMEDS",48,0)
 . N ZTYP
"RTN","C0PSMEDS",49,0)
 . S ZTYP=$P($P(ZMEDS(ZI,0),"^",1),";",2) ; SHOULD BE AN I OR O
"RTN","C0PSMEDS",50,0)
 . I ZTYP="I" Q  ; DON'T WANT INPATIENT MEDS
"RTN","C0PSMEDS",51,0)
 . S ZNM=$NA(ZTMP(ZI)) ; PLACE TO PUT THIS MED XML
"RTN","C0PSMEDS",52,0)
 . N ZDATE
"RTN","C0PSMEDS",53,0)
 . S ZDATE=$G(ZMEDS(ZI,"START"))
"RTN","C0PSMEDS",54,0)
 . I ZDATE'="" D  ; TRANSLATE FM DATE TO YYYYMMDD
"RTN","C0PSMEDS",55,0)
 . . S ZDATE=$$FMDTOUTC^C0CUTIL(ZDATE,"D")
"RTN","C0PSMEDS",56,0)
 . . S ZDATE=$TR(ZDATE,"-") ;REMOVE DASHES FROM DOB
"RTN","C0PSMEDS",57,0)
 . I ZDATE="" S ZDATE=""
"RTN","C0PSMEDS",58,0)
 . S ZVARS("date")=ZDATE
"RTN","C0PSMEDS",59,0)
 . S ZVARS("dispenseNumber")=0
"RTN","C0PSMEDS",60,0)
 . S ZVARS("doctorName")=$P($G(ZMEDS(ZI,"P",0)),"^",2)
"RTN","C0PSMEDS",61,0)
 . S ZVARS("drug")=$P(ZMEDS(ZI,0),"^",2) ; NAME OF THE MED
"RTN","C0PSMEDS",62,0)
 . N ZEXID
"RTN","C0PSMEDS",63,0)
 . S ZEXID=$G(ZMEDS(ZI,"NVAIEN"))
"RTN","C0PSMEDS",64,0)
 . I ZEXID="" S ZEXID="MED_"_$G(ZMEDS(ZI,"DRUG")) ; THE MED NUMBER
"RTN","C0PSMEDS",65,0)
 . S ZVARS("externalId")=ZEXID
"RTN","C0PSMEDS",66,0)
 . S ZVARS("prescriptionType")="reconcile"
"RTN","C0PSMEDS",67,0)
 . S ZVARS("refillCount")=0
"RTN","C0PSMEDS",68,0)
 . S ZVARS("sig")=$G(ZMEDS(ZI,"SIG",1,0))
"RTN","C0PSMEDS",69,0)
 . S ZVARS("sig")=$TR(ZVARS("sig"),"'")
"RTN","C0PSMEDS",70,0)
 . D MAP^C0PMAIN(ZNM,"ZVARS",ZTID) ; GENERATE XML FOR 1 MED
"RTN","C0PSMEDS",71,0)
 . ;B
"RTN","C0PSMEDS",72,0)
 . D QUEUE^C0CXPATH("ZBLD",ZNM,1,@ZNM@(0)) ; ADD TO BUILD LIST
"RTN","C0PSMEDS",73,0)
 I +$D(ZBLD)=0 Q  ; NO NON-ERX MEDS
"RTN","C0PSMEDS",74,0)
 D BUILD^C0CXPATH("ZBLD",RXML) ; BUILD ALL THE MEDS
"RTN","C0PSMEDS",75,0)
 Q
"RTN","C0PSMEDS",76,0)
 ;
"RTN","C0PSUB")
0^1^B140320803
"RTN","C0PSUB",1,0)
C0PSUB   ; ERX/GPL - ERX SUBSCRIBER utilities; 5/8/12 9:51pm
"RTN","C0PSUB",2,0)
 ;;1.0;C0P;;Apr 25, 2012;Build 103
"RTN","C0PSUB",3,0)
 ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"RTN","C0PSUB",4,0)
 ;General Public License See attached copy of the License.
"RTN","C0PSUB",5,0)
 ;
"RTN","C0PSUB",6,0)
 ;This program is free software; you can redistribute it and/or modify
"RTN","C0PSUB",7,0)
 ;it under the terms of the GNU General Public License as published by
"RTN","C0PSUB",8,0)
 ;the Free Software Foundation; either version 2 of the License, or
"RTN","C0PSUB",9,0)
 ;(at your option) any later version.
"RTN","C0PSUB",10,0)
 ;
"RTN","C0PSUB",11,0)
 ;This program is distributed in the hope that it will be useful,
"RTN","C0PSUB",12,0)
 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0PSUB",13,0)
 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"RTN","C0PSUB",14,0)
 ;GNU General Public License for more details.
"RTN","C0PSUB",15,0)
 ;
"RTN","C0PSUB",16,0)
 ;You should have received a copy of the GNU General Public License along
"RTN","C0PSUB",17,0)
 ;with this program; if not, write to the Free Software Foundation, Inc.,
"RTN","C0PSUB",18,0)
 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
"RTN","C0PSUB",19,0)
 ;
"RTN","C0PSUB",20,0)
 QUIT
"RTN","C0PSUB",21,0)
EN(INARY,C0PDUZ) ; creates the array inary passed by name for subscriber
"RTN","C0PSUB",22,0)
 ; variables, mostly from the new person file
"RTN","C0PSUB",23,0)
 ; SUBSCRIBER-FAMILY-NAME
"RTN","C0PSUB",24,0)
 ; SUBSCRIBER-GIVEN-NAME
"RTN","C0PSUB",25,0)
 ; SUBSCRIBER-MIDDLE-NAME
"RTN","C0PSUB",26,0)
 ; LOCATION-PHONE
"RTN","C0PSUB",27,0)
 ; LOCATION-FAX
"RTN","C0PSUB",28,0)
 ; ACCOUNT-PHONE
"RTN","C0PSUB",29,0)
 ; ACCOUNT-FAX
"RTN","C0PSUB",30,0)
 ; LOCATION-ADDRESS1
"RTN","C0PSUB",31,0)
 ; LOCATION-ADDRESS2
"RTN","C0PSUB",32,0)
 ; LOCATION-CITY
"RTN","C0PSUB",33,0)
 ; LOCATION-ZIP
"RTN","C0PSUB",34,0)
 ; LOCATION-ZIP4
"RTN","C0PSUB",35,0)
 ; LOCATION-STATE
"RTN","C0PSUB",36,0)
 ; SUBSCRIBER-LICENSE
"RTN","C0PSUB",37,0)
 ; SUBSCRIBER-LICENSE-STATE
"RTN","C0PSUB",38,0)
 ; SUBSCRIBER-USERROLE
"RTN","C0PSUB",39,0)
 ; SUBSCRIBER-USER
"RTN","C0PSUB",40,0)
 ; ACCOUNT-COUNTRY
"RTN","C0PSUB",41,0)
 ; ACCOUNT-ADDRESS-ZIP4
"RTN","C0PSUB",42,0)
 ; LOCATION-COUNTRY
"RTN","C0PSUB",43,0)
 ; REQUESTED-PAGE
"RTN","C0PSUB",44,0)
 D FAMILY(INARY,"SUBCRIBER-FAMILY-NAME",C0PDUZ)
"RTN","C0PSUB",45,0)
 D GIVEN(INARY,"SUBCRIBER-GIVEN-NAME",C0PDUZ)
"RTN","C0PSUB",46,0)
 D MIDDLE(INARY,"SUBCRIBER-MIDDLE-NAME",C0PDUZ)
"RTN","C0PSUB",47,0)
 D PHONEFAX(INARY,C0PLOC) ; SETS "LOCATION-PHONE" AND "LOCATION-FAX"
"RTN","C0PSUB",48,0)
 D ACTPHFAX(INARY,C0PACCT) ;SETS "ACCOUNT-PHONE" AND "ACCOUNT-FAX" 
"RTN","C0PSUB",49,0)
 D GETLOC(INARY,C0PLOC) ;SETS "LOCATION-" VARIABLES (SEE ROUTINE FOR LIST)
"RTN","C0PSUB",50,0)
 D STLIC(INARY,C0PDUZ,C0PACCT) ;LICENSE AND LICENSE STATE
"RTN","C0PSUB",51,0)
 S C0PAF=113059002 ; FILE NUMBER FOR ACCOUNT FILE
"RTN","C0PSUB",52,0)
 S @INARY@("ACCOUNT-PARTNERNAME")=$$GET1^DIQ(C0PAF,C0PACCT_",",3.1) ;
"RTN","C0PSUB",53,0)
 I @INARY@("ACCOUNT-PARTNERNAME")="" S @INARY@("ACCOUNT-PARTNERNAME")="demo"
"RTN","C0PSUB",54,0)
 ; todo: NPs, PAs, assistants need different roles
"RTN","C0PSUB",55,0)
 D SETACCT(INARY,C0PDUZ) ; SET SUBSCRIBER VARIABLES
"RTN","C0PSUB",56,0)
 ;S @INARY@("SUBSCRIBER-USERROLE")="doctor" ; BASE CASE ACCESS
"RTN","C0PSUB",57,0)
 ;S @INARY@("SUBSCRIBER-USER")="LicensedPrescriber" ; BASE CASE ACCESS
"RTN","C0PSUB",58,0)
 S @INARY@("ACCOUNT-COUNTRY")="US" ;BASE CASE ACCESS
"RTN","C0PSUB",59,0)
 S @INARY@("ACCOUNT-ADDRESS-ZIP4")="" ;DON'T HAVE THIS
"RTN","C0PSUB",60,0)
 S @INARY@("LOCATION-COUNTRY")="US" ; NOT IN FILE
"RTN","C0PSUB",61,0)
 S @INARY@("REQUESTED-PAGE")="compose" ; DEFAULT PAG
"RTN","C0PSUB",62,0)
 S @INARY@("ACCOUNT-ACCOUNTID")=$$GET1^DIQ(C0PAF,C0PACCT_",",2.4)
"RTN","C0PSUB",63,0)
 I @INARY@("ACCOUNT-ACCOUNTID")="" S @INARY@("ACCOUNT-ACCOUNTID")="demo"
"RTN","C0PSUB",64,0)
 S @INARY@("ACCOUNT-NAME")=$$GET1^DIQ(C0PAF,C0PACCT_",",3)
"RTN","C0PSUB",65,0)
 I @INARY@("ACCOUNT-NAME")="" S @INARY@("ACCOUNT-NAME")="demo"
"RTN","C0PSUB",66,0)
 S @INARY@("ACCOUNT-PASSWORD")=$$GET1^DIQ(C0PAF,C0PACCT_",",3.2)
"RTN","C0PSUB",67,0)
 I @INARY@("ACCOUNT-PASSWORD")="" S @INARY@("ACCOUNT-PASSWORD")="demo"
"RTN","C0PSUB",68,0)
 ;S @INARY@("SUBSCRIBER-USERTYPE")="Doctor" ; IS RESET LATER
"RTN","C0PSUB",69,0)
 ;S @INARY@("SUBSCRIBER-USERID")="demo" ; IS RESET LATER
"RTN","C0PSUB",70,0)
 ;N NPI S NPI=$$NPI^XUSNPI("Individual_ID",C0PDUZ)
"RTN","C0PSUB",71,0)
 ;S @INARY@("SUBSCRIBER-SID")=+NPI ; FOR NOW
"RTN","C0PSUB",72,0)
 ;
"RTN","C0PSUB",73,0)
 Q
"RTN","C0PSUB",74,0)
 ;
"RTN","C0PSUB",75,0)
ACTPHFAX(RARY,ZACCT) ;SET ACCOUNT PHONE AND FAX FROM ACCOUNT FILE
"RTN","C0PSUB",76,0)
 ; ZACCT IS A POINTER TO THE ACCOUNT FILE
"RTN","C0PSUB",77,0)
 S C0PAF=113059002 ; FILE NUMBER FOR ACCOUNT FILE
"RTN","C0PSUB",78,0)
 S @RARY@("ACCOUNT-PHONE")=$$GET1^DIQ(C0PAF,ZACCT_",",2.2) ;PHONE NUMBER
"RTN","C0PSUB",79,0)
 S @RARY@("ACCOUNT-FAX")=$$GET1^DIQ(C0PAF,ZACCT_",",2.1) ; FAX NUMBER
"RTN","C0PSUB",80,0)
 Q
"RTN","C0PSUB",81,0)
 ;
"RTN","C0PSUB",82,0)
PHONEFAX(RARY,C0PLOC) ; SET LOCATION PHONE AND FAX INTO THE RETURN ARRAY
"RTN","C0PSUB",83,0)
 N PRIORITY,LOCIEN
"RTN","C0PSUB",84,0)
 S PRIORITY=$O(^SC(C0PLOC,"C0P","PRIORITY",""))
"RTN","C0PSUB",85,0)
 I PRIORITY="" W "NO LOCATION PHONE SET",! Q
"RTN","C0PSUB",86,0)
 S LOCIEN=$O(^SC(C0PLOC,"C0P","PRIORITY",PRIORITY,""))
"RTN","C0PSUB",87,0)
 S C0PLOCF=44.113059
"RTN","C0PSUB",88,0)
 S @RARY@("LOCATION-PHONE")=$$GET1^DIQ(C0PLOCF,LOCIEN_","_C0PLOC_",",1)
"RTN","C0PSUB",89,0)
 S @RARY@("LOCATION-FAX")=$$GET1^DIQ(C0PLOCF,LOCIEN_","_C0PLOC_",",2)
"RTN","C0PSUB",90,0)
 Q
"RTN","C0PSUB",91,0)
 ;
"RTN","C0PSUB",92,0)
GETLOC(RARY,ZLOC) ; GETS LOCATIONS VARIABLE FROM POINTER ZLOC
"RTN","C0PSUB",93,0)
 ; TO THE HOSPITAL LOCATION FILE
"RTN","C0PSUB",94,0)
 ; THE LOCATION ADDRESS IS FOUND IN NEW FIELDS IN THE HOSPITAL LOCATION FILE 44
"RTN","C0PSUB",95,0)
 ; IF THESE ARE NULL, THE ADDRESS WILL BE TAKEN FROM THE INSTITUTION FILE,
"RTN","C0PSUB",96,0)
 ; WHICH IS POINTED TO BY THE FILE 44
"RTN","C0PSUB",97,0)
 ; 
"RTN","C0PSUB",98,0)
 S @RARY@("LOCATION-SITEID")="LOCATION_"_ZLOC ; SITE ID
"RTN","C0PSUB",99,0)
 S @RARY@("LOCATION-ADDRESS1")=$$GET1^DIQ(44,ZLOC_",",113059111) ;ADDR1
"RTN","C0PSUB",100,0)
 I @RARY@("LOCATION-ADDRESS1")'="" D  ; ADDRESS PRESENT IN 44
"RTN","C0PSUB",101,0)
 . S @RARY@("LOCATION-ADDRESS2")=$$GET1^DIQ(44,ZLOC_",",113059112) ;ADDR2
"RTN","C0PSUB",102,0)
 . S @RARY@("LOCATION-CITY")=$$GET1^DIQ(44,ZLOC_",",113059114) ;CITY
"RTN","C0PSUB",103,0)
 . S @RARY@("LOCATION-ZIP")=$$GET1^DIQ(44,ZLOC_",",113059116) ;ZIP
"RTN","C0PSUB",104,0)
 . S @RARY@("LOCATION-ZIP4")="" ;NO ZIP4
"RTN","C0PSUB",105,0)
 . N ZJ
"RTN","C0PSUB",106,0)
 . S ZJ=$$GET1^DIQ(44,ZLOC_",",113059115,"I") ;STATE
"RTN","C0PSUB",107,0)
 . S @RARY@("LOCATION-STATE")=$$GET1^DIQ(5,ZJ_",",1) ;STATE ABBREVIATION
"RTN","C0PSUB",108,0)
 E  D  ; TAKE THE ADDRESS FROM THE INSTITUTION FILE
"RTN","C0PSUB",109,0)
 . N ZI
"RTN","C0PSUB",110,0)
 . S ZI=$$GET1^DIQ(44,ZLOC_",",3,"I") ; POINTER TO INSTITUTION FILE
"RTN","C0PSUB",111,0)
 . S @RARY@("LOCATION-ADDRESS1")=$$GET1^DIQ(4,ZI_",",1.01) ;ADDR1
"RTN","C0PSUB",112,0)
 . S @RARY@("LOCATION-ADDRESS2")=$$GET1^DIQ(4,ZI_",",1.02) ;ADDR2
"RTN","C0PSUB",113,0)
 . S @RARY@("LOCATION-CITY")=$$GET1^DIQ(4,ZI_",",1.03) ;CITY
"RTN","C0PSUB",114,0)
 . S @RARY@("LOCATION-ZIP")=$$GET1^DIQ(4,ZI_",",1.04) ;ZIP
"RTN","C0PSUB",115,0)
 . S @RARY@("LOCATION-ZIP4")="" ;NO ZIP4
"RTN","C0PSUB",116,0)
 . N ZJ
"RTN","C0PSUB",117,0)
 . S ZJ=$$GET1^DIQ(4,ZI_",",.02,"I") ;STATE
"RTN","C0PSUB",118,0)
 . S @RARY@("LOCATION-STATE")=$$GET1^DIQ(5,ZJ_",",1) ;STATE ABBREVIATION
"RTN","C0PSUB",119,0)
 Q
"RTN","C0PSUB",120,0)
 ;
"RTN","C0PSUB",121,0)
SUBINIT(C0PDUZ) ; 
"RTN","C0PSUB",122,0)
 ; SUBSCRIPTIONS MULTIPLE IN NEW PERSON
"RTN","C0PSUB",123,0)
 S C0PAF=113059002 ; FILE NUMBER FOR ACCOUNT FILE
"RTN","C0PSUB",124,0)
 S C0PSUBF=200.113059 ; SUBFILE NUMBER OF C0P SUBSCRIPTION MULTIPLE
"RTN","C0PSUB",125,0)
 S C0PSIEN=$O(^VA(200,C0PDUZ,"C0P","B","ERX","")) ; ERX SUBFILE IEN
"RTN","C0PSUB",126,0)
 Q C0PSIEN
"RTN","C0PSUB",127,0)
 ;
"RTN","C0PSUB",128,0)
HASLIC(ZDUZ) ;EXTRINSIC TO CHECK IF PERSON HAS ANY STATE LICENSES
"RTN","C0PSUB",129,0)
 ;
"RTN","C0PSUB",130,0)
 Q ''$O(^VA(200,ZDUZ,"PS1","B",""))
"RTN","C0PSUB",131,0)
 ;
"RTN","C0PSUB",132,0)
GLICST(ZACCT) ;EXTRINSIC WHICH RETURNS THE POINTER TO THE STATE
"RTN","C0PSUB",133,0)
 ;WHICH IS THE PREFERED LICENSE STATE IN THE ACCOUNT PASSED IN ZACCT
"RTN","C0PSUB",134,0)
 S C0PAF=113059002 ; FILE NUMBER FOR ACCOUNT FILE
"RTN","C0PSUB",135,0)
 Q $$GET1^DIQ(C0PAF,ZACCT_",",5,"I")
"RTN","C0PSUB",136,0)
 ;
"RTN","C0PSUB",137,0)
STLIC(ZARY,ZDUZ,ZACCT) ;ADDS SUBSCRIBER-LICENSE AND SUBSCRIBER-LICENSE-STATE
"RTN","C0PSUB",138,0)
 ; TO ZARY, PASSED BY NAME BY LOOKING IN THE STATE LICENSE MULTIPLE
"RTN","C0PSUB",139,0)
 ; OF THE NEW PERSON FILE FOR THE PREFERED STATE AS FOUND BY GLICST ABOVE
"RTN","C0PSUB",140,0)
 ; FROM THE ACCOUNT NUMBER ZACCT
"RTN","C0PSUB",141,0)
 ; IF THE PREFERED STATE IS NOT FOUND, THE FIRST STATE LISTED IS USED
"RTN","C0PSUB",142,0)
 I '$$HASLIC(ZDUZ) D  ; NEW PERSON ZDUZ HAS NO STATE LICENSES DEFINED
"RTN","C0PSUB",143,0)
 . S @ZARY@("SUBSCRIBER-LICENSE")="" ; NULL LICENSE
"RTN","C0PSUB",144,0)
 . S @ZARY@("SUBSCRIBER-LICENSE-STATE")="" ;NULL LICENSE STATE
"RTN","C0PSUB",145,0)
 E  D  ; THERE IS A LICENSE
"RTN","C0PSUB",146,0)
 . N ZST,ZIEN
"RTN","C0PSUB",147,0)
 . S ZST=$$GLICST(ZACCT) ; GET PREFERED LICENSE STATE FROM ACCOUNT FILE
"RTN","C0PSUB",148,0)
 . S ZIEN=$O(^VA(200,ZDUZ,"PS1","B",ZST,"")) ;IEN OF PREFERED STATE
"RTN","C0PSUB",149,0)
 . I ZIEN="" D  ; PREFERED STATE NOT FOUND
"RTN","C0PSUB",150,0)
 . . ; todo: use get1^diq here instead of looping through global
"RTN","C0PSUB",151,0)
 . . S ZST=$O(^VA(200,ZDUZ,"PS1","B","")) ; FIRST STATE IN MULTIPLE
"RTN","C0PSUB",152,0)
 . . S ZIEN=$O(^VA(200,ZDUZ,"PS1","B",ZST,"")) ; IEN OF FIRST STATE
"RTN","C0PSUB",153,0)
 . S @ZARY@("SUBSCRIBER-LICENSE")=$$GET1^DIQ(200.541,ZIEN_","_ZDUZ_",",1) ;LIC
"RTN","C0PSUB",154,0)
 . ; Try this...
"RTN","C0PSUB",155,0)
 . ; N ZG S ZG=$$GET1^DIQ(200.541,ZIEN_","_ZDUZ_",","LICENSING STATE:ABBREVIATION")
"RTN","C0PSUB",156,0)
 . N ZG S ZG=$$GET1^DIQ(200.541,ZIEN_","_ZDUZ_",",.01,"I") ;STATE POINTER
"RTN","C0PSUB",157,0)
 . S ZG=$$GET1^DIQ(5,ZG_",",1) ; STATE ABBREVIATION
"RTN","C0PSUB",158,0)
 . S @ZARY@("SUBSCRIBER-LICENSE-STATE")=ZG
"RTN","C0PSUB",159,0)
 Q
"RTN","C0PSUB",160,0)
FAMILY(RARY,TAG,C0PDUZ) ; SETS @RARY@(TAG) TO FAMILY NAME OF DUZ
"RTN","C0PSUB",161,0)
 ;USING KERNAL ROUTINE IN CCR PACKAGE. RARY IS PASSED BY NAME.
"RTN","C0PSUB",162,0)
 S @RARY@(TAG)=$$FAMILY^C0CVA200(C0PDUZ)
"RTN","C0PSUB",163,0)
 Q
"RTN","C0PSUB",164,0)
 ;
"RTN","C0PSUB",165,0)
GIVEN(RARY,TAG,C0PDUZ) ; SETS @RARY@(TAG) TO GIVEN NAME OF SUBSCRIBER
"RTN","C0PSUB",166,0)
 ; USING KERNAL ROUTINE IN CCR PACKAGE. RARY IS PASSED BY NAME
"RTN","C0PSUB",167,0)
 S @RARY@(TAG)=$$GIVEN^C0CVA200(C0PDUZ)
"RTN","C0PSUB",168,0)
 Q
"RTN","C0PSUB",169,0)
 ;
"RTN","C0PSUB",170,0)
MIDDLE(RARY,TAG,C0PDUZ) ; SETS @RARY@(TAG) TO MIDDLE NAME OF SUBSCRIBER
"RTN","C0PSUB",171,0)
 ; USING KERNAL ROUTINE IN CCR PACKAGE. RARY IS PASSED BY NAME
"RTN","C0PSUB",172,0)
 S @RARY@(TAG)=$$MIDDLE^C0CVA200(C0PDUZ)
"RTN","C0PSUB",173,0)
 Q
"RTN","C0PSUB",174,0)
 ;
"RTN","C0PSUB",175,0)
STATUS(C0PDUZ,SERVICE) ; $$ Private EP - Check Prescriber's ability to use Service
"RTN","C0PSUB",176,0)
 ; FILEMAN USES THIS CALL. Field Status in C0P Subscription Multiple is
"RTN","C0PSUB",177,0)
 ; + a computed field.
"RTN","C0PSUB",178,0)
 ; gpl - changed the order of this Algorithm to do NPI and DEA last
"RTN","C0PSUB",179,0)
 ; because they are not required for all user type and roles
"RTN","C0PSUB",180,0)
 ; Algorithm as follows:
"RTN","C0PSUB",181,0)
 ; 1. Check existence of DEA# or Institutional DEA + VA#
"RTN","C0PSUB",182,0)
 ; 2. Check existence of NPI
"RTN","C0PSUB",183,0)
 ; 3. Check for at least one license in the licensure subfile in 200
"RTN","C0PSUB",184,0)
 ; 4. Check if a C0P Subscription for SERVICE in subfile C0P in 200 exists
"RTN","C0PSUB",185,0)
 ; 5. Check if a C0P Subscription for points to a valid account
"RTN","C0PSUB",186,0)
 ; 6. Check if a C0P Location is defined
"RTN","C0PSUB",187,0)
 ; 7. Make sure that the service is not disabled for the user.
"RTN","C0PSUB",188,0)
 ; 8. Check if the pointed to location has a phone and fax number filled in.
"RTN","C0PSUB",189,0)
 ; -- Output --
"RTN","C0PSUB",190,0)
 ; 1^ACTIVE --> Everything is fine
"RTN","C0PSUB",191,0)
 ; 0^NO DEA^NO NPI^NO LICENSE^NO SUBSCRIPTION^NO SUBSCRIPTION ACCOUNT^
"RTN","C0PSUB",192,0)
 ; + NO SUBSCSRIPTION LOCATION^SUBSCSRIBER IS DISABLED^LOCATION NOT SETUP
"RTN","C0PSUB",193,0)
 N RETURN
"RTN","C0PSUB",194,0)
 S RETURN="0" ; default case
"RTN","C0PSUB",195,0)
 ; --> step 4, see if there's an entry for the service IEN
"RTN","C0PSUB",196,0)
 N C0PVARS
"RTN","C0PSUB",197,0)
 N SERVIEN S SERVIEN=$O(^VA(200,C0PDUZ,"C0P","B",SERVICE,""))
"RTN","C0PSUB",198,0)
 I $L(SERVIEN)=0 S RETURN=RETURN_"^NO SUBSCRIPTION"
"RTN","C0PSUB",199,0)
 D:SERVIEN
"RTN","C0PSUB",200,0)
 . ; --> step 5, see if the service points to a valid account
"RTN","C0PSUB",201,0)
 . N ACCOUNT S ACCOUNT=$$GET1^DIQ(200.113059,SERVIEN_","_C0PDUZ_",",1)
"RTN","C0PSUB",202,0)
 . I $L(ACCOUNT)=0 S RETURN=RETURN_"^NO SUBSCSRIPTION ACCOUNT"
"RTN","C0PSUB",203,0)
 . ; --> step 6, see if the service points to a valid location
"RTN","C0PSUB",204,0)
 . ; internal will return the IEN for use in a call below.
"RTN","C0PSUB",205,0)
 . N LOCATION S LOCATION=$$GET1^DIQ(200.113059,SERVIEN_","_C0PDUZ_",",2,"I")
"RTN","C0PSUB",206,0)
 . I $L(LOCATION)=0 S RETURN=RETURN_"^NO SUBSCSRIPTION LOCATION"
"RTN","C0PSUB",207,0)
 . ; --> step 7, see if the user is disabled from service
"RTN","C0PSUB",208,0)
 . ; Internal will return 1 or 0, 1 for yes
"RTN","C0PSUB",209,0)
 . N DISABLED S DISABLED=$$GET1^DIQ(200.113059,SERVIEN_","_C0PDUZ_",",3,"I")
"RTN","C0PSUB",210,0)
 . I +DISABLED S RETURN=RETURN_"^SUBSCSRIBER IS DISABLED"
"RTN","C0PSUB",211,0)
 . ; --> step 8, see if at least one set of location 
"RTN","C0PSUB",212,0)
 . ; + phone and fax numbers have been set-up
"RTN","C0PSUB",213,0)
 . D:LOCATION
"RTN","C0PSUB",214,0)
 . . N PHONE,FAX,ARY
"RTN","C0PSUB",215,0)
 . . D PHONEFAX("ARY",LOCATION) ; GET THE LOCATION PHONE AND FAX
"RTN","C0PSUB",216,0)
 . . ;S PHONE=$$GET1^DIQ(44.113059,"1,"_LOCATION_",",1) ;this doesn't work
"RTN","C0PSUB",217,0)
 . . ;S FAX=$$GET1^DIQ(44.113059,"1,"_LOCATION_",",2) ; because of the 1
"RTN","C0PSUB",218,0)
 . . S PHONE=$G(ARY("LOCATION-PHONE")) ; PHONE IF ANY
"RTN","C0PSUB",219,0)
 . . S FAX=$G(ARY("LOCATION-FAX")) ; FAX IF ANY
"RTN","C0PSUB",220,0)
 . . I ($L(PHONE)=0)!($L(FAX)=0) S RETURN=RETURN_"^LOCATION NOT SETUP"
"RTN","C0PSUB",221,0)
 . D SETACCT("C0PVARS",C0PDUZ) ; INITIALIZE ARRAY
"RTN","C0PSUB",222,0)
 . ; --> step 1: DEA
"RTN","C0PSUB",223,0)
 . ;N DEA S DEA=$$DEA^XUSER("",C0PDUZ)
"RTN","C0PSUB",224,0)
 . ;I $L(DEA)=0 S RETURN=RETURN_"^NO DEA"
"RTN","C0PSUB",225,0)
 . I C0PVARS("SUBSCRIBER-DEA")="NONE" D  ;
"RTN","C0PSUB",226,0)
 . . I C0PTYPE="P" S RETURN=RETURN_"^NO DEA" ; ONLY PRESCRIBERS NEED DEA
"RTN","C0PSUB",227,0)
 . ; --> step 2: NPI
"RTN","C0PSUB",228,0)
 . ;N NPI S NPI=$$NPI^XUSNPI("Individual_ID",C0PDUZ)
"RTN","C0PSUB",229,0)
 . ;I +NPI<0 S RETURN=RETURN_"^NO NPI"
"RTN","C0PSUB",230,0)
 . I C0PVARS("SUBSCRIBER-NPI")="NONE" D  ;
"RTN","C0PSUB",231,0)
 . . I C0PTYPE="P" S RETURN=RETURN_"^NO NPI" ; ONLY PRESCRIBERS NEED DEA
"RTN","C0PSUB",232,0)
 . ; --> step 3, get first license # in license multiple
"RTN","C0PSUB",233,0)
 . N LIC S LIC=$$HASLIC(C0PDUZ)
"RTN","C0PSUB",234,0)
 . I 'LIC D  ;
"RTN","C0PSUB",235,0)
 . . I (C0PTYPE="P")!(C0PROLE="N") S RETURN=RETURN_"^NO LICENSE" ; 
"RTN","C0PSUB",236,0)
 . . ; PRESCRIBERS AND NURSES NEED LICENSE
"RTN","C0PSUB",237,0)
 ; If Retrun is still 0 and nothing else, then we are good.
"RTN","C0PSUB",238,0)
 I RETURN="0" S RETURN="1^ACTIVE"
"RTN","C0PSUB",239,0)
 QUIT RETURN  ; <-- END $$STATUS
"RTN","C0PSUB",240,0)
 ; 
"RTN","C0PSUB",241,0)
STATUS2 ; Private Procedure for interactive check of status
"RTN","C0PSUB",242,0)
 N DIC,X,Y,DLAYGO,DTOUT,DUOUT
"RTN","C0PSUB",243,0)
 S DIC=200,DIC(0)="AEMQ",DIC("A")="Select New Person: "
"RTN","C0PSUB",244,0)
 D ^DIC
"RTN","C0PSUB",245,0)
 I Y<0 QUIT
"RTN","C0PSUB",246,0)
 N C0PDUZ S C0PDUZ=+Y
"RTN","C0PSUB",247,0)
 ; Then which service are we checking for
"RTN","C0PSUB",248,0)
 ; Grab this from the DD
"RTN","C0PSUB",249,0)
 N DIR,X,Y,DA,DTOUT,DUOUT,DIRUT,DIROUT
"RTN","C0PSUB",250,0)
 S DIR(0)="200.113059,.01"
"RTN","C0PSUB",251,0)
 S DIR("A")="Select Subcription Service"
"RTN","C0PSUB",252,0)
 D ^DIR
"RTN","C0PSUB",253,0)
 I $G(DIRUT) QUIT
"RTN","C0PSUB",254,0)
 N C0PSERV S C0PSERV=Y
"RTN","C0PSUB",255,0)
 N STATUS S STATUS=$$STATUS^C0PSUB(C0PDUZ,C0PSERV)
"RTN","C0PSUB",256,0)
 D EN^DDIOL("Status: "_$TR($P(STATUS,U,2,99),U,", "))
"RTN","C0PSUB",257,0)
 QUIT
"RTN","C0PSUB",258,0)
 ;
"RTN","C0PSUB",259,0)
SETACCT(C0PRTN,C0PDUZ) ; RETURN ALL SUBSCRIBER SETTINGS FOR
"RTN","C0PSUB",260,0)
 ; GENERATING XML AND VERIFYING A COMPLETE SETUP
"RTN","C0PSUB",261,0)
 ; ALSO, INITIALIZE NULL FIELDS WITH DEFAULTS
"RTN","C0PSUB",262,0)
 ; C0PRTN IS PASSED BY NAME
"RTN","C0PSUB",263,0)
 ; C0PSERV IS USUALLY "ERX" FOR EPRESCRIBING
"RTN","C0PSUB",264,0)
 ;
"RTN","C0PSUB",265,0)
 ;USER TYPE
"RTN","C0PSUB",266,0)
 ;
"RTN","C0PSUB",267,0)
 ;P LicensedPrescriber
"RTN","C0PSUB",268,0)
 ;S Staff
"RTN","C0PSUB",269,0)
 ;M MidlevelPrescriber
"RTN","C0PSUB",270,0)
 ;V SupervisingDoctor 
"RTN","C0PSUB",271,0)
 ;
"RTN","C0PSUB",272,0)
 ;USER ROLE
"RTN","C0PSUB",273,0)
 ;
"RTN","C0PSUB",274,0)
 ;D doctor
"RTN","C0PSUB",275,0)
 ;N nurse
"RTN","C0PSUB",276,0)
 ;A admin
"RTN","C0PSUB",277,0)
 ;M manager
"RTN","C0PSUB",278,0)
 ;SD supervisingDoctor
"RTN","C0PSUB",279,0)
 ;MP midlevelPrescriber      
"RTN","C0PSUB",280,0)
 ;
"RTN","C0PSUB",281,0)
 ;Requested Page
"RTN","C0PSUB",282,0)
 ;
"RTN","C0PSUB",283,0)
 ;C compose
"RTN","C0PSUB",284,0)
 ;A admin
"RTN","C0PSUB",285,0)
 ;M manager
"RTN","C0PSUB",286,0)
 ;S status
"RTN","C0PSUB",287,0)
 ;ME medentry
"RTN","C0PSUB",288,0)
 ;P patientDetail
"RTN","C0PSUB",289,0)
 ;H maintainHealthplans
"RTN","C0PSUB",290,0)
 ;R reports-rx-daily    
"RTN","C0PSUB",291,0)
 ;
"RTN","C0PSUB",292,0)
 N ZI,ZJ
"RTN","C0PSUB",293,0)
 D SETUP^C0PMAIN() ; INITIALIZE VARIABLES
"RTN","C0PSUB",294,0)
 I ERXSERVIEN="" Q  ; PERSON NOT SUBSCRIBED
"RTN","C0PSUB",295,0)
 S C0PTYPE=$$GET1^DIQ($$F200C0P^C0PMAIN(),ERXSERVIEN_","_C0PDUZ_",",4,"I")
"RTN","C0PSUB",296,0)
 S C0PROLE=$$GET1^DIQ($$F200C0P^C0PMAIN(),ERXSERVIEN_","_C0PDUZ_",",4.1,"I")
"RTN","C0PSUB",297,0)
 S C0PPAGE=$$GET1^DIQ($$F200C0P^C0PMAIN(),ERXSERVIEN_","_C0PDUZ_",",4.2,"I")
"RTN","C0PSUB",298,0)
 N C0PSV ; SUPERVISING DOCTOR DUZ
"RTN","C0PSUB",299,0)
 S C0PSV=$$GET1^DIQ($$F200C0P^C0PMAIN(),ERXSERVIEN_","_C0PDUZ_",",6,"I")
"RTN","C0PSUB",300,0)
 ; FIELD 6 IS SUPERVISING DOCTOR. USED FOR MIDLEVEL RENEWAL PROCESSING
"RTN","C0PSUB",301,0)
 I $G(C0PSV)'="" D  ; IF THERE IS A SUPERVISING DOCTOR
"RTN","C0PSUB",302,0)
 . S @C0PRTN@("SUPERVISING-DOCTOR-DUZ")=C0PSV ; RECORD FOR LATER USE
"RTN","C0PSUB",303,0)
 I C0PTYPE="" D  ; SUBSCRIBER TYPE NOT SET
"RTN","C0PSUB",304,0)
 . I C0PROLE="N" S C0PTYPE="S" ; DEFAULT FOR NURSE IS STAFF
"RTN","C0PSUB",305,0)
 . E  S C0PTYPE="P" ; ELSE DEFAULT TYPE IS LICENSEDPRESCRIBER
"RTN","C0PSUB",306,0)
 . K C0PFDA
"RTN","C0PSUB",307,0)
 . S C0PFDA($$F200C0P^C0PMAIN,ERXSERVIEN_","_C0PDUZ_",",4)=C0PTYPE ;SET TYPE
"RTN","C0PSUB",308,0)
 . D UPDIE ; SET THE SUBSCRIBER TYPE
"RTN","C0PSUB",309,0)
 I C0PROLE="" D  ; SUBSCRIBER ROLE NOT SET
"RTN","C0PSUB",310,0)
 . I C0PTYPE="P" S C0PROLE="D" ; DOCTOR IS DEFAULT FOR LICENSED PRESCRIBER
"RTN","C0PSUB",311,0)
 . E  S C0PROLE="N" ; ALL OTHERS SET TO NURSE
"RTN","C0PSUB",312,0)
 . K C0PFDA
"RTN","C0PSUB",313,0)
 . S C0PFDA($$F200C0P^C0PMAIN,ERXSERVIEN_","_C0PDUZ_",",4.1)=C0PROLE ;SET ROLE
"RTN","C0PSUB",314,0)
 . D UPDIE ; SET THE SUBSCRIBER ROLE
"RTN","C0PSUB",315,0)
 I C0PPAGE="" D  ;
"RTN","C0PSUB",316,0)
 . I C0PTYPE="P" S C0PPAGE="C" ; PRESCRIBERS TO COMPOSE PAGE
"RTN","C0PSUB",317,0)
 . E  S C0PPAGE="P" ; ALL OTHERS DEFAULT TO PATIENT DETAIL PAGE
"RTN","C0PSUB",318,0)
 . K C0PFDA
"RTN","C0PSUB",319,0)
 . S C0PFDA($$F200C0P^C0PMAIN,ERXSERVIEN_","_C0PDUZ_",",4.2)=C0PPAGE ;SET PAGE
"RTN","C0PSUB",320,0)
 . D UPDIE ; SET THE REQUESTED PAGE
"RTN","C0PSUB",321,0)
 N ZF S ZF=$$F200C0P^C0PMAIN()
"RTN","C0PSUB",322,0)
 S @C0PRTN@("REQUESTED-PAGE")=$$GET1^DIQ(ZF,ERXSERVIEN_","_C0PDUZ_",",4.2)
"RTN","C0PSUB",323,0)
 S @C0PRTN@("SUBSCRIBER-USERROLE")=$$GET1^DIQ(ZF,ERXSERVIEN_","_C0PDUZ_",",4.1)
"RTN","C0PSUB",324,0)
 S @C0PRTN@("SUBSCRIBER-USERTYPE")=$$GET1^DIQ(ZF,ERXSERVIEN_","_C0PDUZ_",",4)
"RTN","C0PSUB",325,0)
 S C0PSID=$$GET1^DIQ(ZF,ERXSERVIEN_","_C0PDUZ_",",5)
"RTN","C0PSUB",326,0)
 I C0PSID="" D  ; SUBSCRIBER ID NOT SET
"RTN","C0PSUB",327,0)
 . S C0PSID=$$UUID^C0CUTIL ; SET TO RANDOM UUID
"RTN","C0PSUB",328,0)
 . K C0PFDA
"RTN","C0PSUB",329,0)
 . S C0PFDA($$F200C0P^C0PMAIN,ERXSERVIEN_","_C0PDUZ_",",5)=C0PSID ;SET SID
"RTN","C0PSUB",330,0)
 . D UPDIE ; SET SUBSCRIBER ID
"RTN","C0PSUB",331,0)
 N NPI S NPI=+$$NPI^XUSNPI("Individual_ID",C0PDUZ)
"RTN","C0PSUB",332,0)
 I NPI=-1 S NPI="NONE"
"RTN","C0PSUB",333,0)
 S @C0PRTN@("SUBSCRIBER-NPI")=NPI
"RTN","C0PSUB",334,0)
 N DEA S DEA=$$DEA^XUSER("",C0PDUZ)
"RTN","C0PSUB",335,0)
 I $L(DEA)=0 S DEA="NONE"
"RTN","C0PSUB",336,0)
 S @C0PRTN@("SUBSCRIBER-DEA")=DEA
"RTN","C0PSUB",337,0)
 ;N C0PNPIF ; NPI FOR SID LEGACY FLAG - DON'T NEW THIS, IT'S NEEDED LATER
"RTN","C0PSUB",338,0)
 S C0PNPIF=$$GET1^DIQ(C0PAF,C0PACCT_",",8,"I") ; LEGACY FLAG TO USE NPI FOR SID
"RTN","C0PSUB",339,0)
 I C0PNPIF'=1 S @C0PRTN@("SUBSCRIBER-SID")=C0PSID ; IF NO FLAG, USE GUID
"RTN","C0PSUB",340,0)
 E  D  ; IF LEGACY FLAG IS ON, USE NPI FOR SID
"RTN","C0PSUB",341,0)
 . S @C0PRTN@("SUBSCRIBER-SID")=NPI
"RTN","C0PSUB",342,0)
 . I NPI="NONE" S @C0PRTN@("SUBSCRIBER-SID")="USER"_C0PDUZ ; IF NO NPI
"RTN","C0PSUB",343,0)
 Q
"RTN","C0PSUB",344,0)
 ; 
"RTN","C0PSUB",345,0)
UPDIE   ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
"RTN","C0PSUB",346,0)
 K ZERR
"RTN","C0PSUB",347,0)
 D CLEAN^DILF
"RTN","C0PSUB",348,0)
 D UPDATE^DIE("","C0PFDA","","ZERR")
"RTN","C0PSUB",349,0)
 I $D(ZERR) D ERROR^C0PMAIN(",U113059008,",$ST($ST,"PLACE"),"ERX-UPDIE-FAIL","Fileman Data Update Failure") QUIT
"RTN","C0PSUB",350,0)
 K C0PFDA
"RTN","C0PSUB",351,0)
 Q
"RTN","C0PTRXN")
0^21^B112380604
"RTN","C0PTRXN",1,0)
C0PTRXN   ; ERX/GPL - Med file eRx analysis routines ; 7/10/10 ; 5/9/12 12:13am
"RTN","C0PTRXN",2,0)
 ;;1.0;C0P;;Apr 25, 2012;Build 103
"RTN","C0PTRXN",3,0)
 ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"RTN","C0PTRXN",4,0)
 ;General Public License See attached copy of the License.
"RTN","C0PTRXN",5,0)
 ;
"RTN","C0PTRXN",6,0)
 ;This program is free software; you can redistribute it and/or modify
"RTN","C0PTRXN",7,0)
 ;it under the terms of the GNU General Public License as published by
"RTN","C0PTRXN",8,0)
 ;the Free Software Foundation; either version 2 of the License, or
"RTN","C0PTRXN",9,0)
 ;(at your option) any later version.
"RTN","C0PTRXN",10,0)
 ;
"RTN","C0PTRXN",11,0)
 ;This program is distributed in the hope that it will be useful,
"RTN","C0PTRXN",12,0)
 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0PTRXN",13,0)
 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"RTN","C0PTRXN",14,0)
 ;GNU General Public License for more details.
"RTN","C0PTRXN",15,0)
 ;
"RTN","C0PTRXN",16,0)
 ;You should have received a copy of the GNU General Public License along
"RTN","C0PTRXN",17,0)
 ;with this program; if not, write to the Free Software Foundation, Inc.,
"RTN","C0PTRXN",18,0)
 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
"RTN","C0PTRXN",19,0)
 ;
"RTN","C0PTRXN",20,0)
 Q
"RTN","C0PTRXN",21,0)
 ;
"RTN","C0PTRXN",22,0)
 ; gpl 7/2010 - these routines are to test the Drug file mappings 
"RTN","C0PTRXN",23,0)
 ; to see how well they will work for eRx. None of this code is needed
"RTN","C0PTRXN",24,0)
 ; for operation of the eRx Package. It is for analysis, debugging and future
"RTN","C0PTRXN",25,0)
 ; development
"RTN","C0PTRXN",26,0)
 ;
"RTN","C0PTRXN",27,0)
FDBFN() Q 1130590010 ; First Databank Drugs file number
"RTN","C0PTRXN",28,0)
RXNFN() Q 1130590011.001 ; RxNorm Concepts file number
"RTN","C0PTRXN",29,0)
T1 ; TEST1
"RTN","C0PTRXN",30,0)
 N ZI
"RTN","C0PTRXN",31,0)
 S ZI=""
"RTN","C0PTRXN",32,0)
 F  S ZI=$O(^C0P("FDB","B",ZI)) Q:ZI=""  D  ;
"RTN","C0PTRXN",33,0)
 . N ZGCN,ZRXNCUI,ZNAME,ZVAIEN,ZDRUGIEN
"RTN","C0PTRXN",34,0)
 . S (ZGCN,ZRXNCUI,ZNAME,ZVAIEN,ZDRUGIEN)=""
"RTN","C0PTRXN",35,0)
 . S ZGCN=$$GCN^C0PLKUP(ZI)
"RTN","C0PTRXN",36,0)
 . S ZRXNCUI=$$RXNCUI^C0PLKUP(ZGCN)
"RTN","C0PTRXN",37,0)
 . I ZRXNCUI'="" S ZVUID=$$VUID^C0PLKUP(ZRXNCUI)
"RTN","C0PTRXN",38,0)
 . E  S ZRXNCUI="NONE"
"RTN","C0PTRXN",39,0)
 . S ZNAME=$$FULLNAME^C0PLKUP(ZI)
"RTN","C0PTRXN",40,0)
 . I ZVUID'="" S ZVAIEN=$$VAPROD^C0PLKUP(ZVUID)
"RTN","C0PTRXN",41,0)
 . I ZVAIEN'="" S ZDRUGIEN=$$DRUG^C0PLKUP(ZVAIEN)
"RTN","C0PTRXN",42,0)
 . E  S ZDRUGIEN="N/A"
"RTN","C0PTRXN",43,0)
 . W !,ZI," ",ZGCN," ",ZRXNCUI," ",ZVUID," ",ZVAIEN," ",ZDRUGIEN," ",ZNAME
"RTN","C0PTRXN",44,0)
 Q
"RTN","C0PTRXN",45,0)
 ; OK, T1 IS JUST SOME EXPLORITORY WORK. TIME TO GET ORGANIZED
"RTN","C0PTRXN",46,0)
 ;
"RTN","C0PTRXN",47,0)
TEST ;
"RTN","C0PTRXN",48,0)
 ;
"RTN","C0PTRXN",49,0)
 S GARY=$NA(^TMP("C0PRXN","TYPE2"))
"RTN","C0PTRXN",50,0)
 S GOUT=$NA(^TMP("C0POUT"))
"RTN","C0PTRXN",51,0)
 K @GOUT
"RTN","C0PTRXN",52,0)
 D RNF2CSV^C0CRNF(GOUT,GARY,"VN") ; TURN TYPE 2 INTO A CSV 
"RTN","C0PTRXN",53,0)
 D FILEOUT^C0CRNF(GOUT,"TYPE2_TEST.csv")
"RTN","C0PTRXN",54,0)
 Q
"RTN","C0PTRXN",55,0)
 ;
"RTN","C0PTRXN",56,0)
INDEX2 ; ADD AN INDEX TO TYPE2 DRUGS OF THE VUID
"RTN","C0PTRXN",57,0)
 ; FOR USE IN FINDING THE CURRENT VA->FDB MAPPING STATUS
"RTN","C0PTRXN",58,0)
 N ZI S ZI=""
"RTN","C0PTRXN",59,0)
 N ZBASE
"RTN","C0PTRXN",60,0)
 S ZBASE=$NA(^TMP("C0PRXN","TYPE2","V")) ; TYPE2 DRUGS ARE HERE
"RTN","C0PTRXN",61,0)
 S ZINDEX=$NA(^TMP("C0PRXN","TYPE2","INDEX")) ; PUT THE INDEX HERE
"RTN","C0PTRXN",62,0)
 F  S ZI=$O(@ZBASE@(ZI)) Q:ZI=""  D  ;
"RTN","C0PTRXN",63,0)
 . N ZVUIDS,ZVUID
"RTN","C0PTRXN",64,0)
 . S ZVUIDS=@ZBASE@(ZI,"VUID",1) ; LIST OF VUIDS ^ SEPARATED
"RTN","C0PTRXN",65,0)
 . N ZN S ZN=@ZBASE@(ZI,"VANAME",1)_"^"_@ZBASE@(ZI,"FDBNAME",1)
"RTN","C0PTRXN",66,0)
 . I ZVUIDS["^" D  ;
"RTN","C0PTRXN",67,0)
 . . N ZJ S ZJ=""
"RTN","C0PTRXN",68,0)
 . . F  S ZJ=$P(ZVUIDS,"^",1) Q:ZJ=""  D  ; FOR EACH VUID
"RTN","C0PTRXN",69,0)
 . . . S ZVUID(ZJ)=ZN ;SET INDEX TO NAME
"RTN","C0PTRXN",70,0)
 . . . S ZVUIDS=$P(ZVUIDS,"^",2) ; DROP THE FIRST IN THE LIST
"RTN","C0PTRXN",71,0)
 . E  S ZVUID(ZVUIDS)=ZN ;SET INDEX TO VA NAME
"RTN","C0PTRXN",72,0)
 . S ZJ=""
"RTN","C0PTRXN",73,0)
 . F  S ZJ=$O(ZVUID(ZJ)) Q:ZJ=""  D  ; FOR EACH VUID
"RTN","C0PTRXN",74,0)
 . . ;S @ZINDEX@(ZJ,ZI)=ZVUID(ZJ) ;SET THE INDEX
"RTN","C0PTRXN",75,0)
 . . W !,$NA(@ZINDEX@(ZJ,ZI))_"="_ZVUID(ZJ) ;SET THE INDEX
"RTN","C0PTRXN",76,0)
 Q
"RTN","C0PTRXN",77,0)
EN ; ENTRY POINT TO CREATE THE ERX DRUG ANALYSIS SPREADSHEETS
"RTN","C0PTRXN",78,0)
 ; SEE BELOW FOR DOCUMENTATION
"RTN","C0PTRXN",79,0)
 N GARY
"RTN","C0PTRXN",80,0)
 S GARY=$NA(^TMP("C0PRXN","ALL")) ; PLACE TO PUT THE ENTIRE ARRAY
"RTN","C0PTRXN",81,0)
 K @GARY
"RTN","C0PTRXN",82,0)
 D BLDARY(GARY) ; BUILD THE ENTIRE ARRAY
"RTN","C0PTRXN",83,0)
 D IDXARY(GARY) ; INDEX THE ARRAY BY TYPE AND DRUG NAME
"RTN","C0PTRXN",84,0)
 D TYPES
"RTN","C0PTRXN",85,0)
 Q
"RTN","C0PTRXN",86,0)
 ;
"RTN","C0PTRXN",87,0)
TYPES ; BUILD AN ARRAY FOR EACH TYPE
"RTN","C0PTRXN",88,0)
 I '$D(GARY) S GARY=$NA(^TMP("C0PRXN","ALL"))
"RTN","C0PTRXN",89,0)
 N C0PN,ZTYPE
"RTN","C0PTRXN",90,0)
 F C0PN=1:1:4 D  ; FOR EACH ANALYSIS TYPE
"RTN","C0PTRXN",91,0)
 . S ZTYPE=$NA(^TMP("C0PRXN","TYPE"_C0PN))
"RTN","C0PTRXN",92,0)
 . K @ZTYPE
"RTN","C0PTRXN",93,0)
 . D BLDTYPE(GARY,ZTYPE,C0PN) ; BUILD AN EXTRACTED ARRAY ACCORDING TO TYPE
"RTN","C0PTRXN",94,0)
 . S GOUT=$NA(^TMP("C0POUT"))
"RTN","C0PTRXN",95,0)
 . K @GOUT
"RTN","C0PTRXN",96,0)
 . D RNF2CSV^C0CRNF(GOUT,ZTYPE,"VN") ; TURN TYPE 2 INTO A CSV 
"RTN","C0PTRXN",97,0)
 . W !
"RTN","C0PTRXN",98,0)
 . D FILEOUT^C0CRNF(GOUT,"eRx_mapping__Type"_C0PN_".csv")
"RTN","C0PTRXN",99,0)
 Q
"RTN","C0PTRXN",100,0)
 ;
"RTN","C0PTRXN",101,0)
IDXARY(INARY) ; INDEX THE ARRAY BY TYPE AND NAME
"RTN","C0PTRXN",102,0)
 ;
"RTN","C0PTRXN",103,0)
 N ZI
"RTN","C0PTRXN",104,0)
 S ZI=""
"RTN","C0PTRXN",105,0)
 F  S ZI=$O(@INARY@("V",ZI)) Q:ZI=""  D  ; FOR EACH ELEMENT OF THE ARRAY
"RTN","C0PTRXN",106,0)
 . S @INARY@("INDEX",@INARY@("V",ZI,"TYPE"),@INARY@("V",ZI,"FDBNAME"),ZI)=""
"RTN","C0PTRXN",107,0)
 D COUNT
"RTN","C0PTRXN",108,0)
 Q
"RTN","C0PTRXN",109,0)
 ;
"RTN","C0PTRXN",110,0)
COUNT ; COUNT AND REPORT HOW MANY ARE IN EACH TYPE
"RTN","C0PTRXN",111,0)
 I '$D(INARY) S INARY=$NA(^TMP("C0PRXN","ALL"))
"RTN","C0PTRXN",112,0)
 N ZN,ZI,ZJ,ZCOUNT
"RTN","C0PTRXN",113,0)
 S ZN=""
"RTN","C0PTRXN",114,0)
 F  S ZN=$O(@INARY@("INDEX",ZN)) Q:ZN=""  D  ; FOR EACH TYPE
"RTN","C0PTRXN",115,0)
 . S ZCOUNT=0
"RTN","C0PTRXN",116,0)
 . S ZI=""
"RTN","C0PTRXN",117,0)
 . F  S ZI=$O(@INARY@("INDEX",ZN,ZI)) Q:ZI=""  D  ; FOR EACH INDEX ENTRY
"RTN","C0PTRXN",118,0)
 . . S ZCOUNT=ZCOUNT+1
"RTN","C0PTRXN",119,0)
 . W !,"COUNT FOR TYPE "_ZN_" = "_ZCOUNT
"RTN","C0PTRXN",120,0)
 Q
"RTN","C0PTRXN",121,0)
 ;
"RTN","C0PTRXN",122,0)
BLDTYPE(INARY,OARY,ITYPE) ; EXTRACT A TYPE ARRAY
"RTN","C0PTRXN",123,0)
 ;
"RTN","C0PTRXN",124,0)
 N C0PI,C0PJ
"RTN","C0PTRXN",125,0)
 S C0PI=""
"RTN","C0PTRXN",126,0)
 F  S C0PI=$O(@INARY@("INDEX",ITYPE,C0PI)) Q:C0PI=""  D  ; FOR EACH OF TYPE
"RTN","C0PTRXN",127,0)
 . S C0PJ=$O(@INARY@("INDEX",ITYPE,C0PI,"")) ; SET RECORD NUMBER
"RTN","C0PTRXN",128,0)
 . N C0PROW
"RTN","C0PTRXN",129,0)
 . M C0PROW=@INARY@("V",C0PJ) ; CONTENTS OF ROW
"RTN","C0PTRXN",130,0)
 . D RNF1TO2B^C0CRNF(OARY,"C0PROW") ; USING THE "B" VERSION TO BE ABLE TO
"RTN","C0PTRXN",131,0)
 . ; TO CONVERT TO A CSV
"RTN","C0PTRXN",132,0)
 Q
"RTN","C0PTRXN",133,0)
 ;
"RTN","C0PTRXN",134,0)
BLDARY(ZARY) ; BUILDS AN RNF2 ARRAY; ZARY IS PASSED BY NAME 
"RTN","C0PTRXN",135,0)
 ; (SEE C0CRNF.m FOR DOCUMENTATION OF RNF2 FORMAT)
"RTN","C0PTRXN",136,0)
 ; 
"RTN","C0PTRXN",137,0)
 ; FIRST DATA BANK DRUGS ARE MATCHED TO VISTA DRUGS THROUGH A MULTI-STEP
"RTN","C0PTRXN",138,0)
 ; PROCESS. THE MEDID IS THE FIRST DATA BANK NUMBER USED TO REFER TO THEIR
"RTN","C0PTRXN",139,0)
 ; DRUGS. EACH MEDID HAS A GCN (GENERIC CODE NUMBER) WHICH CAN BE USED TO
"RTN","C0PTRXN",140,0)
 ; LOOK UP THE DRUG IN THE RXNORM UMLS DATABASE. THE GCN IS USED TO FIND
"RTN","C0PTRXN",141,0)
 ; THE RXNORM CONCEPT NUMBER (RXNCUI). THE RXNCUI IS USED TO FIND THE VUID
"RTN","C0PTRXN",142,0)
 ; USING THE RXNORM UMLS DATABASE. THE VUID IS USED TO FIND THE IEN OF THE
"RTN","C0PTRXN",143,0)
 ; DRUG IN THE VA PRODUCTS FILE (ALSO KNOWN AS THE NDF - NATIONAL DRUG FILE).
"RTN","C0PTRXN",144,0)
 ; THE VAPROD IEN IS THEN USED TO LOOK UP THE DRUG IN THE VA DRUG FILE
"RTN","C0PTRXN",145,0)
 ; (FILE 50) USING A NEW CROSS REFERENCE (AC0P) CREATED FOR THIS PURPOSE.
"RTN","C0PTRXN",146,0)
 ; THE RESULT OF THIS CHAIN IS A DRUG MAPPED FROM THE FDB MEDID TO A
"RTN","C0PTRXN",147,0)
 ; VA DRUG FILE IEN. TO SUMMARIZE:
"RTN","C0PTRXN",148,0)
 ; 
"RTN","C0PTRXN",149,0)
 ; MEDID->GCN->RXNCUI->VUID->VAPROD->DRUGIEN
"RTN","C0PTRXN",150,0)
 ;
"RTN","C0PTRXN",151,0)
 ; (NOTE: THIS PROCESS WILL CHANGE - BE IMPROVED - WHEN THE VERIFIED 
"RTN","C0PTRXN",152,0)
 ; MEDID->RXNORM MAPPING BECOMES AVAILABLE. THIS ANALYSIS WILL ESTABLISH
"RTN","C0PTRXN",153,0)
 ; A BASELINE WITH WHICH TO COMPARE THE RESULT OF USING THAT MAPPING)
"RTN","C0PTRXN",154,0)
 ;
"RTN","C0PTRXN",155,0)
 ; (THE PROCESS IS ACTUALLY MORE COMPLEX THAT THIS, BECAUSE WE ALSO TRY
"RTN","C0PTRXN",156,0)
 ; AND MATCH DRUGS BY LOOKING AT THEIR CHEMICAL COMPONENTS BUT THIS ANALYSIS
"RTN","C0PTRXN",157,0)
 ; IGNORES THIS MORE COMPLEX PROCESS.)
"RTN","C0PTRXN",158,0)
 ; 
"RTN","C0PTRXN",159,0)
 ; NOT ALL DRUGS MAKE IT ALL THE WAY THROUGH THIS MAPPING. IN ADDITION, THERE
"RTN","C0PTRXN",160,0)
 ; MAY BE DRUGS THAT ARE IN THE DRUG FILE THAT ARE NOT IN THE FDB FILE
"RTN","C0PTRXN",161,0)
 ; THIS ROUTINE WILL CREATE A SPREADSHEET THAT WILL SHOW THE UNMAPPED DRUGS
"RTN","C0PTRXN",162,0)
 ; IN BOTH DIRECTIONS (MEDID->...>DRUGIEN AND DRUGIEN->...>MEDID)
"RTN","C0PTRXN",163,0)
 ; IT WILL ALSO SHOW THE DRUG NAME AS IT APPEARS IN FIRST DATA BANK
"RTN","C0PTRXN",164,0)
 ; AND THE NAME THAT WILL BE USED FOR THAT DRUG IN VISTA (ERX). OFTEN
"RTN","C0PTRXN",165,0)
 ; THEY WILL BE DIFFERENT. IF THE FDB DRUG IS NOT A GENERIC, THE GENERIC NAME
"RTN","C0PTRXN",166,0)
 ; WILL BY USED BY ERX TO LIST THE DRUG IN THE PATIENT'S DRUG LIST IN VISTA
"RTN","C0PTRXN",167,0)
 ;
"RTN","C0PTRXN",168,0)
 ; WE ARE GOING TO ORGANIZE AN ARRAY WITH DRUGS BY TYPE. HERE ARE THE TYPES:
"RTN","C0PTRXN",169,0)
 ; 
"RTN","C0PTRXN",170,0)
 ; TYPE 1 - FDB DRUGS THAT MAP EXACTLY TO THE DRUG FILE, WITH NAMES THAT
"RTN","C0PTRXN",171,0)
 ;  MATCH EXACTLY
"RTN","C0PTRXN",172,0)
 ;
"RTN","C0PTRXN",173,0)
 ; TYPE 2 - FDB DRUGS THAT MAP TO THE DRUG FILE, BUT WITH DIFFERENT NAMES.
"RTN","C0PTRXN",174,0)
 ;  THIS CATEGORY INCLUDES DRUGS THAT ARE SHOWN IN VISTA AS GENERICS BUT
"RTN","C0PTRXN",175,0)
 ;  ON FDB AS BRAND NAME DRUGS
"RTN","C0PTRXN",176,0)
 ; 
"RTN","C0PTRXN",177,0)
 ; TYPE 3 - FDB DRUGS THAT DO NOT MAP TO THE DRUG FILE, BUT DO MAP TO THE
"RTN","C0PTRXN",178,0)
 ;  VA PRODUCT FILE (NDF). IF ANY OF THESE DRUGS MIGHT BE ORDERED VIA ERX,
"RTN","C0PTRXN",179,0)
 ;  IT MIGHT BE A GOOD IDEA TO ADD THEM TO THE DRUG FILE.
"RTN","C0PTRXN",180,0)
 ; NOTE: FOR TYPE 3 AND ABOVE DRUGS, ERX WILL STILL FUNCTION PROPERLY BUT
"RTN","C0PTRXN",181,0)
 ; INSTEAD OF MAPPING THE DRUG TO THE DRUG FILE, WILL MAP IT AS A FREE TEXT
"RTN","C0PTRXN",182,0)
 ; DRUG AND WILL SEND A MAIL MESSAGE ABOUT THE MAPPING ERROR SO THAT THE
"RTN","C0PTRXN",183,0)
 ; DRUG CAN BE CONSIDERED FOR ADDING TO THE DRUG FILE
"RTN","C0PTRXN",184,0)
 ; 
"RTN","C0PTRXN",185,0)
 ; TYPE 4 - FDB DRUGS THAT DO NOT MAP TO THE DRUG FILE AND ARE ALSO NOT
"RTN","C0PTRXN",186,0)
 ;  FOUND IN THE NDF. THIS MIGHT BE THE CASE FOR NEWER DRUGS. ERX WILL
"RTN","C0PTRXN",187,0)
 ;  STILL FUNCTION, BUT THESE WILL BE FREE TEXT DRUGS. THE REMEDY IS AN
"RTN","C0PTRXN",188,0)
 ;  UPDATE FROM THE VA OF THE NDF OR ADDING THE DRUGS TO THE NDF AND THE
"RTN","C0PTRXN",189,0)
 ;  DRUG FILE. (THERE ARE COMPLEXITIES IN ADDING DRUGS TO THE NDF BECAUSE
"RTN","C0PTRXN",190,0)
 ;  OF HOW TO THEN HANDLE AN UPDATE FROM THE VA)
"RTN","C0PTRXN",191,0)
 ;
"RTN","C0PTRXN",192,0)
 ; TYPE 5 - DRUGS IN THE DRUG FILE THAT ARE NOT FOUND IN THE FDB DRUG DATABASE
"RTN","C0PTRXN",193,0)
 ;  MAPPING. THIS MIGHT INCLUDE BRAND NAME DRUGS IN THE DRUG FILE THAT HAVE
"RTN","C0PTRXN",194,0)
 ;  BEEN MAPPED TO GENERICS WHEN COMING FROM FDB. IN ANY CASE, THESE ARE DRUGS
"RTN","C0PTRXN",195,0)
 ;  FOR WHICH THERE IS NO PATH TO MAP FROM THEM TO FDB. (REDUCING THE NUMBER
"RTN","C0PTRXN",196,0)
 ;  OF DRUGS IN THIS TYPE TO ZERO WILL BE A GOAL BEFORE IMPLEMENTING PHASE II
"RTN","C0PTRXN",197,0)
 ;  OF ERX WHERE DRUGS WILL BE ORDERED ON VISTA AND SENT TO THE ERX 
"RTN","C0PTRXN",198,0)
 ;  SERVICE.
"RTN","C0PTRXN",199,0)
 ;
"RTN","C0PTRXN",200,0)
 N ZI
"RTN","C0PTRXN",201,0)
 S ZI=""
"RTN","C0PTRXN",202,0)
 F  S ZI=$O(^C0P("FDB","B",ZI)) Q:ZI=""  D  ;
"RTN","C0PTRXN",203,0)
 . N ZGCN,ZRXNCUI,ZNAME,ZVAIEN,ZDRUGIEN,ZROW,ZIEN,ZVANAME
"RTN","C0PTRXN",204,0)
 . S (ZGCN,ZRXNCUI,ZNAME,ZVAIEN,ZDRUGIEN,ZVANAME)=""
"RTN","C0PTRXN",205,0)
 . S ZROW("MEDID")=ZI ; FDB MEDID
"RTN","C0PTRXN",206,0)
 . S ZIEN=$O(^C0P("FDB","B",ZI,"")) ; IEN OF THE FDB MED
"RTN","C0PTRXN",207,0)
 . S ZROW("FDBNAME")=$$FULLNAME^C0PLKUP(ZI) ; FDB MED NAME
"RTN","C0PTRXN",208,0)
 . S ZGCN=$$GCN^C0PLKUP(ZI)
"RTN","C0PTRXN",209,0)
 . I ZGCN=0 D  Q  ; NO GCN, CAN'T MAP 
"RTN","C0PTRXN",210,0)
 . . S ZROW("TYPE")=4
"RTN","C0PTRXN",211,0)
 . . D RNF1TO2^C0CRNF(ZARY,"ZROW")
"RTN","C0PTRXN",212,0)
 . S ZROW("GCN")=ZGCN
"RTN","C0PTRXN",213,0)
 . S ZRXNCUI=$$RXNCUI^C0PLKUP(ZGCN) ; RETRIEVE THE RXNORM CONCEPT ID
"RTN","C0PTRXN",214,0)
 . I ZRXNCUI="" W !,"ERROR, NO RXNCUI "_ZGCN D ERROR^C0PMAIN(",U113059009,",$ST($ST,"PLACE"),"ERX-INVALID-DATA","Invalid Data") QUIT
"RTN","C0PTRXN",215,0)
 . S ZROW("RXNCUI")=ZRXNCUI
"RTN","C0PTRXN",216,0)
 . S ZVUID=$$VUID^C0PLKUP(ZRXNCUI) ; FETCH THE VUID
"RTN","C0PTRXN",217,0)
 . I ZVUID="" D  Q  ; NO VUID FOUND
"RTN","C0PTRXN",218,0)
 . . S ZROW("TYPE")=4
"RTN","C0PTRXN",219,0)
 . . D RNF1TO2^C0CRNF(ZARY,"ZROW")
"RTN","C0PTRXN",220,0)
 . S ZROW("VUID")=ZVUID
"RTN","C0PTRXN",221,0)
 . I ZVUID["^" S ZVUID=$P(ZVUID,"^",1) ; USE THE FIRST ONE
"RTN","C0PTRXN",222,0)
 . S ZVAIEN=$$VAPROD^C0PLKUP(ZVUID) ; IEN IN VA PRODUCTS (NDF)
"RTN","C0PTRXN",223,0)
 . I ZVAIEN=0 D  Q  ; NOT FOUND IN NDF
"RTN","C0PTRXN",224,0)
 . . S ZROW("TYPE")=4
"RTN","C0PTRXN",225,0)
 . . D RNF1TO2^C0CRNF(ZARY,"ZROW")
"RTN","C0PTRXN",226,0)
 . S ZDRUGIEN=$$DRUG^C0PLKUP(ZVAIEN) ; IEN IN DRUG FILE
"RTN","C0PTRXN",227,0)
 . I ZDRUGIEN=0 D  Q  ;
"RTN","C0PTRXN",228,0)
 . . S ZROW("TYPE")=3
"RTN","C0PTRXN",229,0)
 . . S ZROW("VANDFNAME")=$$GET1^DIQ(50.68,ZVAIEN_",",.01) ;NDF NAME
"RTN","C0PTRXN",230,0)
 . . D RNF1TO2^C0CRNF(ZARY,"ZROW")
"RTN","C0PTRXN",231,0)
 . S ZVANAME=$$GET1^DIQ(50,ZDRUGIEN_",",.01) ; VA DRUG NAME
"RTN","C0PTRXN",232,0)
 . S ZROW("VANAME")=ZVANAME ; 
"RTN","C0PTRXN",233,0)
 . I ZVANAME=$$UP^XLFSTR(ZNAME) S ZROW("TYPE")=1
"RTN","C0PTRXN",234,0)
 . E  S ZROW("TYPE")=2
"RTN","C0PTRXN",235,0)
 . D RNF1TO2^C0CRNF(ZARY,"ZROW")
"RTN","C0PTRXN",236,0)
 . ;B
"RTN","C0PTRXN",237,0)
 Q
"RTN","C0PTRXN",238,0)
 ;
"RTN","C0PTRXN",239,0)
BLDFILE() ; BUILDS THE C0P RXNORM FDB VUID MAPPING FILE #113059010.002
"RTN","C0PTRXN",240,0)
 ; 
"RTN","C0PTRXN",241,0)
 ; FIRST DATA BANK DRUGS ARE MATCHED TO VISTA DRUGS THROUGH A MULTI-STEP
"RTN","C0PTRXN",242,0)
 ; PROCESS. THE MEDID IS THE FIRST DATA BANK NUMBER USED TO REFER TO THEIR
"RTN","C0PTRXN",243,0)
 ; DRUGS. EACH MEDID HAS A GCN (GENERIC CODE NUMBER) WHICH CAN BE USED TO
"RTN","C0PTRXN",244,0)
 ; LOOK UP THE DRUG IN THE RXNORM UMLS DATABASE. THE GCN IS USED TO FIND
"RTN","C0PTRXN",245,0)
 ; THE RXNORM CONCEPT NUMBER (RXNCUI). THE RXNCUI IS USED TO FIND THE VUID
"RTN","C0PTRXN",246,0)
 ; USING THE RXNORM UMLS DATABASE. THE VUID IS USED TO FIND THE IEN OF THE
"RTN","C0PTRXN",247,0)
 ; DRUG IN THE VA PRODUCTS FILE (ALSO KNOWN AS THE NDF - NATIONAL DRUG FILE).
"RTN","C0PTRXN",248,0)
 ; THE VAPROD IEN IS THEN USED TO LOOK UP THE DRUG IN THE VA DRUG FILE
"RTN","C0PTRXN",249,0)
 ; (FILE 50) USING A NEW CROSS REFERENCE (AC0P) CREATED FOR THIS PURPOSE.
"RTN","C0PTRXN",250,0)
 ; THE RESULT OF THIS CHAIN IS A DRUG MAPPED FROM THE FDB MEDID TO A
"RTN","C0PTRXN",251,0)
 ; VA DRUG FILE IEN. TO SUMMARIZE:
"RTN","C0PTRXN",252,0)
 ; 
"RTN","C0PTRXN",253,0)
 ; MEDID->GCN->RXNCUI->VUID->VAPROD->DRUGIEN
"RTN","C0PTRXN",254,0)
 ;
"RTN","C0PTRXN",255,0)
 ; (NOTE: THIS PROCESS WILL CHANGE - BE IMPROVED - WHEN THE VERIFIED 
"RTN","C0PTRXN",256,0)
 ; MEDID->RXNORM MAPPING BECOMES AVAILABLE. THIS ANALYSIS WILL ESTABLISH
"RTN","C0PTRXN",257,0)
 ; A BASELINE WITH WHICH TO COMPARE THE RESULT OF USING THAT MAPPING)
"RTN","C0PTRXN",258,0)
 ;
"RTN","C0PTRXN",259,0)
 ; (THE PROCESS IS ACTUALLY MORE COMPLEX THAT THIS, BECAUSE WE ALSO TRY
"RTN","C0PTRXN",260,0)
 ; AND MATCH DRUGS BY LOOKING AT THEIR CHEMICAL COMPONENTS BUT THIS ANALYSIS
"RTN","C0PTRXN",261,0)
 ; IGNORES THIS MORE COMPLEX PROCESS.)
"RTN","C0PTRXN",262,0)
 ; 
"RTN","C0PTRXN",263,0)
 ; NOT ALL DRUGS MAKE IT ALL THE WAY THROUGH THIS MAPPING. IN ADDITION, THERE
"RTN","C0PTRXN",264,0)
 ; MAY BE DRUGS THAT ARE IN THE DRUG FILE THAT ARE NOT IN THE FDB FILE
"RTN","C0PTRXN",265,0)
 ; THIS ROUTINE WILL CREATE A SPREADSHEET THAT WILL SHOW THE UNMAPPED DRUGS
"RTN","C0PTRXN",266,0)
 ; IN BOTH DIRECTIONS (MEDID->...>DRUGIEN AND DRUGIEN->...>MEDID)
"RTN","C0PTRXN",267,0)
 ; IT WILL ALSO SHOW THE DRUG NAME AS IT APPEARS IN FIRST DATA BANK
"RTN","C0PTRXN",268,0)
 ; AND THE NAME THAT WILL BE USED FOR THAT DRUG IN VISTA (ERX). OFTEN
"RTN","C0PTRXN",269,0)
 ; THEY WILL BE DIFFERENT. IF THE FDB DRUG IS NOT A GENERIC, THE GENERIC NAME
"RTN","C0PTRXN",270,0)
 ; WILL BY USED BY ERX TO LIST THE DRUG IN THE PATIENT'S DRUG LIST IN VISTA
"RTN","C0PTRXN",271,0)
 ;
"RTN","C0PTRXN",272,0)
 ; WE ARE GOING TO ORGANIZE AN ARRAY WITH DRUGS BY TYPE. HERE ARE THE TYPES:
"RTN","C0PTRXN",273,0)
 ; 
"RTN","C0PTRXN",274,0)
 ; TYPE 1 - FDB DRUGS THAT MAP EXACTLY TO THE DRUG FILE, WITH NAMES THAT
"RTN","C0PTRXN",275,0)
 ;  MATCH EXACTLY
"RTN","C0PTRXN",276,0)
 ;
"RTN","C0PTRXN",277,0)
 ; TYPE 2 - FDB DRUGS THAT MAP TO THE DRUG FILE, BUT WITH DIFFERENT NAMES.
"RTN","C0PTRXN",278,0)
 ;  THIS CATEGORY INCLUDES DRUGS THAT ARE SHOWN IN VISTA AS GENERICS BUT
"RTN","C0PTRXN",279,0)
 ;  ON FDB AS BRAND NAME DRUGS
"RTN","C0PTRXN",280,0)
 ; 
"RTN","C0PTRXN",281,0)
 ; TYPE 3 - FDB DRUGS THAT DO NOT MAP TO THE DRUG FILE, BUT DO MAP TO THE
"RTN","C0PTRXN",282,0)
 ;  VA PRODUCT FILE (NDF). IF ANY OF THESE DRUGS MIGHT BE ORDERED VIA ERX,
"RTN","C0PTRXN",283,0)
 ;  IT MIGHT BE A GOOD IDEA TO ADD THEM TO THE DRUG FILE.
"RTN","C0PTRXN",284,0)
 ; NOTE: FOR TYPE 3 AND ABOVE DRUGS, ERX WILL STILL FUNCTION PROPERLY BUT
"RTN","C0PTRXN",285,0)
 ; INSTEAD OF MAPPING THE DRUG TO THE DRUG FILE, WILL MAP IT AS A FREE TEXT
"RTN","C0PTRXN",286,0)
 ; DRUG AND WILL SEND A MAIL MESSAGE ABOUT THE MAPPING ERROR SO THAT THE
"RTN","C0PTRXN",287,0)
 ; DRUG CAN BE CONSIDERED FOR ADDING TO THE DRUG FILE
"RTN","C0PTRXN",288,0)
 ; 
"RTN","C0PTRXN",289,0)
 ; TYPE 4 - FDB DRUGS THAT DO NOT MAP TO THE DRUG FILE AND ARE ALSO NOT
"RTN","C0PTRXN",290,0)
 ;  FOUND IN THE NDF. THIS MIGHT BE THE CASE FOR NEWER DRUGS. ERX WILL
"RTN","C0PTRXN",291,0)
 ;  STILL FUNCTION, BUT THESE WILL BE FREE TEXT DRUGS. THE REMEDY IS AN
"RTN","C0PTRXN",292,0)
 ;  UPDATE FROM THE VA OF THE NDF OR ADDING THE DRUGS TO THE NDF AND THE
"RTN","C0PTRXN",293,0)
 ;  DRUG FILE. (THERE ARE COMPLEXITIES IN ADDING DRUGS TO THE NDF BECAUSE
"RTN","C0PTRXN",294,0)
 ;  OF HOW TO THEN HANDLE AN UPDATE FROM THE VA)
"RTN","C0PTRXN",295,0)
 ;
"RTN","C0PTRXN",296,0)
 ; TYPE 5 - DRUGS IN THE DRUG FILE THAT ARE NOT FOUND IN THE FDB DRUG DATABASE
"RTN","C0PTRXN",297,0)
 ;  MAPPING. THIS MIGHT INCLUDE BRAND NAME DRUGS IN THE DRUG FILE THAT HAVE
"RTN","C0PTRXN",298,0)
 ;  BEEN MAPPED TO GENERICS WHEN COMING FROM FDB. IN ANY CASE, THESE ARE DRUGS
"RTN","C0PTRXN",299,0)
 ;  FOR WHICH THERE IS NO PATH TO MAP FROM THEM TO FDB. (REDUCING THE NUMBER
"RTN","C0PTRXN",300,0)
 ;  OF DRUGS IN THIS TYPE TO ZERO WILL BE A GOAL BEFORE IMPLEMENTING PHASE II
"RTN","C0PTRXN",301,0)
 ;  OF ERX WHERE DRUGS WILL BE ORDERED ON VISTA AND SENT TO THE ERX 
"RTN","C0PTRXN",302,0)
 ;  SERVICE.
"RTN","C0PTRXN",303,0)
 ;
"RTN","C0PTRXN",304,0)
 N FN S FN=1130590010.002 ;FILE NUMBER FOR C0P RXNORM FDB VUID MAPPING FILE
"RTN","C0PTRXN",305,0)
 N C0PFDA
"RTN","C0PTRXN",306,0)
 N ZI
"RTN","C0PTRXN",307,0)
 S ZI=""
"RTN","C0PTRXN",308,0)
 F  S ZI=$O(^C0P("FDB","B",ZI)) Q:ZI=""  D  ;
"RTN","C0PTRXN",309,0)
 . D DOONE(.C0PFDA,ZI) ;BUILD AN FDA
"RTN","C0PTRXN",310,0)
 . D UPDIE ;WRITE TO FILE
"RTN","C0PTRXN",311,0)
 Q
"RTN","C0PTRXN",312,0)
 ;
"RTN","C0PTRXN",313,0)
DOONE(C0PFDA,ZI) ; RETURN FDA FOR MEDID ZI
"RTN","C0PTRXN",314,0)
 N FN S FN=1130590010.002 ;FILE NUMBER FOR C0P RXNORM FDB VUID MAPPING FILE
"RTN","C0PTRXN",315,0)
 N ZGCN,ZRXNCUI,ZNAME,ZVAIEN,ZDRUGIEN,ZROW,ZIEN,ZVANAME,ZRXNIEN,ZRXNTXT
"RTN","C0PTRXN",316,0)
 S (ZGCN,ZRXNCUI,ZNAME,ZVAIEN,ZDRUGIEN,ZVANAME)=""
"RTN","C0PTRXN",317,0)
 ;S ZROW("MEDID")=ZI ; FDB MEDID
"RTN","C0PTRXN",318,0)
 S C0PFDA(FN,"+1,",.02)=ZI ; FDB MEDID
"RTN","C0PTRXN",319,0)
 S ZIEN=$O(^C0P("FDB","B",ZI,"")) ; IEN OF THE FDB MED
"RTN","C0PTRXN",320,0)
 S C0PFDA(FN,"+1,",1.02)=ZIEN ;POINTER TO FDB MED
"RTN","C0PTRXN",321,0)
 ;S ZROW("FDBNAME")=$$FULLNAME^C0PLKUP(ZI) ; FDB MED NAME
"RTN","C0PTRXN",322,0)
 S ZNAME=$$FULLNAME^C0PLKUP(ZI) ; FDB MED NAME
"RTN","C0PTRXN",323,0)
 S C0PFDA(FN,"+1,",2.02)=ZNAME ; FDB MED NAME
"RTN","C0PTRXN",324,0)
 S ZGCN=$$GCN^C0PLKUP(ZI)
"RTN","C0PTRXN",325,0)
 I ZGCN=0 D  Q  ; NO GCN, CAN'T GO FURTHER 
"RTN","C0PTRXN",326,0)
 . ;S ZROW("TYPE")=4
"RTN","C0PTRXN",327,0)
 . S C0PFDA(FN,"+1,",3)=4 ;TYPE 4, CAN'T MAP FDB TO RXN
"RTN","C0PTRXN",328,0)
 . S C0PFDA(FN,"+1,",.01)="MISSING RXN" ;NEED TO HAVE A .01
"RTN","C0PTRXN",329,0)
 . ;D RNF1TO2^C0CRNF(ZARY,"ZROW")
"RTN","C0PTRXN",330,0)
 ;S ZROW("GCN")=ZGCN
"RTN","C0PTRXN",331,0)
 S C0PFDA(FN,"+1,",.04)=$$GCN^C0PLKUP(ZI) ;GENERIC CATEGORY NUMBER
"RTN","C0PTRXN",332,0)
 S ZRXNCUI=$$RXNCUI^C0PLKUP(ZGCN) ; RETRIEVE THE RXNORM CONCEPT ID
"RTN","C0PTRXN",333,0)
 I ZRXNCUI="" W !,"ERROR, NO RXNCUI "_ZGCN D ERROR^C0PMAIN(",U113059009,",$ST($ST,"PLACE"),"ERX-INVALID-DATA","Invalid Data") QUIT  ;shouldn't happen
"RTN","C0PTRXN",334,0)
 S C0PFDA(FN,"+1,",.01)=ZRXNCUI ; RXN CONCEPT
"RTN","C0PTRXN",335,0)
 S ZRXNIEN=$O(^C0P("RXN","B",ZRXNCUI,"")) ; RXN CONCEPT IEN
"RTN","C0PTRXN",336,0)
 S C0PFDA(FN,"+1,",1.01)=ZRXNIEN ; POINTER TO RXN CONCEPT
"RTN","C0PTRXN",337,0)
 S ZRXNTXT=$G(^C0P("RXN",ZRXNIEN,1,1,0)) ; FIRST LINE OF RXN TEXT
"RTN","C0PTRXN",338,0)
 S C0PFDA(FN,"+1,",2.01)=ZRXNTXT ; RXN CONCEPT LABEL
"RTN","C0PTRXN",339,0)
 ;S ZROW("RXNCUI")=ZRXNCUI
"RTN","C0PTRXN",340,0)
 S ZVUID=$$VUID^C0PLKUP(ZRXNCUI) ; FETCH THE VUID
"RTN","C0PTRXN",341,0)
 I ZVUID="" D  Q  ; NO VUID FOUND
"RTN","C0PTRXN",342,0)
 . ;S ZROW("TYPE")=4
"RTN","C0PTRXN",343,0)
 . S C0PFDA(FN,"+1,",3)=4 ;TYPE 4, CAN'T MAP RXNCUI TO VUID
"RTN","C0PTRXN",344,0)
 . ;D RNF1TO2^C0CRNF(ZARY,"ZROW")
"RTN","C0PTRXN",345,0)
 ;S ZROW("VUID")=ZVUID
"RTN","C0PTRXN",346,0)
 S ZVUID=$TR(ZVUID,"^","|") ; CAN'T HAVE ^ IN FIELDS
"RTN","C0PTRXN",347,0)
 S C0PFDA(FN,"+1,",.03)=ZVUID ;SET OF VUIDS
"RTN","C0PTRXN",348,0)
 I ZVUID["|" S ZVUID=$P(ZVUID,"|",1) ; USE THE FIRST ONE
"RTN","C0PTRXN",349,0)
 S ZVAIEN=$$VAPROD^C0PLKUP(ZVUID) ; IEN IN VA PRODUCTS (NDF)
"RTN","C0PTRXN",350,0)
 I +ZVAIEN=0 D  Q  ; NOT FOUND IN NDF
"RTN","C0PTRXN",351,0)
 . ;S ZROW("TYPE")=4
"RTN","C0PTRXN",352,0)
 . S C0PFDA(FN,"+1,",3)=4 ;TYPE 4, CAN'T MAP VUID TO NDF
"RTN","C0PTRXN",353,0)
 . ;D RNF1TO2^C0CRNF(ZARY,"ZROW")
"RTN","C0PTRXN",354,0)
 S ZDRUGIEN=$$DRUG^C0PLKUP(ZVAIEN) ; IEN IN DRUG FILE
"RTN","C0PTRXN",355,0)
 I ZDRUGIEN["^" S ZDRUGIEN=$P(ZDRUGIEN,"^",1) ; USE THE FIRST ONE
"RTN","C0PTRXN",356,0)
 I +ZDRUGIEN=0 D  Q  ;
"RTN","C0PTRXN",357,0)
 . S ZROW("TYPE")=3
"RTN","C0PTRXN",358,0)
 . S C0PFDA(FN,"+1,",3)=3 ;TYPE 3, CAN'T MAP VUID TO DRUG FILE
"RTN","C0PTRXN",359,0)
 . ;S ZROW("VANDFNAME")=$$GET1^DIQ(50.68,ZVAIEN_",",.01) ;NDF NAME
"RTN","C0PTRXN",360,0)
 . S C0PFDA(FN,"+1,",1.04)=ZVAIEN ;POINTER TO NDF
"RTN","C0PTRXN",361,0)
 . S C0PFDA(FN,"+1,",2.04)=$$GET1^DIQ(50.68,ZVAIEN_",",.01) ;NDF NAME
"RTN","C0PTRXN",362,0)
 . ;D RNF1TO2^C0CRNF(ZARY,"ZROW")
"RTN","C0PTRXN",363,0)
 S ZVANAME=$$GET1^DIQ(50,ZDRUGIEN_",",.01) ; VA DRUG NAME
"RTN","C0PTRXN",364,0)
 S C0PFDA(FN,"+1,",2.03)=ZVANAME ; VA DRUG FILE NAME
"RTN","C0PTRXN",365,0)
 S C0PFDA(FN,"+1,",1.03)=$G(ZDRUGIEN) ; VA DRUG FILE IEN
"RTN","C0PTRXN",366,0)
 ;S ZROW("VANAME")=ZVANAME ; 
"RTN","C0PTRXN",367,0)
 I ZVANAME=$$UP^XLFSTR(ZNAME) S ZROW("TYPE")=1
"RTN","C0PTRXN",368,0)
 E  S ZROW("TYPE")=2
"RTN","C0PTRXN",369,0)
 S C0PFDA(FN,"+1,",3)=ZROW("TYPE") ; MATCHING TYPE 1 OR 2
"RTN","C0PTRXN",370,0)
 ;D RNF1TO2^C0CRNF(ZARY,"ZROW")
"RTN","C0PTRXN",371,0)
 ;B
"RTN","C0PTRXN",372,0)
 Q
"RTN","C0PTRXN",373,0)
 ;
"RTN","C0PTRXN",374,0)
UPDIE   ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
"RTN","C0PTRXN",375,0)
 ;Q  ;//SMH don't want an update
"RTN","C0PTRXN",376,0)
 ;I C0PFDA(FN,"+1,",3)'=3 Q  ;
"RTN","C0PTRXN",377,0)
 I C0PFDA(FN,"+1,",1.02)=1 Q  ;
"RTN","C0PTRXN",378,0)
 ;ZWR C0PFDA ;
"RTN","C0PTRXN",379,0)
 K ZERR
"RTN","C0PTRXN",380,0)
 D CLEAN^DILF
"RTN","C0PTRXN",381,0)
 D UPDATE^DIE("","C0PFDA","","ZERR")
"RTN","C0PTRXN",382,0)
 I $D(ZERR) D ERROR^C0PMAIN(",U113059008,",$ST($ST,"PLACE"),"ERX-UPDIE-FAIL","Fileman Data Update Failure") QUIT
"RTN","C0PTRXN",383,0)
 K C0PFDA
"RTN","C0PTRXN",384,0)
 Q
"RTN","C0PWPS")
0^19^B36558462
"RTN","C0PWPS",1,0)
C0PWPS   ; ERX/GPL - eRx CPRS RPCs ; 2/8/10 ; 5/8/12 5:24pm
"RTN","C0PWPS",2,0)
 ;;1.0;C0P;;Apr 25, 2012;Build 103
"RTN","C0PWPS",3,0)
 ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"RTN","C0PWPS",4,0)
 ;General Public License See attached copy of the License.
"RTN","C0PWPS",5,0)
 ;
"RTN","C0PWPS",6,0)
 ;This program is free software; you can redistribute it and/or modify
"RTN","C0PWPS",7,0)
 ;it under the terms of the GNU General Public License as published by
"RTN","C0PWPS",8,0)
 ;the Free Software Foundation; either version 2 of the License, or
"RTN","C0PWPS",9,0)
 ;(at your option) any later version.
"RTN","C0PWPS",10,0)
 ;
"RTN","C0PWPS",11,0)
 ;This program is distributed in the hope that it will be useful,
"RTN","C0PWPS",12,0)
 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0PWPS",13,0)
 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"RTN","C0PWPS",14,0)
 ;GNU General Public License for more details.
"RTN","C0PWPS",15,0)
 ;
"RTN","C0PWPS",16,0)
 ;You should have received a copy of the GNU General Public License along
"RTN","C0PWPS",17,0)
 ;with this program; if not, write to the Free Software Foundation, Inc.,
"RTN","C0PWPS",18,0)
 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
"RTN","C0PWPS",19,0)
 ;
"RTN","C0PWPS",20,0)
 Q
"RTN","C0PWPS",21,0)
 ; These routines are substitutes for COVER^ORWPS and DETAIL^ORWPS to
"RTN","C0PWPS",22,0)
 ; display eRx and CCR/CCD medication lists accurately
"RTN","C0PWPS",23,0)
 ;
"RTN","C0PWPS",24,0)
COVER(LST,DFN)  ; retrieve meds for cover sheet
"RTN","C0PWPS",25,0)
 K ^TMP("PS",$J)
"RTN","C0PWPS",26,0)
 D OCL^PSOORRL(DFN,"","")  ;DBIA #2400
"RTN","C0PWPS",27,0)
 N ILST,ITMP,X S ILST=0
"RTN","C0PWPS",28,0)
 S ITMP="" F  S ITMP=$O(^TMP("PS",$J,ITMP)) Q:'ITMP  D
"RTN","C0PWPS",29,0)
 . S X=^TMP("PS",$J,ITMP,0)
"RTN","C0PWPS",30,0)
 . I '$L($P(X,U,2)) S X="??"  ; show something if drug empty
"RTN","C0PWPS",31,0)
 . I $D(^TMP("PS",$J,ITMP,"CLINIC",0)) S LST($$NXT^ORWPS)=$P(X,U,1,2)_U_$P(X,U,8,9)_U_"C"
"RTN","C0PWPS",32,0)
 . E  S LST($$NXT^ORWPS)=$P(X,U,1,2)_U_$P(X,U,8,9)
"RTN","C0PWPS",33,0)
 K ^TMP("PS",$J)
"RTN","C0PWPS",34,0)
 ; BEGIN NEW PROCESSING (EVERYTHING ABOVE WAS COPIED FROM COVER^0RWPS
"RTN","C0PWPS",35,0)
 N ZCUR
"RTN","C0PWPS",36,0)
 D GET^C0PCUR(.ZCUR,DFN) ; GET THE DETAIL FOR THE SAME MEDS LIST
"RTN","C0PWPS",37,0)
 N ZI S ZI=""
"RTN","C0PWPS",38,0)
 F  S ZI=$O(LST(ZI)) Q:ZI=""  D  ;FOR EACH MED IN THE LIST
"RTN","C0PWPS",39,0)
 . I $P(LST(ZI),U,2)["FREE TXT" D  ; IS AN ERX UNMAPPED DRUG
"RTN","C0PWPS",40,0)
 . . N ZD
"RTN","C0PWPS",41,0)
 . . S ZD=$P(ZCUR(ZI,"SIG",1,0),"|",1) ; REAL DRUG NAME SHOULD BE IN SIG
"RTN","C0PWPS",42,0)
 . . ; SEPARATED BY "|"
"RTN","C0PWPS",43,0)
 . . I ZD'="" S $P(LST(ZI),U,2)=ZD ; IF SO, USE THE REAL NAME
"RTN","C0PWPS",44,0)
 ; BEGIN VISTACOM MOD -
"RTN","C0PWPS",45,0)
 ; SAVE THE DUZ OFF TO THE VISTACOM TMP GLOBAL
"RTN","C0PWPS",46,0)
 S ^TMP("ZEWD",$J,"DUZ")=DUZ ; TO BE PICKED UP AND DELETED LATER BY VISTACOM
"RTN","C0PWPS",47,0)
 Q
"RTN","C0PWPS",48,0)
COVER2(LST,DFN)  ; retrieve meds for cover sheet ;
"RTN","C0PWPS",49,0)
 ; THIS VERSION WILL DISPLAY THE DRUG NAME FROM THE PHARMACY ORDERABLE
"RTN","C0PWPS",50,0)
 ; ITEMS FILE FOR ERX DRUGS. THIS ALLOWS THE DRUG TO APPEAR AS GENERIC(BRAND)
"RTN","C0PWPS",51,0)
 ; FOR CERTAIN DRUGS - GPL 10/5/10
"RTN","C0PWPS",52,0)
 K ^TMP("PS",$J)
"RTN","C0PWPS",53,0)
 D OCL^PSOORRL(DFN,"","")  ;DBIA #2400
"RTN","C0PWPS",54,0)
 N ILST,ITMP,X S ILST=0
"RTN","C0PWPS",55,0)
 S ITMP="" F  S ITMP=$O(^TMP("PS",$J,ITMP)) Q:'ITMP  D
"RTN","C0PWPS",56,0)
 . S X=^TMP("PS",$J,ITMP,0)
"RTN","C0PWPS",57,0)
 . I '$L($P(X,U,2)) S X="??"  ; show something if drug empty
"RTN","C0PWPS",58,0)
 . I $D(^TMP("PS",$J,ITMP,"CLINIC",0)) S LST($$NXT^ORWPS)=$P(X,U,1,2)_U_$P(X,U,8,9)_U_"C"
"RTN","C0PWPS",59,0)
 . E  S LST($$NXT^ORWPS)=$P(X,U,1,2)_U_$P(X,U,8,9)
"RTN","C0PWPS",60,0)
 K ^TMP("PS",$J)
"RTN","C0PWPS",61,0)
 ; BEGIN NEW PROCESSING (EVERYTHING ABOVE WAS COPIED FROM COVER^0RWPS
"RTN","C0PWPS",62,0)
 N ZCUR
"RTN","C0PWPS",63,0)
 D GET^C0PCUR(.ZCUR,DFN) ; GET THE DETAIL FOR THE SAME MEDS LIST
"RTN","C0PWPS",64,0)
 N ZI S ZI=""
"RTN","C0PWPS",65,0)
 F  S ZI=$O(LST(ZI)) Q:ZI=""  D  ;FOR EACH MED IN THE LIST
"RTN","C0PWPS",66,0)
 . I $P(LST(ZI),U,2)["FREE TXT" D  ; IS AN ERX UNMAPPED DRUG
"RTN","C0PWPS",67,0)
 . . N ZD
"RTN","C0PWPS",68,0)
 . . S ZD=$P(ZCUR(ZI,"SIG",1,0),"|",1) ; REAL DRUG NAME SHOULD BE IN SIG
"RTN","C0PWPS",69,0)
 . . ; SEPARATED BY "|"
"RTN","C0PWPS",70,0)
 . . I ZD'="" S $P(LST(ZI),U,2)=ZD ; IF SO, USE THE REAL NAME
"RTN","C0PWPS",71,0)
 . E  I $P(LST(ZI),U,1)["N" D  ; THIS IS A NONVA DRUG
"RTN","C0PWPS",72,0)
 . . N ZD,ZDIEN
"RTN","C0PWPS",73,0)
 . . I $G(ZCUR(ZI,"COMMENTS",1))["E-Rx" D  ; IS AN ERX DRUG
"RTN","C0PWPS",74,0)
 . . . S ZDIEN=$G(ZCUR(ZI,"DRUG")) ; IEN IN THE DRUG FILE
"RTN","C0PWPS",75,0)
 . . . S ZD=$$GET1^DIQ(50,ZDIEN,2.1) ; THE PHARMACY ORDERABLE ITEM
"RTN","C0PWPS",76,0)
 . . . I ZD'="" S $P(LST(ZI),U,2)=ZD ; USE THIS DRUG NAME
"RTN","C0PWPS",77,0)
 ; BEGIN VISTACOM MOD -
"RTN","C0PWPS",78,0)
 ; SAVE THE DUZ OFF TO THE VISTACOM TMP GLOBAL
"RTN","C0PWPS",79,0)
 S ^TMP("ZEWD",$J,"DUZ")=DUZ ; TO BE PICKED UP AND DELETED LATER BY VISTACOM
"RTN","C0PWPS",80,0)
 Q
"RTN","C0PWPS",81,0)
COVER3(LST,DFN)  ; retrieve meds for cover sheet ;
"RTN","C0PWPS",82,0)
 ; THIS VERSION WILL DISPLAY THE FIRST DATA BANK DRUG NAME WHERE AVAILABLE
"RTN","C0PWPS",83,0)
 ;  - GPL 10/6/10
"RTN","C0PWPS",84,0)
 K ^TMP("PS",$J)
"RTN","C0PWPS",85,0)
 D OCL^PSOORRL(DFN,"","")  ;DBIA #2400
"RTN","C0PWPS",86,0)
 N ILST,ITMP,X S ILST=0
"RTN","C0PWPS",87,0)
 S ITMP="" F  S ITMP=$O(^TMP("PS",$J,ITMP)) Q:'ITMP  D
"RTN","C0PWPS",88,0)
 . S X=^TMP("PS",$J,ITMP,0)
"RTN","C0PWPS",89,0)
 . I '$L($P(X,U,2)) S X="??"  ; show something if drug empty
"RTN","C0PWPS",90,0)
 . I $D(^TMP("PS",$J,ITMP,"CLINIC",0)) S LST($$NXT^ORWPS)=$P(X,U,1,2)_U_$P(X,U,8,9)_U_"C"
"RTN","C0PWPS",91,0)
 . E  S LST($$NXT^ORWPS)=$P(X,U,1,2)_U_$P(X,U,8,9)
"RTN","C0PWPS",92,0)
 K ^TMP("PS",$J)
"RTN","C0PWPS",93,0)
 ; BEGIN NEW PROCESSING (EVERYTHING ABOVE WAS COPIED FROM COVER^0RWPS
"RTN","C0PWPS",94,0)
 N ZCUR
"RTN","C0PWPS",95,0)
 D GET^C0PCUR(.ZCUR,DFN) ; GET THE DETAIL FOR THE SAME MEDS LIST
"RTN","C0PWPS",96,0)
 N ZI S ZI=""
"RTN","C0PWPS",97,0)
 F  S ZI=$O(LST(ZI)) Q:ZI=""  D  ;FOR EACH MED IN THE LIST
"RTN","C0PWPS",98,0)
 . I $P(LST(ZI),U,2)["FREE TXT" D  ; IS AN ERX UNMAPPED DRUG
"RTN","C0PWPS",99,0)
 . . N ZD
"RTN","C0PWPS",100,0)
 . . S ZD=$P(ZCUR(ZI,"SIG",1,0),"|",1) ; REAL DRUG NAME SHOULD BE IN SIG
"RTN","C0PWPS",101,0)
 . . ; SEPARATED BY "|"
"RTN","C0PWPS",102,0)
 . . I ZD'="" S $P(LST(ZI),U,2)=ZD ; IF SO, USE THE REAL NAME
"RTN","C0PWPS",103,0)
 . E  I $P(LST(ZI),U,1)["N" D  ; THIS IS A NONVA DRUG
"RTN","C0PWPS",104,0)
 . . N ZD,ZDSIG
"RTN","C0PWPS",105,0)
 . . S ZDSIG=ZCUR(ZI,"SIG",1,0) ; THE SIG (CHECK THIS PLEASE)
"RTN","C0PWPS",106,0)
 . . I ZDSIG["|" D  ; THERE ARE TWO PARTS TO THE SIG
"RTN","C0PWPS",107,0)
 . . . S ZD=$P(ZDSIG,"|",1) ; FDB DRUG NAME SHOULD BE IN SIG
"RTN","C0PWPS",108,0)
 . . . I ZD'="" S $P(LST(ZI),U,2)=ZD ; IF SO, USE THE FDB NAME
"RTN","C0PWPS",109,0)
 ; BEGIN VISTACOM MOD -
"RTN","C0PWPS",110,0)
 ; SAVE THE DUZ OFF TO THE VISTACOM TMP GLOBAL
"RTN","C0PWPS",111,0)
 S ^TMP("ZEWD",$J,"DUZ")=DUZ ; TO BE PICKED UP AND DELETED LATER BY VISTACOM
"RTN","C0PWPS",112,0)
 Q
"RTN","C0PWPS",113,0)
DETAIL(ROOT,DFN,ID) ; -- show details for a med order
"RTN","C0PWPS",114,0)
 K ^TMP("ORXPND",$J)
"RTN","C0PWPS",115,0)
 N ZID
"RTN","C0PWPS",116,0)
 S ZID=ID
"RTN","C0PWPS",117,0)
 N LCNT,ORVP
"RTN","C0PWPS",118,0)
 S LCNT=0,ORVP=DFN_";DPT("
"RTN","C0PWPS",119,0)
 D MEDS^ORCXPND1
"RTN","C0PWPS",120,0)
 S ROOT=$NA(^TMP("ORXPND",$J))
"RTN","C0PWPS",121,0)
 I @ROOT@(11,0)="Order #0" D ERXDET
"RTN","C0PWPS",122,0)
 Q
"RTN","C0PWPS",123,0)
ERXDET ; BUILD ERX MED DETAIL
"RTN","C0PWPS",124,0)
 N ZMEDS
"RTN","C0PWPS",125,0)
 D GET^C0PCUR(.ZMEDS,DFN)
"RTN","C0PWPS",126,0)
 N ZI,FOUND
"RTN","C0PWPS",127,0)
 S FOUND=0 S ZI=""
"RTN","C0PWPS",128,0)
 F  Q:FOUND'=0  S ZI=$O(ZMEDS(ZI)) Q:ZI=""  D  ; SEARCH FOR THE ID
"RTN","C0PWPS",129,0)
 . I $P(ZMEDS(ZI,0),U,1)=ZID S FOUND=1 ; ID MATCHES THE MED
"RTN","C0PWPS",130,0)
 I FOUND=0 Q  ; NO MATCH FOR THE MED
"RTN","C0PWPS",131,0)
 K @ROOT ; CLEAR OUT THE NULL DETAIL
"RTN","C0PWPS",132,0)
 ;W !,"MED FOUND ",ZI," ",ZID
"RTN","C0PWPS",133,0)
 N ZNAME,ZSIG,ZCOM,ZFDBN
"RTN","C0PWPS",134,0)
 S ZNAME=$P(ZMEDS(ZI,0),U,2)
"RTN","C0PWPS",135,0)
 S ZSIG=$G(ZMEDS(ZI,"SIG",1,0))
"RTN","C0PWPS",136,0)
 M ZCOM=ZMEDS(ZI,"COMMENTS")
"RTN","C0PWPS",137,0)
 I ZNAME["FREE TXT" D  ;
"RTN","C0PWPS",138,0)
 . S ZNAME=$P(ZSIG,"|",1)
"RTN","C0PWPS",139,0)
 . S ZSIG=$P(ZSIG,"| ",2)
"RTN","C0PWPS",140,0)
 E  I ZSIG["|" D  ; NEED TO PULL OUT THE DRUG NAME FROM THE SIG
"RTN","C0PWPS",141,0)
 . S ZFDBN=$P(ZSIG,"|",1)
"RTN","C0PWPS",142,0)
 . S ZSIG=$P(ZSIG,"| ",2)
"RTN","C0PWPS",143,0)
 N ZN S ZN=1
"RTN","C0PWPS",144,0)
 S @ROOT@(ZN,0)=" Medication: "_ZNAME S ZN=ZN+1
"RTN","C0PWPS",145,0)
 I $G(ZFDBN)'="" D  ; IF FIRST DATA BANK NAME IS KNOWN
"RTN","C0PWPS",146,0)
 . S @ROOT@(ZN,0)="                                     " S ZN=ZN+1
"RTN","C0PWPS",147,0)
 . S @ROOT@(ZN,0)="   FDB Name: "_ZFDBN S ZN=ZN+1
"RTN","C0PWPS",148,0)
 . S @ROOT@(ZN,0)="                                     " S ZN=ZN+1
"RTN","C0PWPS",149,0)
 E  S @ROOT@(ZN,0)="                                     " S ZN=ZN+1
"RTN","C0PWPS",150,0)
 S @ROOT@(ZN,0)="        Sig: "_ZSIG S ZN=ZN+1
"RTN","C0PWPS",151,0)
 S @ROOT@(ZN,0)=""  S ZN=ZN+1
"RTN","C0PWPS",152,0)
 S @ROOT@(ZN,0)="     Status: "_$P(ZMEDS(ZI,0),U,9) S ZN=ZN+1
"RTN","C0PWPS",153,0)
 S @ROOT@(ZN,0)="" S ZN=ZN+1
"RTN","C0PWPS",154,0)
 S @ROOT@(ZN,0)="   Schedule: "_$G(ZMEDS(ZI,"SCH",1,0)) S ZN=ZN+1
"RTN","C0PWPS",155,0)
 S @ROOT@(ZN,0)="                " S ZN=ZN+1
"RTN","C0PWPS",156,0)
 S @ROOT@(ZN,0)=" Start Date: "_$$FMTE^XLFDT($G(ZMEDS(ZI,"START"))) S ZN=ZN+1
"RTN","C0PWPS",157,0)
 S @ROOT@(ZN,0)="                " S ZN=ZN+1
"RTN","C0PWPS",158,0)
 S @ROOT@(ZN,0)="    Source:  ePrescribing          " S ZN=ZN+1
"RTN","C0PWPS",159,0)
 S @ROOT@(ZN,0)="                " S ZN=ZN+1
"RTN","C0PWPS",160,0)
 N ZI S ZI=""
"RTN","C0PWPS",161,0)
 F  S ZI=$O(ZCOM(ZI)) Q:ZI=""  D   ;
"RTN","C0PWPS",162,0)
 . S @ROOT@(12+ZI,0)=ZCOM(ZI) ;COMMENT LINE
"RTN","C0PWPS",163,0)
 Q
"RTN","C0PWPS",164,0)
 ;
"RTN","C0PWS1")
0^2^B158660722
"RTN","C0PWS1",1,0)
C0PWS1   ; ERX/GPL - Web Service utilities; 8/31/09 ; 5/9/12 12:14am
"RTN","C0PWS1",2,0)
 ;;1.0;C0P;;Apr 25, 2012;Build 103
"RTN","C0PWS1",3,0)
 ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"RTN","C0PWS1",4,0)
 ;General Public License See attached copy of the License.
"RTN","C0PWS1",5,0)
 ;
"RTN","C0PWS1",6,0)
 ;This program is free software; you can redistribute it and/or modify
"RTN","C0PWS1",7,0)
 ;it under the terms of the GNU General Public License as published by
"RTN","C0PWS1",8,0)
 ;the Free Software Foundation; either version 2 of the License, or
"RTN","C0PWS1",9,0)
 ;(at your option) any later version.
"RTN","C0PWS1",10,0)
 ;
"RTN","C0PWS1",11,0)
 ;This program is distributed in the hope that it will be useful,
"RTN","C0PWS1",12,0)
 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0PWS1",13,0)
 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"RTN","C0PWS1",14,0)
 ;GNU General Public License for more details.
"RTN","C0PWS1",15,0)
 ;
"RTN","C0PWS1",16,0)
 ;You should have received a copy of the GNU General Public License along
"RTN","C0PWS1",17,0)
 ;with this program; if not, write to the Free Software Foundation, Inc.,
"RTN","C0PWS1",18,0)
 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
"RTN","C0PWS1",19,0)
 ;
"RTN","C0PWS1",20,0)
 Q
"RTN","C0PWS1",21,0)
 ;
"RTN","C0PWS1",22,0)
 ; TEST Lines below not intended for End Users. Programmers only.
"RTN","C0PWS1",23,0)
 ; BEWARE ZWRITE SYNTAX. It may not work in other M Implementations.
"RTN","C0PWS1",24,0)
TEST(C0PDUZ,C0PDFN) ; TEST RETRIEVAL OF PATIENT1 MEDS
"RTN","C0PWS1",25,0)
 ;S DEBUG=1 ;
"RTN","C0PWS1",26,0)
 D SOAP("C0POUT",6,C0PDUZ,C0PDFN)
"RTN","C0PWS1",27,0)
 ZWRITE C0POUT
"RTN","C0PWS1",28,0)
 Q
"RTN","C0PWS1",29,0)
 ;
"RTN","C0PWS1",30,0)
ACCOUNTF()  Q 113059002  ; file number for account file
"RTN","C0PWS1",31,0)
XMLFN()  Q 113059001  ; XML TEMPLATE FILE NUMBER
"RTN","C0PWS1",32,0)
BINDFN()  Q 113059001.04 ; FILE NUMBER FOR BINDING SUBFILE
"RTN","C0PWS1",33,0)
 ;
"RTN","C0PWS1",34,0)
GETTID(C0PWS,C0PTNAME) ; EXTRINSIC WHICH RETURNS THE TEMPLATE ID FOR
"RTN","C0PWS1",35,0)
 ; TEMPLATE NAMED C0PTNAME BELONGING TO WEB SERVICE NAMED C0PWS
"RTN","C0PWS1",36,0)
 ; ALSO WORKS IF THE ACCOUNT NUMBER IS PASSED IN C0PWS
"RTN","C0PWS1",37,0)
 S C0PXF=113059001 ; FILE NUMBER FOR THE C0P XML TEMPLATE FILE
"RTN","C0PWS1",38,0)
 S C0PAF=113059002 ; FILE NUMBER FOR THE C0P WS ACCT FILE
"RTN","C0PWS1",39,0)
 N C0PA,C0PT ; C0P ACCOUNT AND C0P TEMPLATE
"RTN","C0PWS1",40,0)
 I C0PWS>0 S C0PA=C0PWS
"RTN","C0PWS1",41,0)
 E  D  ; NAME NOT RECORD NUMBER IS PASSED FOR ACCOUNT
"RTN","C0PWS1",42,0)
 . S C0PA=$O(^C0PS("B",C0PWS,"")) ; RECORD NUMBER OF ACCOUNT
"RTN","C0PWS1",43,0)
 . I C0PA="" D  Q  ; OOPS ACCOUNT NOT FOUND
"RTN","C0PWS1",44,0)
 . . W "ACCOUNT "_C0PWS_" NOT FOUND",!
"RTN","C0PWS1",45,0)
 S C0PT=$O(^C0PX("C",C0PA,C0PTNAME,"")) ; RECORD NUMBER OF TEMPLATE
"RTN","C0PWS1",46,0)
 ; WE USE THE C INDEX TO INSURE THAT THE TEMPLATE BELONGS TO THE WEB SERVICE
"RTN","C0PWS1",47,0)
 Q C0PT
"RTN","C0PWS1",48,0)
 ;
"RTN","C0PWS1",49,0)
RESTID(C0PDUZ,C0PTID) ; RESOLVE TEMPLATE ID FROM SUBSCRIPTION
"RTN","C0PWS1",50,0)
 ;
"RTN","C0PWS1",51,0)
 N C0PAIEN S C0PAIEN=$$SUBINIT^C0PSUB(C0PDUZ) ;IEN OF SUBSCRIPTION
"RTN","C0PWS1",52,0)
 N C0PACCT S C0PACCT=$$GET1^DIQ(C0PSUBF,C0PAIEN_","_C0PDUZ_",",1,"I") ;ACCT
"RTN","C0PWS1",53,0)
 N C0PWBS S C0PWBS=$$GET1^DIQ(C0PAF,C0PACCT_",",4,"I") ;WEB SERVICE IEN
"RTN","C0PWS1",54,0)
 N C0PUTID S C0PUTID=$$GETTID(C0PWBS,C0PTID) ;TEMPLATE ID
"RTN","C0PWS1",55,0)
 Q C0PUTID
"RTN","C0PWS1",56,0)
 ;
"RTN","C0PWS1",57,0)
SOAP(C0PRTN,C0PTID,C0PDUZ,C0PDFN,C0PVOR) ; MAKES A SOAP CALL FOR 
"RTN","C0PWS1",58,0)
 ; TEMPLATE ID C0PTID
"RTN","C0PWS1",59,0)
 ; RETURNS THE XML RESULT IN C0PRTN, PASSED BY NAME
"RTN","C0PWS1",60,0)
 ; C0PVOR IS THE NAME OF A VARIABLE OVERRIDE ARRAY, WHICH IS APPLIED 
"RTN","C0PWS1",61,0)
 ; BEFORE MAPPING
"RTN","C0PWS1",62,0)
 ;
"RTN","C0PWS1",63,0)
 ; ARTIFACTS SECTION
"RTN","C0PWS1",64,0)
 ; THE FOLLOWING WILL SET UP DEBUGGING ARTIFACTS FOR A POSSIBLE FUTURE
"RTN","C0PWS1",65,0)
 ; ONLINE DEBUGGER. IF DEBUG=1, VARIABLES CONTAINING INTERMEDIATE RESULTS
"RTN","C0PWS1",66,0)
 ; WILL NOT BE NEWED.
"RTN","C0PWS1",67,0)
 I $G(DEBUG)="" N C0PV ; CATALOG OF ARTIFACT VARIABLES AND ARRAYS
"RTN","C0PWS1",68,0)
 S C0PV(100,"C0PXF","XML TEMPLATE FILE NUMBER")=""
"RTN","C0PWS1",69,0)
 S C0PV(200,"C0PHEAD","SOAP HEADER VARIABLE NAME")=""
"RTN","C0PWS1",70,0)
 S C0PV(300,"header","SOAP HEADER")=""
"RTN","C0PWS1",71,0)
 S C0PV(400,"C0PMIME","MIME TYPE")=""
"RTN","C0PWS1",72,0)
 S C0PV(500,"C0PURL","WS URL")=""
"RTN","C0PWS1",73,0)
 S C0PV(550,"C0PPURL","PROXY URL")=""
"RTN","C0PWS1",74,0)
 S C0PV(600,"C0PXML","XML VARIABLE NAME")=""
"RTN","C0PWS1",75,0)
 S C0PV(700,"xml","OUTBOUND XML")=""
"RTN","C0PWS1",76,0)
 S C0PV(800,"C0PRSLT","RAW XML RESULT RETURNED FROM WEB SERVICE")=""
"RTN","C0PWS1",77,0)
 S C0PV(900,"C0PRHDR","RETURNED HEADER")=""
"RTN","C0PWS1",78,0)
 S C0PV(1000,"C0PRXML","XML RESULT NORMALIZED")=""
"RTN","C0PWS1",79,0)
 S C0PV(1100,"C0PR","REPLY TEMPLATE")=""
"RTN","C0PWS1",80,0)
 S C0PV(1200,"C0PREDUX","REDUX STRING")=""
"RTN","C0PWS1",81,0)
 S C0PV(1300,"C0PIDX","RESULT XPATH INDEX")=""
"RTN","C0PWS1",82,0)
 S C0PV(1400,"C0PARY","RESULT XPATH ARRAY")=""
"RTN","C0PWS1",83,0)
 S C0PV(1500,"C0PNOM","RESULT DOM DOCUMENT NAME")=""
"RTN","C0PWS1",84,0)
 S C0PV(1600,"C0PID","RESULT DOM ID")=""
"RTN","C0PWS1",85,0)
 I $G(DEBUG)'="" G NOTNEW ; SKIP NEWING THE VARIABLES IF IN DEBUG
"RTN","C0PWS1",86,0)
 N ZI,ZJ S ZI=""
"RTN","C0PWS1",87,0)
NEW ; new the variables
"RTN","C0PWS1",88,0)
 S ZI=$O(C0PV(ZI))
"RTN","C0PWS1",89,0)
 S ZJ=$O(C0PV(ZI,"")) ; SET UP NEW COMMAND
"RTN","C0PWS1",90,0)
 ;W ZJ,!
"RTN","C0PWS1",91,0)
 N @ZJ ; NEW THE VARIABLE
"RTN","C0PWS1",92,0)
 I $O(C0PV(ZI))'="" G NEW ;LOOP TO GET NEW IN CONTEXT
"RTN","C0PWS1",93,0)
NOTNEW ; (goto label) don't new the variables... skip that
"RTN","C0PWS1",94,0)
 ; END ARTIFACTS
"RTN","C0PWS1",95,0)
 ;
"RTN","C0PWS1",96,0)
 D INITXPF("C0PF") ; SET FILE NUMBER AND PARAMATERS 
"RTN","C0PWS1",97,0)
 S C0PXF=C0PF("XML FILE NUMBER") ; FILE NUMBER FOR THE C0P XML TEMPLATE FILE
"RTN","C0PWS1",98,0)
 I +C0PTID=0 D  ; A STRING WAS PASSED FOR THE TEMPLATE NAME
"RTN","C0PWS1",99,0)
 . S C0PUTID=$$RESTID(C0PDUZ,C0PTID) ;RESOLVE TEMPLATE IEN FROM NAME
"RTN","C0PWS1",100,0)
 E  S C0PUTID=C0PTID ; AN IEN WAS PASSED
"RTN","C0PWS1",101,0)
 N xml,template,header
"RTN","C0PWS1",102,0)
 S C0PHEAD=$$GET1^DIQ(C0PXF,C0PUTID_",",2.2,,"header")
"RTN","C0PWS1",103,0)
 S C0PMIME=$$GET1^DIQ(C0PXF,C0PUTID_",","MIME TYPE")
"RTN","C0PWS1",104,0)
 S C0PPURL=$$GET1^DIQ(C0PXF,C0PUTID_",","PROXY SERVER")
"RTN","C0PWS1",105,0)
 ;S C0PURL=$$GET1^DIQ(C0PXF,C0PUTID_",","URL") ;GPL CHANGE TO USE PROD FLAG
"RTN","C0PWS1",106,0)
 D SETUP^C0PMAIN() ; INITIALIZE C0PACCT IEN OF WS ACCOUNT
"RTN","C0PWS1",107,0)
 S C0PURL=$$WSURL^C0PMAIN(C0PACCT) ; RESOLVES PRODUCTION VS TEST
"RTN","C0PWS1",108,0)
 S C0PXML=$$GET1^DIQ(C0PXF,C0PUTID_",",2.1,,"xml")
"RTN","C0PWS1",109,0)
 S C0PTMPL=$$GET1^DIQ(C0PXF,C0PUTID_",",3,,"template")
"RTN","C0PWS1",110,0)
 I C0PTMPL="template" D  ; there is a template to process
"RTN","C0PWS1",111,0)
 . K xml ; going to replace the xml array
"RTN","C0PWS1",112,0)
 . D EN^C0PMAIN("xml","url",C0PDUZ,C0PDFN,C0PUTID,$G(C0PVOR))
"RTN","C0PWS1",113,0)
 . ;N ZZG M ZZG(1)=xml
"RTN","C0PWS1",114,0)
 . ;S ZDIR=^TMP("C0CCCR","ODIR")
"RTN","C0PWS1",115,0)
 . ;ZWR ZZG(1)
"RTN","C0PWS1",116,0)
 . ;W $$OUTPUT^C0CXPATH("xml(1)","GPLTEST-"_ZDFN_".xml",ZDIR)
"RTN","C0PWS1",117,0)
 I $G(C0PPROXY) S C0PURL=C0PPURL
"RTN","C0PWS1",118,0)
 I '$D(C0PERROR) S C0PERROR="0^NO ERRORS" ; to do: start using this gpl
"RTN","C0PWS1",119,0)
 K C0PRSLT,C0PRHDR
"RTN","C0PWS1",120,0)
 ;
"RTN","C0PWS1",121,0)
 ; token to catch runaway linux jobs - gpl 4/12/2012
"RTN","C0PWS1",122,0)
 ; But not ready for release b/c depends on code that is not available --smh 5/9/12
"RTN","C0PWS1",123,0)
 ; D LOG^C0PTRAK($J,"PULLBACK")
"RTN","C0PWS1",124,0)
 ;
"RTN","C0PWS1",125,0)
 S ok=$$httpPOST^%zewdGTM(C0PURL,.xml,C0PMIME,.C0PRSLT,.header,"",.gpl5,.C0PRHDR)
"RTN","C0PWS1",126,0)
 ;
"RTN","C0PWS1",127,0)
 ; kill token after return from EWD
"RTN","C0PWS1",128,0)
 ;
"RTN","C0PWS1",129,0)
 ;D UNLOG^C0PTRAK($J) ; success, remove the token ; smh commented out 5/9/12
"RTN","C0PWS1",130,0)
 ;K ^TMP("C0PERX",$J)
"RTN","C0PWS1",131,0)
 K C0PRXML
"RTN","C0PWS1",132,0)
 ;I DUZ=135 B  ; patch so others can use the pullback while i debug - gpl
"RTN","C0PWS1",133,0)
 ;. ;I $D(C0PRSLT(1)) D NORMAL("C0PRXML","C0PRSLT(1)") ;RETURN XML IN AN ARRAY
"RTN","C0PWS1",134,0)
 ;. I $D(C0PRSLT(1)) D CHUNK("C0PRXML","C0PRSLT",2000) ;RETURN IN AN ARRAY  
"RTN","C0PWS1",135,0)
 ;. ; SWITCHED TO CHUNK TO HANDLE ARRAYS OF XML
"RTN","C0PWS1",136,0)
 ;E  I $D(C0PRSLT(1)) D NORMAL("C0PRXML","C0PRSLT(1)") ;RETURN XML IN AN ARRAY
"RTN","C0PWS1",137,0)
 ; The following is a temporary fix to keep eRx working while a better 
"RTN","C0PWS1",138,0)
 ; solution is developed. Template ID 6 is GETMEDS for eRx and it needs
"RTN","C0PWS1",139,0)
 ; to handle xml files that are too big for NORMAL to handle. So, I wrote
"RTN","C0PWS1",140,0)
 ; CHUNK which will allow us to handle any size xml file bound for the
"RTN","C0PWS1",141,0)
 ; EWD parser. 
"RTN","C0PWS1",142,0)
 ; However, all the other templates in eRx need NORMAL to find the 
"RTN","C0PWS1",143,0)
 ; embedded XML file in their web service responses. So, we will use
"RTN","C0PWS1",144,0)
 ; CHUNK for template 6 and continue to use NORMAL for all other templates
"RTN","C0PWS1",145,0)
 ; we can handle big med lists, but not big web service calls.
"RTN","C0PWS1",146,0)
 ; What is needed is a better NORMAL (see NORMAL2) or another routine
"RTN","C0PWS1",147,0)
 ; to detect, extract, and decode embeded XML files of any size. gpl 10/8/10
"RTN","C0PWS1",148,0)
 I C0PUTID=6 D  ;
"RTN","C0PWS1",149,0)
 . I $D(C0PRSLT(1)) D CHUNK("C0PRXML","C0PRSLT",2000) ;RETURN IN AN ARRAY  
"RTN","C0PWS1",150,0)
 E  I $D(C0PRSLT(1)) D NORMAL("C0PRXML","C0PRSLT(1)") ;RETURN XML IN AN ARRAY
"RTN","C0PWS1",151,0)
 S C0PR=$$GET1^DIQ(C0PXF,C0PUTID_",",.03,"I") ; REPLY TEMPLATE
"RTN","C0PWS1",152,0)
 ; reply templates are optional and are specified by populating a
"RTN","C0PWS1",153,0)
 ; template pointer in field 2.5 of the request template
"RTN","C0PWS1",154,0)
 ; if specified, the reply template is the source of the REDUX string
"RTN","C0PWS1",155,0)
 ; used for XPath on the reply, and for UNBIND processing
"RTN","C0PWS1",156,0)
 ; if no reply template is specified, REDUX is obtained from the request
"RTN","C0PWS1",157,0)
 ; template and no UNBIND processing is performed. The XPath array is
"RTN","C0PWS1",158,0)
 ; returned without variable bindings
"RTN","C0PWS1",159,0)
 I C0PR'="" D  ; REPLY TEMPLATE EXISTS
"RTN","C0PWS1",160,0)
 . I +$G(DEBUG)'=0 W "REPLY TEMPLATE:",C0PR,!
"RTN","C0PWS1",161,0)
 . S C0PTID=C0PR ;
"RTN","C0PWS1",162,0)
 S C0PREDUX=$$GET1^DIQ(C0PXF,C0PUTID_",",2.5) ;XPATH REDUCTION STRING
"RTN","C0PWS1",163,0)
 K C0PIDX,C0PARY ; XPATH INDEX AND ARRAY VARS
"RTN","C0PWS1",164,0)
 S C0PNOM="C0PMEDS"_$J ; DOCUMENT NAME FOR THE DOM
"RTN","C0PWS1",165,0)
 N ZBIG S ZBIG=0
"RTN","C0PWS1",166,0)
 I C0PUTID'=6 D  ;
"RTN","C0PWS1",167,0)
 . S ZBIG=$$TOOBIG("C0PRXML") ; PATCH BY GPL WHICH ASSUMES ONLY
"RTN","C0PWS1",168,0)
 . ; TEMPLATE 1 IS A REGULAR XML FILE.. EVERYTHING ELSE HAS EMBEDDED XML
"RTN","C0PWS1",169,0)
 I ZBIG>0 D  ; PROBABLY AN EMBEDDED XML DOCUMENT
"RTN","C0PWS1",170,0)
 . S C0PID=$$UNWRAP("C0PRXML",ZBIG,C0PNOM) ; DECODE AND PARSE THE EMBEDED XML
"RTN","C0PWS1",171,0)
 E  S C0PID=$$PARSE^C0PXEWD("C0PRXML",C0PNOM) ;CALL THE PARSER
"RTN","C0PWS1",172,0)
 ;S C0PID=$$PARSE^C0PXEWD("C0PRXML",C0PNOM) ;CALL THE PARSER
"RTN","C0PWS1",173,0)
 S C0PID=$$FIRST^C0PXEWD($$ID^C0PXEWD(C0PNOM)) ;ID OF FIRST NODE
"RTN","C0PWS1",174,0)
 D XPATH^C0PXEWD(C0PID,"/","C0PIDX","C0PARY","",C0PREDUX) ;XPATH GENERATOR
"RTN","C0PWS1",175,0)
 S OK=$$DELETE^C0PXEWD(C0PNOM) ; REMOVE PARSED XML FROM THE EWD DOM
"RTN","C0PWS1",176,0)
 ; Next, call UNBIND to map the reply XPath array to variables
"RTN","C0PWS1",177,0)
 ; This is only done if a Reply Template is provided
"RTN","C0PWS1",178,0)
 D DEMUXARY(C0PRTN,"C0PARY")
"RTN","C0PWS1",179,0)
 ; M @C0PRTN=C0PARY
"RTN","C0PWS1",180,0)
 Q
"RTN","C0PWS1",181,0)
 ;
"RTN","C0PWS1",182,0)
TOOBIG(ZXML) ; EXTRINSIC WHICH RETURNS TRUE IF ANY NODE IS OVER 2000 CHARS
"RTN","C0PWS1",183,0)
 ; RETURNS THE INDEX OF THE LARGE NODE . IF NO LARGE NODE, RETURNS ZERO
"RTN","C0PWS1",184,0)
 N ZI,ZR
"RTN","C0PWS1",185,0)
 S ZI=""
"RTN","C0PWS1",186,0)
 S ZR=0 ; DEFAULT FALSE
"RTN","C0PWS1",187,0)
 F  S ZI=$O(@ZXML@(ZI)) Q:ZI=""  D  ;
"RTN","C0PWS1",188,0)
 . I $L(@ZXML@(ZI))>1000 S ZR=ZI
"RTN","C0PWS1",189,0)
 Q ZR
"RTN","C0PWS1",190,0)
 ;
"RTN","C0PWS1",191,0)
NORMAL(OUTXML,INXML) ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML
"RTN","C0PWS1",192,0)
 ; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME
"RTN","C0PWS1",193,0)
 ;
"RTN","C0PWS1",194,0)
 N ZI,ZN,ZTMP
"RTN","C0PWS1",195,0)
 S ZN=1
"RTN","C0PWS1",196,0)
 S @OUTXML@(ZN)=$P(@INXML,"><",ZN)_">"
"RTN","C0PWS1",197,0)
 S ZN=ZN+1
"RTN","C0PWS1",198,0)
 F  S @OUTXML@(ZN)="<"_$P(@INXML,"><",ZN) Q:$P(@INXML,"><",ZN+1)=""  D  ;
"RTN","C0PWS1",199,0)
 . S @OUTXML@(ZN)=@OUTXML@(ZN)_">"
"RTN","C0PWS1",200,0)
 . S ZN=ZN+1
"RTN","C0PWS1",201,0)
 Q
"RTN","C0PWS1",202,0)
 ;
"RTN","C0PWS1",203,0)
CHUNK(OUTXML,INXML,ZSIZE) ; BREAKS INXML INTO ZSIZE BLOCKS
"RTN","C0PWS1",204,0)
 ; INXML IS AN ARRAY PASSED BY NAME OF STRINGS
"RTN","C0PWS1",205,0)
 ; OUTXML IS ALSO PASSED BY NAME
"RTN","C0PWS1",206,0)
 ; IF ZSIZE IS NOT PASSED, 1000 IS USED
"RTN","C0PWS1",207,0)
 I '$D(ZSIZE) S ZSIZE=1000 ; DEFAULT BLOCK SIZE
"RTN","C0PWS1",208,0)
 N ZB,ZI,ZJ,ZK,ZL,ZN
"RTN","C0PWS1",209,0)
 S ZB=ZSIZE-1
"RTN","C0PWS1",210,0)
 S ZN=1
"RTN","C0PWS1",211,0)
 S ZI=0 ; BEGINNING OF INDEX TO INXML
"RTN","C0PWS1",212,0)
 F  S ZI=$O(@INXML@(ZI)) Q:+ZI=0  D  ; FOR EACH STRING IN INXML
"RTN","C0PWS1",213,0)
 . S ZL=$L(@INXML@(ZI)) ; LENGTH OF THE STRING
"RTN","C0PWS1",214,0)
 . F ZJ=1:ZSIZE:ZL D  ;
"RTN","C0PWS1",215,0)
 . . S ZK=$S(ZJ+ZB<ZL:ZJ+ZB,1:ZL) ; END FOR EXTRACT
"RTN","C0PWS1",216,0)
 . . S @OUTXML@(ZN)=$E(@INXML@(ZI),ZJ,ZK) ; PULL OUT THE PIECE
"RTN","C0PWS1",217,0)
 . . S ZN=ZN+1 ; INCREMENT OUT ARRAY INDEX
"RTN","C0PWS1",218,0)
 Q
"RTN","C0PWS1",219,0)
 ;
"RTN","C0PWS1",220,0)
NORMAL2(OUTXML,INXML) ;NORMALIZES AN ARRAY OF XML STRINGS PASSED BY NAME INXML
"RTN","C0PWS1",221,0)
 ; AS @INXML@(1) TO @INXML@(x) ALL NUMERIC
"RTN","C0PWS1",222,0)
 ; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME
"RTN","C0PWS1",223,0)
 ; this routine doesn't work unless the blocks are on xml tag boundaries - gpl
"RTN","C0PWS1",224,0)
 ; which is hard to do... this routine is left here awaiting future development
"RTN","C0PWS1",225,0)
 N ZI,ZN,ZJ
"RTN","C0PWS1",226,0)
 S ZJ=0
"RTN","C0PWS1",227,0)
 S ZN=1
"RTN","C0PWS1",228,0)
 F  S ZJ=$O(@INXML@(ZJ)) Q:+ZJ=0  D  ; FOR EACH XML STRING IN ARRAY
"RTN","C0PWS1",229,0)
 . S @OUTXML@(ZN)=$P(@INXML@(ZJ),"><",ZN)_">"
"RTN","C0PWS1",230,0)
 . S ZN=ZN+1
"RTN","C0PWS1",231,0)
 . F  S @OUTXML@(ZN)="<"_$P(@INXML@(ZJ),"><",ZN) Q:$P(@INXML@(ZJ),"><",ZN+1)=""  D  ;
"RTN","C0PWS1",232,0)
 . . S @OUTXML@(ZN)=@OUTXML@(ZN)_">"
"RTN","C0PWS1",233,0)
 . . S ZN=ZN+1
"RTN","C0PWS1",234,0)
 Q
"RTN","C0PWS1",235,0)
 ;
"RTN","C0PWS1",236,0)
UNWRAP(ZXML,ZI,ZNOM) ; EXTRINSIC TO LOCATE, DECODE AND PARSE AN EMBEDED XML DOC
"RTN","C0PWS1",237,0)
 ; RETURNS THE DOCID OF THE DOM
"RTN","C0PWS1",238,0)
 N ZS,ZX
"RTN","C0PWS1",239,0)
 S ZS=$P($P(@ZXML@(ZI),">",2),"<",1) ; PULL OUT THE ENCODED STRING
"RTN","C0PWS1",240,0)
 S ZX=$$DECODE^RGUTUU(ZS)
"RTN","C0PWS1",241,0)
 N ZZ
"RTN","C0PWS1",242,0)
 N ZY S ZY="<?xml version=""1.0"" encoding=""utf-8""?>"
"RTN","C0PWS1",243,0)
 I $E(ZX,1,5)'="<?xml" S ZZ(1)=ZY_ZX
"RTN","C0PWS1",244,0)
 E  S ZZ(1)=ZX
"RTN","C0PWS1",245,0)
 N ZI
"RTN","C0PWS1",246,0)
 ;F ZI=1:1 Q:$$REDUCE(.ZZ,ZI) ; CHOP THE STRING INTO 4000 CHAR ARRAY
"RTN","C0PWS1",247,0)
 S ZI=$$REDUCRCR(.ZZ,1) ; RECURSIVE VERSION OF REDUCE
"RTN","C0PWS1",248,0)
 S G=$$PARSE^C0PXEWD("ZZ",C0PNOM)
"RTN","C0PWS1",249,0)
 I G=0 D ERROR^C0PMAIN(",U113059005,",$ST($ST,"PLACE"),"ERX-XML-PRS","XML Parsing Error") QUIT  ;ZWR ^TMP("MXMLERR",$J,*) B
"RTN","C0PWS1",250,0)
 Q G
"RTN","C0PWS1",251,0)
 ;
"RTN","C0PWS1",252,0)
REDUCE(ZARY,ZN) ; WILL REDUCE ZARY(ZN) BY CHOPPING IT TO 4000 CHARS
"RTN","C0PWS1",253,0)
 ; AND PUTTING THE REST IN ZARY(ZN+1)
"RTN","C0PWS1",254,0)
 ; ZARY IS PASSED BY REFERENCE
"RTN","C0PWS1",255,0)
 ; EXTRINSIC WHICH RETURNS FALSE IF THERE IS NOTHING TO REDUCE
"RTN","C0PWS1",256,0)
 I $L(ZARY(ZN))<4001 Q 0 ;NOTHING TO REDUCE
"RTN","C0PWS1",257,0)
 S ZARY(ZN+1)=$E(ZARY(ZN),4001,$L(ZZ(ZN))) ;BREAK IT UP
"RTN","C0PWS1",258,0)
 S ZARY(ZN)=$E(ZARY(ZN),1,4000) ;  
"RTN","C0PWS1",259,0)
 Q 1  ;ACTUALLY REDUCED
"RTN","C0PWS1",260,0)
 ;
"RTN","C0PWS1",261,0)
REDUCRCR(ZARY,ZN) ; RECURSIVE VERSION OF REDUCE ABOVE
"RTN","C0PWS1",262,0)
 ; WILL REDUCE ZARY(ZN) BY CHOPPING IT TO 4000 CHARS
"RTN","C0PWS1",263,0)
 ; AND PUTTING THE REST IN ZARY(ZN+1)
"RTN","C0PWS1",264,0)
 ; ZARY IS PASSED BY REFERENCE
"RTN","C0PWS1",265,0)
 ; EXTRINSIC WHICH RETURNS FALSE IF THERE IS NOTHING TO REDUCE
"RTN","C0PWS1",266,0)
 I $L(ZARY(ZN))<4001 Q 0 ;NOTHING TO REDUCE
"RTN","C0PWS1",267,0)
 S ZARY(ZN+1)=$E(ZARY(ZN),4001,$L(ZZ(ZN))) ;BREAK IT UP
"RTN","C0PWS1",268,0)
 S ZARY(ZN)=$E(ZARY(ZN),1,4000) ;  
"RTN","C0PWS1",269,0)
 I '$$REDUCRCR(.ZARY,ZN+1) Q 1 ; CALL RECURSIVELY
"RTN","C0PWS1",270,0)
 Q 1  ;ACTUALLY REDUCED
"RTN","C0PWS1",271,0)
 ;
"RTN","C0PWS1",272,0)
DEMUXARY(OARY,IARY) ;CONVERT AN XPATH ARRAY PASSED AS IARY TO
"RTN","C0PWS1",273,0)
 ; FORMAT @OARY@(x,xpath) where x is the first multiple
"RTN","C0PWS1",274,0)
 N ZI,ZJ,ZK,ZL S ZI=""
"RTN","C0PWS1",275,0)
 F  S ZI=$O(@IARY@(ZI)) Q:ZI=""  D  ;
"RTN","C0PWS1",276,0)
 . D DEMUX^C0CMXP("ZJ",ZI)
"RTN","C0PWS1",277,0)
 . S ZK=$P(ZJ,"^",3)
"RTN","C0PWS1",278,0)
 . S ZK=$RE($P($RE(ZK),"/",1))
"RTN","C0PWS1",279,0)
 . S ZL=$P(ZJ,"^",1)
"RTN","C0PWS1",280,0)
 . I ZL="" S ZL=1
"RTN","C0PWS1",281,0)
 . S @OARY@(ZL,ZK)=@IARY@(ZI)
"RTN","C0PWS1",282,0)
 Q
"RTN","C0PWS1",283,0)
 ;
"RTN","C0PWS1",284,0)
 ; BEGIN OLD CODE - REMOVE AFTER A WHILE WHEN "SOAP" SETTLES DOWN - GPL
"RTN","C0PWS1",285,0)
 ;s URL="http://preproduction.newcropaccounts.com/InterfaceV7/Doctor.xml"
"RTN","C0PWS1",286,0)
 ;D GETPOST1(URL) ;
"RTN","C0PWS1",287,0)
 ;N I,J
"RTN","C0PWS1",288,0)
 ;S J=$O(gpl(""),-1) ; count of things in gpl
"RTN","C0PWS1",289,0)
 ;F I=1:1:J S gpl(I)=$$CLEAN^C0PEWDU(gpl(I))
"RTN","C0PWS1",290,0)
 ;I $$GET1^DIQ(113059001,"3,",2.1,,"gpl")'="gpl" D  Q  ; ERR GETTING TEMPLATE
"RTN","C0PWS1",291,0)
 ;. W "ERROR RETRIEVING TEMPLATE",!
"RTN","C0PWS1",292,0)
 ;S gpl(1)="RxInput="_gpl(1)
"RTN","C0PWS1",293,0)
 S url="https://preproduction.newcropaccounts.com/InterfaceV7/RxEntry.aspx"
"RTN","C0PWS1",294,0)
 S url="https://secure.newcropaccounts.com/V7/WebServices/Doctor.asmx"
"RTN","C0PWS1",295,0)
 S url="http://76.110.202.22/v7/WebServices/Doctor.asmx" ;RICHARD'S SOAP PROXY SERVER
"RTN","C0PWS1",296,0)
 ;S url="http://76.110.202.22/" ;RICHARD'S SOAP PROXY SERVER
"RTN","C0PWS1",297,0)
 N header
"RTN","C0PWS1",298,0)
 S ZH=$$GET1^DIQ(113059001,"3,",2.2,,"header")
"RTN","C0PWS1",299,0)
 ;W $$OUTPUT^C0CXPATH("gpl(1)","NewCropV7-DOCTOR2.xml","/home/dev/CCR/"),!
"RTN","C0PWS1",300,0)
 S ok=$$httpPOST^%zewdGTM(url,.gpl,"text/xml; charset=utf-8",.gpl6,.header,"",.gpl5,.gpl7)
"RTN","C0PWS1",301,0)
 ;S ok=$$httpPOST2(.RTN,url,.gpl,"text/xml; charset=utf-8",.gpl6,.header,"",.gpl5,.gpl7)
"RTN","C0PWS1",302,0)
 ;S ok=$$httpPOST2(.RTN,"https://preproduction.newcropaccounts.com/InterfaceV7/RxEntry.aspx",.gpl,"application/x-www-form-urlencoded",.gpl6,"","",.gpl5,.gpl7)
"RTN","C0PWS1",303,0)
 ZWRITE gpl6 ; smh: this zwrite is never reached.
"RTN","C0PWS1",304,0)
 Q
"RTN","C0PWS1",305,0)
PARSE(INXML,INDOC) ;CALL THE EWD PARSER ON INXML, PASSED BY NAME
"RTN","C0PWS1",306,0)
 ; INDOC IS PASSED AS THE DOCUMENT NAME TO EWD
"RTN","C0PWS1",307,0)
 ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY EWD
"RTN","C0PWS1",308,0)
 N ZR
"RTN","C0PWS1",309,0)
 M ^CacheTempEWD($j)=@INXML ;
"RTN","C0PWS1",310,0)
 S ZR=$$parseDocument^%zewdHTMLParser(INDOC)
"RTN","C0PWS1",311,0)
 K ^CacheTempEWD($j) ;clean up after
"RTN","C0PWS1",312,0)
 Q ZR
"RTN","C0PWS1",313,0)
 ;
"RTN","C0PWS1",314,0)
ADDWS(WSNAME,WSTNAM,WSURL) ; ADD A WEB SERVICE TEMPLATE GIVEN A WSDL URL
"RTN","C0PWS1",315,0)
 ; WSNAME IS THE NAME OF THE WEB SERVICE.. WILL BE LAYGO
"RTN","C0PWS1",316,0)
 ; WSTNAM IS THE TEMPLATE NAME TO BE ADDED TO BE CREATED AND IMPORTED
"RTN","C0PWS1",317,0)
 ; WSURL IS THE URL TO THE WSDL DEFINITION OF THE TEMPLATE
"RTN","C0PWS1",318,0)
 ; WILL FIRST TRY AND FETCH THE XML FROM THE INTERNET USING THE URL
"RTN","C0PWS1",319,0)
 ; IF SUCCESSFUL, AND THE RETURN XML IS VALID, AN ENTRY IN THE XML TEMPLATE
"RTN","C0PWS1",320,0)
 ; FILE WILL BE CREATED, WITH THE RAW XML AND DERIVED TEMPLATE XML.
"RTN","C0PWS1",321,0)
 ; THEN ENTRIES IN THE BINDING SUBFILE WILL BE CREATED FOR EACH XPATH
"RTN","C0PWS1",322,0)
 ; FINALLY, THE TEMPLATE WILL BE POINTED TO IN THE WEB SERVICE FILE TEMPLATE
"RTN","C0PWS1",323,0)
 ; MULTIPLE
"RTN","C0PWS1",324,0)
 N C0PWSF S C0PWSF=113059003 ; WEB SERVICE FILE
"RTN","C0PWS1",325,0)
 N C0PXTF S C0PXTF=113059001 ; XML TEMPLATE FILE
"RTN","C0PWS1",326,0)
 ; NEVER MIND... WRONG APPROACH
"RTN","C0PWS1",327,0)
 Q
"RTN","C0PWS1",328,0)
 ;
"RTN","C0PWS1",329,0)
TBLD(INT) ; TEMPLATE BUILD OF TEMPLATE INT
"RTN","C0PWS1",330,0)
 ; want to break this up into pieces -  gpl
"RTN","C0PWS1",331,0)
 ; THE TEMPLATE NEEDS TO EXIST AND THE DEFINING XML URL MUST BE POPULATED
"RTN","C0PWS1",332,0)
 ; THEN THE DEFINING XML WILL BE RETRIVED AND STORED INTO THE RAW XML FIELD
"RTN","C0PWS1",333,0)
 ; IT WILL BE TRANSFORMED INTO A TEMPLATE AND STORED IN THE TEMPLATE FIELD
"RTN","C0PWS1",334,0)
 ; ALL THE XPATHs WILL BE EXTRACTED AND A BINDING MULTIPLE CREATED FOR EACH
"RTN","C0PWS1",335,0)
 ; ALL IN ONE SIMPLE ROUTINE
"RTN","C0PWS1",336,0)
 ; WHAT REMAINS IS FOR MANUAL ENTRY OF THE OTHER FIELDS IN THE BINDINGS
"RTN","C0PWS1",337,0)
 N C0PXTF S C0PXTF=113059001 ; XML TEMPLATE FILE
"RTN","C0PWS1",338,0)
 N C0PURL ; URL TO RETRIEVE THE DEFINING XML FOR THE TEMPLATE
"RTN","C0PWS1",339,0)
 S C0PURL=$$GET1^DIQ(C0PXTF,INT,2)
"RTN","C0PWS1",340,0)
 D GET1URL^C0PEWD2(C0PURL)
"RTN","C0PWS1",341,0)
 D CLEAN^DILF
"RTN","C0PWS1",342,0)
 ; D WP^DIE(ZF,ZIEN_",",1,,$NA(@ZOR@(ZD,ZI,"TX"))) ; WP OF ORDER TXT
"RTN","C0PWS1",343,0)
 D WP^DIE(C0PXTF,INT_",",2.1,,$NA(gpl))
"RTN","C0PWS1",344,0)
 D WP^DIE(C0PXTF,INT_",",3,,$NA(gplTEMP))
"RTN","C0PWS1",345,0)
 ;N C0PFDA ; DON'T NEW FOR TESTING
"RTN","C0PWS1",346,0)
 D ADDXP("gpl2",INT)
"RTN","C0PWS1",347,0)
 Q
"RTN","C0PWS1",348,0)
 ;
"RTN","C0PWS1",349,0)
COMPILE(INTID) ;COMPILE A XML TEMPLATE IN RECORD INTID
"RTN","C0PWS1",350,0)
 ;
"RTN","C0PWS1",351,0)
 D INITXPF("C0PF") ;FILE ARRAY TO POINT TO C0P FILES
"RTN","C0PWS1",352,0)
 D COMPILE^C0CMXP(INTID,"C0PF") ;COMPILE THE TEMPLATE
"RTN","C0PWS1",353,0)
 Q
"RTN","C0PWS1",354,0)
 ;
"RTN","C0PWS1",355,0)
CPBIND(INID,OUTID,FORCE) ; COPIES XPATH BINDINGS FROM TEMPLATE INID
"RTN","C0PWS1",356,0)
 ; TO TEMPLATE OUTID - ONLY BINDINGS FOR MATCHING XPATHS ARE COPIED
"RTN","C0PWS1",357,0)
 ; NOTE - REDO THIS TO USE FILEMAN CALLS GPL
"RTN","C0PWS1",358,0)
 ; WILL NOT OVERWRITE UNLESS FORCE=1
"RTN","C0PWS1",359,0)
 N FARY S FARY="C0PF"
"RTN","C0PWS1",360,0)
 D INITXPF("C0PF")
"RTN","C0PWS1",361,0)
 I +OUTID=0 S OUTID=$$RESTID^C0CSOAP(OUTID,FARY) ;RESOLVE TEMPLATE NAME
"RTN","C0PWS1",362,0)
 I +INID=0 S INID=$$RESTID^C0CSOAP(INID,FARY) ;RESOLVE TEMPLATE NAME
"RTN","C0PWS1",363,0)
 N ZI
"RTN","C0PWS1",364,0)
 S ZI=0
"RTN","C0PWS1",365,0)
 F  S ZI=$O(^C0PX(OUTID,5,ZI)) Q:+ZI=0  D  ; FOR EACH XPATH IN OUTID
"RTN","C0PWS1",366,0)
 . W !,ZI," ",^C0PX(OUTID,5,ZI,0)
"RTN","C0PWS1",367,0)
 . S ZN=^C0PX(OUTID,5,ZI,0)
"RTN","C0PWS1",368,0)
 . I $D(^C0PX(OUTID,5,ZI,1)) D  ;Q  ;
"RTN","C0PWS1",369,0)
 . . W !,"ERROR XPATH BINDING EXISTS ",ZI
"RTN","C0PWS1",370,0)
 . D  ; LOOK FOR MATCHING XPATH IN SOURCE
"RTN","C0PWS1",371,0)
 . . S ZJ=$O(^C0PX(INID,5,"B",ZN,""))
"RTN","C0PWS1",372,0)
 . . ;W " FOUND:",ZJ
"RTN","C0PWS1",373,0)
 . . I ZJ'="" D  ;
"RTN","C0PWS1",374,0)
 . . . ;W !,"SETTING ",$G(^C0PX(INID,5,ZJ,1))
"RTN","C0PWS1",375,0)
 . . . S ^C0PX(OUTID,5,ZI,0)=^C0PX(INID,5,ZJ,0) ;GET BOTH FIELDS
"RTN","C0PWS1",376,0)
 . . . S ^C0PX(OUTID,5,ZI,1)=$G(^C0PX(INID,5,ZJ,1))
"RTN","C0PWS1",377,0)
 Q
"RTN","C0PWS1",378,0)
 ;
"RTN","C0PWS1",379,0)
INITXPF(ARY) ;INITIAL XML/XPATH FILE ARRAY
"RTN","C0PWS1",380,0)
 ;
"RTN","C0PWS1",381,0)
 S @ARY@("XML FILE NUMBER")=113059001
"RTN","C0PWS1",382,0)
 S @ARY@("BINDING SUBFILE NUMBER")=113059001.04
"RTN","C0PWS1",383,0)
 S @ARY@("MIME TYPE")="2.3"
"RTN","C0PWS1",384,0)
 S @ARY@("PROXY SERVER")="2.4"
"RTN","C0PWS1",385,0)
 S @ARY@("REPLY TEMPLATE")=".03"
"RTN","C0PWS1",386,0)
 S @ARY@("TEMPLATE NAME")=".01"
"RTN","C0PWS1",387,0)
 S @ARY@("TEMPLATE XML")="3"
"RTN","C0PWS1",388,0)
 S @ARY@("URL")="1"
"RTN","C0PWS1",389,0)
 S @ARY@("WSDL URL")="2"
"RTN","C0PWS1",390,0)
 S @ARY@("XML")="2.1"
"RTN","C0PWS1",391,0)
 S @ARY@("XML HEADER")="2.2"
"RTN","C0PWS1",392,0)
 S @ARY@("XPATH REDUCTION STRING")="2.5"
"RTN","C0PWS1",393,0)
 S @ARY@("CCR VARIABLE")="4"
"RTN","C0PWS1",394,0)
 S @ARY@("FILEMAN FIELD NAME")="1"
"RTN","C0PWS1",395,0)
 S @ARY@("FILEMAN FIELD NUMBER")="1.2"
"RTN","C0PWS1",396,0)
 S @ARY@("FILEMAN FILE POINTER")="1.1"
"RTN","C0PWS1",397,0)
 S @ARY@("INDEXED BY")=".05"
"RTN","C0PWS1",398,0)
 S @ARY@("SQLI FIELD NAME")="3"
"RTN","C0PWS1",399,0)
 S @ARY@("VARIABLE NAME")="2"
"RTN","C0PWS1",400,0)
 Q
"RTN","C0PWS1",401,0)
 ;
"RTN","C0PWS1",402,0)
ADDXP(INARY,TID) ;ADD XPATH .01 FIELD TO BINDING SUBFILE OF TEMPLATE TID
"RTN","C0PWS1",403,0)
 N FARY S FARY="C0PFILES"
"RTN","C0PWS1",404,0)
 D INITXPF(FARY)
"RTN","C0PWS1",405,0)
 D ADDXP^C0CMXP(INARY,TID,FARY) ;
"RTN","C0PWS1",406,0)
 Q
"RTN","C0PWS1",407,0)
 ; 
"RTN","C0PWS1",408,0)
ADDXML(INXML,TEMPID) ;ADD XML TO A TEMPLATE ID TEMPID
"RTN","C0PWS1",409,0)
 ; INXML IS PASSED BY NAME
"RTN","C0PWS1",410,0)
 N FARY S FARY="C0PFILES"
"RTN","C0PWS1",411,0)
 D INITXPF(FARY)
"RTN","C0PWS1",412,0)
 D ADDXML^C0CMXP(INXML,TEMPID,FARY) ;CALL C0C ROUTINE TO ADD TO THE FILE
"RTN","C0PWS1",413,0)
 Q
"RTN","C0PWS1",414,0)
 ;
"RTN","C0PWS1",415,0)
ADDTEMP(INXML,TEMPID,FARY) ;ADD XML TEMPLATE TO TEMPLATE RECORD TEMPID FIELD 3
"RTN","C0PWS1",416,0)
 ;
"RTN","C0PWS1",417,0)
 N FARY S FARY="C0PFILES"
"RTN","C0PWS1",418,0)
 D INITXPF(FARY)
"RTN","C0PWS1",419,0)
 D ADDTEMP^C0CMXP(INXML,TEMPID,FARY)
"RTN","C0PWS1",420,0)
 Q
"RTN","C0PWS1",421,0)
 ;
"RTN","C0PWS1",422,0)
GETXML(OUTXML,TEMPID,FARY) ;GET THE XML FROM TEMPLATE TEMPID
"RTN","C0PWS1",423,0)
 ;
"RTN","C0PWS1",424,0)
 N FARY S FARY="C0PFILES"
"RTN","C0PWS1",425,0)
 D INITXPF(FARY)
"RTN","C0PWS1",426,0)
 N C0PUTID ; TEMPLATE IEN TO USE
"RTN","C0PWS1",427,0)
 D GETXML^C0CMXP(OUTXML,TEMPID,FARY)
"RTN","C0PWS1",428,0)
 Q
"RTN","C0PWS1",429,0)
 ;
"RTN","C0PWS1",430,0)
GETTEMP(OUTXML,TEMPID,FARY) ;GET THE TEMPLATE XML FROM TEMPLATE TEMPID
"RTN","C0PWS1",431,0)
 ;
"RTN","C0PWS1",432,0)
 N FARY S FARY="C0PFILES"
"RTN","C0PWS1",433,0)
 D INITXPF(FARY)
"RTN","C0PWS1",434,0)
 N C0PUTID ; TEMPLATE IEN TO USE
"RTN","C0PWS1",435,0)
 D GETTEMP^C0CMXP(OUTXML,TEMPID,FARY)
"RTN","C0PWS1",436,0)
 Q
"RTN","C0PWS1",437,0)
 ;
"RTN","C0PWS1",438,0)
COPYHDR(ZS,ZD) ; COPY XML HEADER FROM RECORD ZS TO ZD
"RTN","C0PWS1",439,0)
 ; ASSUMES C0P XML TEMPLATE FILE
"RTN","C0PWS1",440,0)
 N FARY
"RTN","C0PWS1",441,0)
 D INITXPF("FARY")
"RTN","C0PWS1",442,0)
 D COPYWP^C0CMXP("XML HEADER",ZS,ZD,"FARY")
"RTN","C0PWS1",443,0)
 Q
"RTN","C0PWS1",444,0)
 ;
"RTN","C0PWS1",445,0)
UPDIE   ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
"RTN","C0PWS1",446,0)
 K ZERR
"RTN","C0PWS1",447,0)
 D CLEAN^DILF
"RTN","C0PWS1",448,0)
 D UPDATE^DIE("","C0PFDA","","ZERR")
"RTN","C0PWS1",449,0)
 I $D(ZERR) D ERROR^C0PMAIN(",U113059008,",$ST($ST,"PLACE"),"ERX-UPDIE-FAIL","Fileman Data Update Failure") QUIT
"RTN","C0PWS1",450,0)
 K C0PFDA
"RTN","C0PWS1",451,0)
 Q
"RTN","C0PWS1",452,0)
 ;
"RTN","C0PWS2")
0^22^B215641893
"RTN","C0PWS2",1,0)
C0PWS2   ; ERX/GPL - Web Service utilities; 8/31/09; 12/08/2010 ; 5/9/12 12:29am
"RTN","C0PWS2",2,0)
 ;;1.0;C0P;;Apr 25, 2012;Build 103
"RTN","C0PWS2",3,0)
 ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"RTN","C0PWS2",4,0)
 ;General Public License See attached copy of the License.
"RTN","C0PWS2",5,0)
 ; Modified by Chris Richardson, November, 2010.
"RTN","C0PWS2",6,0)
 ; Code has been modified to accept very large XML documents and block them logically.
"RTN","C0PWS2",7,0)
 ; 3101208 - RCR - Correct end of buffer condition, BF=">"
"RTN","C0PWS2",8,0)
 QUIT
"RTN","C0PWS2",9,0)
 ;
"RTN","C0PWS2",10,0)
 ; TEST Lines below not intended for End Users. Programmers only.
"RTN","C0PWS2",11,0)
 ; BEWARE ZWRITE SYNTAX. It may not work in other M Implementations.
"RTN","C0PWS2",12,0)
TEST(C0PDUZ,C0PDFN) ; TEST RETRIEVAL OF PATIENT1 MEDS
"RTN","C0PWS2",13,0)
 ;S DEBUG=1 ;
"RTN","C0PWS2",14,0)
 D SOAP("C0POUT",6,C0PDUZ,C0PDFN)
"RTN","C0PWS2",15,0)
 ZWRITE C0POUT ; Should use ^%ZOSV Node, this is very GT.M Specific
"RTN","C0PWS2",16,0)
 QUIT
"RTN","C0PWS2",17,0)
 ;
"RTN","C0PWS2",18,0)
ACCOUNTF()  QUIT 113059002  ; file number for account file
"RTN","C0PWS2",19,0)
 ;
"RTN","C0PWS2",20,0)
XMLFN()  QUIT 113059001  ; XML TEMPLATE FILE NUMBER
"RTN","C0PWS2",21,0)
 ;
"RTN","C0PWS2",22,0)
BINDFN()  QUIT 113059001.04 ; FILE NUMBER FOR BINDING SUBFILE
"RTN","C0PWS2",23,0)
 ;
"RTN","C0PWS2",24,0)
 ;
"RTN","C0PWS2",25,0)
GETTID(C0PWS,C0PTNAME) ; EXTRINSIC WHICH RETURNS THE TEMPLATE ID FOR
"RTN","C0PWS2",26,0)
 ; TEMPLATE NAMED C0PTNAME BELONGING TO WEB SERVICE NAMED C0PWS
"RTN","C0PWS2",27,0)
 ; ALSO WORKS IF THE ACCOUNT NUMBER IS PASSED IN C0PWS
"RTN","C0PWS2",28,0)
 S C0PXF=113059001 ; FILE NUMBER FOR THE C0P XML TEMPLATE FILE
"RTN","C0PWS2",29,0)
 S C0PAF=113059002 ; FILE NUMBER FOR THE C0P WS ACCT FILE
"RTN","C0PWS2",30,0)
 N C0PA,C0PT       ; C0P ACCOUNT AND C0P TEMPLATE
"RTN","C0PWS2",31,0)
 DO
"RTN","C0PWS2",32,0)
 . I C0PWS>0 S C0PA=C0PWS QUIT
"RTN","C0PWS2",33,0)
 . ;
"RTN","C0PWS2",34,0)
 . DO  ; NAME NOT RECORD NUMBER IS PASSED FOR ACCOUNT
"RTN","C0PWS2",35,0)
 . . S C0PA=$O(^C0PS("B",C0PWS,"")) ; RECORD NUMBER OF ACCOUNT
"RTN","C0PWS2",36,0)
 . . I C0PA="" D  Q  ; OOPS ACCOUNT NOT FOUND
"RTN","C0PWS2",37,0)
 . . . W "ACCOUNT "_C0PWS_" NOT FOUND",!
"RTN","C0PWS2",38,0)
 . . .QUIT
"RTN","C0PWS2",39,0)
 . .QUIT
"RTN","C0PWS2",40,0)
 .QUIT
"RTN","C0PWS2",41,0)
 S C0PT=$O(^C0PX("C",C0PA,C0PTNAME,"")) ; RECORD NUMBER OF TEMPLATE
"RTN","C0PWS2",42,0)
 ; WE USE THE C INDEX TO INSURE THAT THE TEMPLATE BELONGS TO THE WEB SERVICE
"RTN","C0PWS2",43,0)
 Q C0PT
"RTN","C0PWS2",44,0)
 ;
"RTN","C0PWS2",45,0)
RESTID(C0PDUZ,C0PTID) ; RESOLVE TEMPLATE ID FROM SUBSCRIPTION
"RTN","C0PWS2",46,0)
 ;
"RTN","C0PWS2",47,0)
 N C0PAIEN,COPACCT,COPWBS,COPUTID
"RTN","C0PWS2",48,0)
 S C0PAIEN=$$SUBINIT^C0PSUB(C0PDUZ) ;IEN OF SUBSCRIPTION
"RTN","C0PWS2",49,0)
 ; N C0PACCT
"RTN","C0PWS2",50,0)
 S C0PACCT=$$GET1^DIQ(C0PSUBF,C0PAIEN_","_C0PDUZ_",",1,"I") ;ACCT
"RTN","C0PWS2",51,0)
 ; N C0PWBS
"RTN","C0PWS2",52,0)
 S C0PWBS=$$GET1^DIQ(C0PAF,C0PACCT_",",4,"I") ;WEB SERVICE IEN
"RTN","C0PWS2",53,0)
 ; N C0PUTID
"RTN","C0PWS2",54,0)
 S C0PUTID=$$GETTID(C0PWBS,C0PTID) ;TEMPLATE ID
"RTN","C0PWS2",55,0)
 Q C0PUTID
"RTN","C0PWS2",56,0)
 ;
"RTN","C0PWS2",57,0)
SOAP(C0PRTN,C0PTID,C0PDUZ,C0PDFN,C0PVOR) ; MAKES A SOAP CALL FOR 
"RTN","C0PWS2",58,0)
 ; TEMPLATE ID C0PTID
"RTN","C0PWS2",59,0)
 ; RETURNS THE XML RESULT IN C0PRTN, PASSED BY NAME
"RTN","C0PWS2",60,0)
 ; C0PVOR IS THE NAME OF A VARIABLE OVERRIDE ARRAY, WHICH IS APPLIED 
"RTN","C0PWS2",61,0)
 ; BEFORE MAPPING
"RTN","C0PWS2",62,0)
 ;
"RTN","C0PWS2",63,0)
 ; ARTIFACTS SECTION
"RTN","C0PWS2",64,0)
 ; THE FOLLOWING WILL SET UP DEBUGGING ARTIFACTS FOR A POSSIBLE FUTURE
"RTN","C0PWS2",65,0)
 ; ONLINE DEBUGGER. IF DEBUG=1, VARIABLES CONTAINING INTERMEDIATE RESULTS
"RTN","C0PWS2",66,0)
 ; WILL NOT BE NEWED.
"RTN","C0PWS2",67,0)
 I $G(DEBUG)="" N C0PV ; CATALOG OF ARTIFACT VARIABLES AND ARRAYS
"RTN","C0PWS2",68,0)
 S C0PV(100,"C0PXF","XML TEMPLATE FILE NUMBER")=""
"RTN","C0PWS2",69,0)
 S C0PV(200,"C0PHEAD","SOAP HEADER VARIABLE NAME")=""
"RTN","C0PWS2",70,0)
 S C0PV(300,"header","SOAP HEADER")=""
"RTN","C0PWS2",71,0)
 S C0PV(400,"C0PMIME","MIME TYPE")=""
"RTN","C0PWS2",72,0)
 S C0PV(500,"C0PURL","WS URL")=""
"RTN","C0PWS2",73,0)
 S C0PV(550,"C0PPURL","PROXY URL")=""
"RTN","C0PWS2",74,0)
 S C0PV(600,"C0PXML","XML VARIABLE NAME")=""
"RTN","C0PWS2",75,0)
 S C0PV(700,"xml","OUTBOUND XML")=""
"RTN","C0PWS2",76,0)
 S C0PV(800,"C0PRSLT","RAW XML RESULT RETURNED FROM WEB SERVICE")=""
"RTN","C0PWS2",77,0)
 S C0PV(900,"C0PRHDR","RETURNED HEADER")=""
"RTN","C0PWS2",78,0)
 S C0PV(1000,"C0PRXML","XML RESULT NORMALIZED")=""
"RTN","C0PWS2",79,0)
 S C0PV(1100,"C0PR","REPLY TEMPLATE")=""
"RTN","C0PWS2",80,0)
 S C0PV(1200,"C0PREDUX","REDUX STRING")=""
"RTN","C0PWS2",81,0)
 S C0PV(1300,"C0PIDX","RESULT XPATH INDEX")=""
"RTN","C0PWS2",82,0)
 S C0PV(1400,"C0PARY","RESULT XPATH ARRAY")=""
"RTN","C0PWS2",83,0)
 S C0PV(1500,"C0PNOM","RESULT DOM DOCUMENT NAME")=""
"RTN","C0PWS2",84,0)
 S C0PV(1600,"C0PID","RESULT DOM ID")=""
"RTN","C0PWS2",85,0)
 N ZI,ZN,ZS
"RTN","C0PWS2",86,0)
 S ZN=""
"RTN","C0PWS2",87,0)
 D:$G(DEBUG)=""   ; G NOTNEW ; SKIP NEWING THE VARIABLES IF IN DEBUG
"RTN","C0PWS2",88,0)
 . S ZI="",ZN="",ZS=""
"RTN","C0PWS2",89,0)
 . F  S ZI=$O(COPV(ZI)) Q:ZI=""  D
"RTN","C0PWS2",90,0)
 . . ; S ZJ=$O(C0PV(ZI,"")) ; SET UP NEW COMMAND
"RTN","C0PWS2",91,0)
 . . S ZN=ZN_ZS_$O(C0PV(ZI,"")),ZS=","
"RTN","C0PWS2",92,0)
 . .QUIT
"RTN","C0PWS2",93,0)
 .QUIT
"RTN","C0PWS2",94,0)
 I $L(ZN) N @ZN  ; Apply collected NEW Variables 1 time
"RTN","C0PWS2",95,0)
 ; NEW
"RTN","C0PWS2",96,0)
 ; S ZI=$O(C0PV(ZI))
"RTN","C0PWS2",97,0)
 ; S ZJ=$O(C0PV(ZI,"")) ; SET UP NEW COMMAND
"RTN","C0PWS2",98,0)
 ;W ZJ,!
"RTN","C0PWS2",99,0)
 ; N @ZJ ; NEW THE VARIABLE
"RTN","C0PWS2",100,0)
 ; I $O(C0PV(ZI))'="" G NEW ;LOOP TO GET NEW IN CONTEXT
"RTN","C0PWS2",101,0)
 ;NOTNEW
"RTN","C0PWS2",102,0)
 ; END ARTIFACTS
"RTN","C0PWS2",103,0)
 ;
"RTN","C0PWS2",104,0)
 D INITXPF("C0PF") ; SET FILE NUMBER AND PARAMATERS 
"RTN","C0PWS2",105,0)
 S C0PXF=C0PF("XML FILE NUMBER") ; FILE NUMBER FOR THE C0P XML TEMPLATE FILE
"RTN","C0PWS2",106,0)
 D
"RTN","C0PWS2",107,0)
 . I +C0PTID=0 D  Q  ; A STRING WAS PASSED FOR THE TEMPLATE NAME
"RTN","C0PWS2",108,0)
 . . S C0PUTID=$$RESTID(C0PDUZ,C0PTID) ;RESOLVE TEMPLATE IEN FROM NAME
"RTN","C0PWS2",109,0)
 . .QUIT
"RTN","C0PWS2",110,0)
 . ;
"RTN","C0PWS2",111,0)
 . S C0PUTID=C0PTID ; AN IEN WAS PASSED
"RTN","C0PWS2",112,0)
 .QUIT
"RTN","C0PWS2",113,0)
 N xml,template,header
"RTN","C0PWS2",114,0)
 S C0PHEAD=$$GET1^DIQ(C0PXF,C0PUTID_",",2.2,,"header")
"RTN","C0PWS2",115,0)
 S C0PMIME=$$GET1^DIQ(C0PXF,C0PUTID_",","MIME TYPE")
"RTN","C0PWS2",116,0)
 S C0PPURL=$$GET1^DIQ(C0PXF,C0PUTID_",","PROXY SERVER")
"RTN","C0PWS2",117,0)
 ;S C0PURL=$$GET1^DIQ(C0PXF,C0PUTID_",","URL") ;GPL CHANGE TO USE PROD FLAG
"RTN","C0PWS2",118,0)
 D SETUP^C0PMAIN() ; INITIALIZE C0PACCT IEN OF WS ACCOUNT
"RTN","C0PWS2",119,0)
 S C0PURL=$$WSURL^C0PMAIN(C0PACCT) ; RESOLVES PRODUCTION VS TEST
"RTN","C0PWS2",120,0)
 S C0PXML=$$GET1^DIQ(C0PXF,C0PUTID_",",2.1,,"xml")
"RTN","C0PWS2",121,0)
 S C0PTMPL=$$GET1^DIQ(C0PXF,C0PUTID_",",3,,"template")
"RTN","C0PWS2",122,0)
 I C0PTMPL="template" D  ; there is a template to process
"RTN","C0PWS2",123,0)
 . K xml ; going to replace the xml array
"RTN","C0PWS2",124,0)
 . D EN^C0PMAIN("xml","url",C0PDUZ,C0PDFN,C0PUTID,$G(C0PVOR))
"RTN","C0PWS2",125,0)
 . ;N ZZG M ZZG(1)=xml
"RTN","C0PWS2",126,0)
 . ;S ZDIR=^TMP("C0CCCR","ODIR")
"RTN","C0PWS2",127,0)
 . ;ZWR ZZG(1)
"RTN","C0PWS2",128,0)
 . ;W $$OUTPUT^C0CXPATH("xml(1)","GPLTEST-"_ZDFN_".xml",ZDIR)
"RTN","C0PWS2",129,0)
 .QUIT
"RTN","C0PWS2",130,0)
 I $G(C0PPROXY) S C0PURL=C0PPURL
"RTN","C0PWS2",131,0)
 K C0PRSLT,C0PRHDR
"RTN","C0PWS2",132,0)
 S ok=$$httpPOST^%zewdGTM(C0PURL,.xml,C0PMIME,.C0PRSLT,.header,"",.gpl5,.C0PRHDR)
"RTN","C0PWS2",133,0)
 K C0PRXML
"RTN","C0PWS2",134,0)
 I $D(GPLTEST) D  ; WAY TO TEST WITH DATA FROM LIVE
"RTN","C0PWS2",135,0)
 . K C0PSRLT ; GPL HACK TO TEST XML FROM LIVE
"RTN","C0PWS2",136,0)
 . I GPLTEST=1 M C0PRSLT=^C0PG ; THIS IS THE BIG STATUS EMBEDDED XML FROM LIVE
"RTN","C0PWS2",137,0)
 . I GPLTEST=2 M C0PRSLT=^C0PG2 ; THIS IS THE BIG REFILL XML  FROM LIVE 
"RTN","C0PWS2",138,0)
 . Q
"RTN","C0PWS2",139,0)
 ; The following is a temporary fix to keep eRx working while a better 
"RTN","C0PWS2",140,0)
 ; solution is developed. Template ID 6 is GETMEDS for eRx and it needs
"RTN","C0PWS2",141,0)
 ; to handle xml files that are too big for NORMAL to handle. So, I wrote
"RTN","C0PWS2",142,0)
 ; CHUNK which will allow us to handle any size xml file bound for the
"RTN","C0PWS2",143,0)
 ; EWD parser. 
"RTN","C0PWS2",144,0)
 ; However, all the other templates in eRx need NORMAL to find the 
"RTN","C0PWS2",145,0)
 ; embedded XML file in their web service responses. So, we will use
"RTN","C0PWS2",146,0)
 ; CHUNK for template 6 and continue to use NORMAL for all other templates
"RTN","C0PWS2",147,0)
 ; we can handle big med lists, but not big web service calls.
"RTN","C0PWS2",148,0)
 ; What is needed is a better NORMAL (see NORMAL2) or another routine
"RTN","C0PWS2",149,0)
 ; to detect, extract, and decode embeded XML files of any size. gpl 10/8/10
"RTN","C0PWS2",150,0)
 ;
"RTN","C0PWS2",151,0)
 I $D(C0PRSLT(1)) D  ;
"RTN","C0PWS2",152,0)
 . D CHUNK("C0PRXML","C0PRSLT",1000) ;RETURN IN AN ARRAY
"RTN","C0PWS2",153,0)
 . I $G(C0PRSLT("RELOC",1,1))'="" D  ; THERE WAS EMBEDED XML
"RTN","C0PWS2",154,0)
 . . K C0PRXML ; THROW AWAY WRAPPER
"RTN","C0PWS2",155,0)
 . . M C0PRXML=C0PRSLT("RELOC",1) ; REPLACE WITH EMBEDDED DOCUMENT 
"RTN","C0PWS2",156,0)
 ; D:C0PUTID=6 
"RTN","C0PWS2",157,0)
 ;. I $D(C0PRSLT(1)) D CHUNK("C0PRXML","C0PRSLT",2000) QUIT  ;RETURN IN AN ARRAY
"RTN","C0PWS2",158,0)
 ;. ;
"RTN","C0PWS2",159,0)
 ;. I $D(C0PRSLT(1)) D NORMAL("C0PRXML","C0PRSLT(1)") ;RETURN XML IN AN ARRAY
"RTN","C0PWS2",160,0)
 ;.QUIT
"RTN","C0PWS2",161,0)
 S C0PR=$$GET1^DIQ(C0PXF,C0PUTID_",",.03,"I") ; REPLY TEMPLATE
"RTN","C0PWS2",162,0)
 ; reply templates are optional and are specified by populating a
"RTN","C0PWS2",163,0)
 ; template pointer in field 2.5 of the request template
"RTN","C0PWS2",164,0)
 ; if specified, the reply template is the source of the REDUX string
"RTN","C0PWS2",165,0)
 ; used for XPath on the reply, and for UNBIND processing
"RTN","C0PWS2",166,0)
 ; if no reply template is specified, REDUX is obtained from the request
"RTN","C0PWS2",167,0)
 ; template and no UNBIND processing is performed. The XPath array is
"RTN","C0PWS2",168,0)
 ; returned without variable bindings
"RTN","C0PWS2",169,0)
 I C0PR'="" D  ; REPLY TEMPLATE EXISTS
"RTN","C0PWS2",170,0)
 . I +$G(DEBUG)'=0 W "REPLY TEMPLATE:"_C0PR,!
"RTN","C0PWS2",171,0)
 . S C0PTID=C0PR ;
"RTN","C0PWS2",172,0)
 .QUIT
"RTN","C0PWS2",173,0)
 S C0PREDUX=$$GET1^DIQ(C0PXF,C0PUTID_",",2.5) ;XPATH REDUCTION STRING
"RTN","C0PWS2",174,0)
 K C0PIDX,C0PARY ; XPATH INDEX AND ARRAY VARS
"RTN","C0PWS2",175,0)
 S C0PNOM="C0PMEDS"_$J ; DOCUMENT NAME FOR THE DOM
"RTN","C0PWS2",176,0)
 N ZBIG S ZBIG=0
"RTN","C0PWS2",177,0)
 ;I C0PUTID'=6 D  ;
"RTN","C0PWS2",178,0)
 ;. S ZBIG=$$TOOBIG("C0PRXML") ; PATCH BY GPL WHICH ASSUMES ONLY
"RTN","C0PWS2",179,0)
 ;. ; TEMPLATE 1 IS A REGULAR XML FILE.. EVERYTHING ELSE HAS EMBEDDED XML
"RTN","C0PWS2",180,0)
 ;.QUIT
"RTN","C0PWS2",181,0)
 ;D
"RTN","C0PWS2",182,0)
 ;. I ZBIG>0 D    QUIT  ; PROBABLY AN EMBEDDED XML DOCUMENT
"RTN","C0PWS2",183,0)
 ;. . S C0PID=$$UNWRAP("C0PRXML",ZBIG,C0PNOM) ; DECODE AND PARSE THE EMBEDED XML
"RTN","C0PWS2",184,0)
 ;. .QUIT
"RTN","C0PWS2",185,0)
 ;. ;
"RTN","C0PWS2",186,0)
 ;. ; ELSE
"RTN","C0PWS2",187,0)
 ;. S C0PID=$$PARSE^C0PXEWD("C0PRXML",C0PNOM) ;CALL THE PARSER
"RTN","C0PWS2",188,0)
 ;.QUIT
"RTN","C0PWS2",189,0)
 ; I $D(GPLTEST) B  ; STOP TO LOOK AT C0PRXML --> use ZB SOAP+137^C0PWS2 //SMH
"RTN","C0PWS2",190,0)
 S C0PID=$$PARSE^C0PXEWD("C0PRXML",C0PNOM) ;CALL THE PARSER
"RTN","C0PWS2",191,0)
 S C0PID=$$FIRST^C0PXEWD($$ID^C0PXEWD(C0PNOM)) ;ID OF FIRST NODE
"RTN","C0PWS2",192,0)
 D XPATH^C0PXEWD(C0PID,"/","C0PIDX","C0PARY","",C0PREDUX) ;XPATH GENERATOR
"RTN","C0PWS2",193,0)
 S OK=$$DELETE^C0PXEWD(C0PNOM) ; REMOVE PARSED XML FROM THE EWD DOM
"RTN","C0PWS2",194,0)
 ; Next, call UNBIND to map the reply XPath array to variables
"RTN","C0PWS2",195,0)
 ; This is only done if a Reply Template is provided
"RTN","C0PWS2",196,0)
 D DEMUXARY(C0PRTN,"C0PARY")
"RTN","C0PWS2",197,0)
 ; M @C0PRTN=C0PARY
"RTN","C0PWS2",198,0)
 QUIT
"RTN","C0PWS2",199,0)
 ;
"RTN","C0PWS2",200,0)
TOOBIG(ZXML) ; EXTRINSIC WHICH RETURNS TRUE IF ANY NODE IS OVER 2000 CHARS
"RTN","C0PWS2",201,0)
 ; RETURNS THE INDEX OF THE LARGE NODE . IF NO LARGE NODE, RETURNS ZERO
"RTN","C0PWS2",202,0)
 N ZI,ZR
"RTN","C0PWS2",203,0)
 S ZI=""
"RTN","C0PWS2",204,0)
 S ZR=0 ; DEFAULT FALSE
"RTN","C0PWS2",205,0)
 ; First time we go over 1,000, we can stop.
"RTN","C0PWS2",206,0)
 F  S ZI=$O(@ZXML@(ZI)) Q:ZI=""  I $L(@ZXML@(ZI))>1000 S ZR=ZI Q   ; First oversize stops
"RTN","C0PWS2",207,0)
 QUIT ZR
"RTN","C0PWS2",208,0)
 ; ===================
"RTN","C0PWS2",209,0)
NORMAL(OUTXML,INXML) ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML
"RTN","C0PWS2",210,0)
 ; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME
"RTN","C0PWS2",211,0)
 ;
"RTN","C0PWS2",212,0)
 N INBF,ZI,ZN,ZTMP
"RTN","C0PWS2",213,0)
 S ZN=1,INBF=@INXML
"RTN","C0PWS2",214,0)
 S @OUTXML@(ZN)=$P(INBF,"><",ZN)_">"
"RTN","C0PWS2",215,0)
 ; S ZN=ZN+1
"RTN","C0PWS2",216,0)
 ; F  S @OUTXML@(ZN)="<"_$P(@INXML,"><",ZN) Q:$P(@INXML,"><",ZN+1)=""  D  ;
"RTN","C0PWS2",217,0)
 ; Should speed up, and not leave a dangling node, and doesn't stop at first NULL
"RTN","C0PWS2",218,0)
 F ZN=2:1:$L(INBF,"><") S @OUTXML@(ZN)="<"_$P(INBF,"><",ZN)_">"
"RTN","C0PWS2",219,0)
 ; . ; S ZN=ZN+1 
"RTN","C0PWS2",220,0)
 ; .QUIT
"RTN","C0PWS2",221,0)
 QUIT
"RTN","C0PWS2",222,0)
 ;  ================
"RTN","C0PWS2",223,0)
 ; The goal of this block has changed a little bit.  Most modern MUMPS engines can
"RTN","C0PWS2",224,0)
 ; handle a 1,000,000 byte string.  We will use BF to hold hunks that big so that 
"RTN","C0PWS2",225,0)
 ; we can logically suck up a big hunk of the input to supply the reblocking of the XML
"RTN","C0PWS2",226,0)
 ; into more logical blocks less than 2000 bytes in length blocks.
"RTN","C0PWS2",227,0)
 ; A series of signals will be needed, Source (INXML) is exhausted (INEND),
"RTN","C0PWS2",228,0)
 ; BF is less than 2200 bytes (BFLD, BuFfer reLoaD)
"RTN","C0PWS2",229,0)
 ; BF is Full (BF contains 998,000 bytes or more, BFULL)
"RTN","C0PWS2",230,0)
 ; BF and Process is Complete (BFEND)
"RTN","C0PWS2",231,0)
 ; ZSIZE defaults to 2,000 now, but can be set lower or higher
"RTN","C0PWS2",232,0)
 ;
"RTN","C0PWS2",233,0)
CHUNK(OUTXML,INXML,ZSIZE) ; BREAKS INXML INTO ZSIZE BLOCKS
"RTN","C0PWS2",234,0)
 ; INXML IS AN ARRAY PASSED BY NAME OF STRINGS
"RTN","C0PWS2",235,0)
 ; OUTXML IS ALSO PASSED BY NAME
"RTN","C0PWS2",236,0)
 ; IF ZSIZE IS NOT PASSED, 2000 IS USED
"RTN","C0PWS2",237,0)
 I '$D(ZSIZE) S ZSIZE=2000 ; DEFAULT BLOCK SIZE
"RTN","C0PWS2",238,0)
 N BF,BFEND,BFLD,BFMAX,BFULL,INEND,ZB,ZI,ZJ,ZK,ZL,ZN
"RTN","C0PWS2",239,0)
 ; S ZB=ZSIZE-1
"RTN","C0PWS2",240,0)
 S ZN=1
"RTN","C0PWS2",241,0)
 S BFMAX=998000
"RTN","C0PWS2",242,0)
 S ZI=0 ; BEGINNING OF INDEX TO INXML
"RTN","C0PWS2",243,0)
 S (BFLD,BFEND,BFULL,INEND)=0,BF=""
"RTN","C0PWS2",244,0)
 ; Major loop loads the buffer, BF, and unloads it into the Output Array
"RTN","C0PWS2",245,0)
 ;  in 
"RTN","C0PWS2",246,0)
 F  D  Q:BFEND
"RTN","C0PWS2",247,0)
 . ; Input LOADER
"RTN","C0PWS2",248,0)
 . D:'INEND
"RTN","C0PWS2",249,0)
 . . F  S ZI=$O(@INXML@(ZI)) S INEND=(ZI="")  Q:INEND!BFULL  D   ; LOAD EACH STRING IN INXML
"RTN","C0PWS2",250,0)
 . . . S BF=BF_@INXML@(ZI)                                       ; ADD TO THE BF STRING
"RTN","C0PWS2",251,0)
 . . . S BFULL=($L(BF)>BFMAX)
"RTN","C0PWS2",252,0)
 . . .QUIT
"RTN","C0PWS2",253,0)
 . .QUIT
"RTN","C0PWS2",254,0)
 . ;  Full Buffer, BF, now check for Encryption and Unpack
"RTN","C0PWS2",255,0)
 . D TEST4COD(.BF,"C0PRSLT(""RELOC"")")
"RTN","C0PWS2",256,0)
 . ; Output BREAKER
"RTN","C0PWS2",257,0)
 . F  Q:BFLD  D   ; ZJ=1:ZSIZE:ZL D  ;
"RTN","C0PWS2",258,0)
 . . ; ZK=$S(ZJ+ZB<ZL:ZJ+ZB,1:ZL) ; END FOR EXTRACT
"RTN","C0PWS2",259,0)
 . . F ZK=ZSIZE:-1:0  Q:$E(BF,ZK)=">"
"RTN","C0PWS2",260,0)
 . . I ZK=0 S ZK=ZSIZE
"RTN","C0PWS2",261,0)
 . . S @OUTXML@(ZN)=$E(BF,1,ZK) ; PULL OUT THE PIECE
"RTN","C0PWS2",262,0)
 . . S ZN=ZN+1 ; INCREMENT OUT ARRAY INDEX
"RTN","C0PWS2",263,0)
 . . S BF=$E(BF,ZK+1,BFMAX)
"RTN","C0PWS2",264,0)
 . . S BFLD=($L(BF)<(ZSIZE*2))
"RTN","C0PWS2",265,0)
 . .QUIT
"RTN","C0PWS2",266,0)
 . S BFEND=(INEND&BFLD)!(">"[BF)
"RTN","C0PWS2",267,0)
 . I $L(BF)&BFEND S @OUTXML@(ZN)=BF,BF=""
"RTN","C0PWS2",268,0)
 .QUIT
"RTN","C0PWS2",269,0)
 QUIT
"RTN","C0PWS2",270,0)
 ;  ==============
"RTN","C0PWS2",271,0)
 ; Test for Encryption, extract it and decode it.
"RTN","C0PWS2",272,0)
TEST4COD(INBF,RELOC) 
"RTN","C0PWS2",273,0)
 N DBF,I,MSK,TBF,TRG,RCNT
"RTN","C0PWS2",274,0)
 S RCNT=0
"RTN","C0PWS2",275,0)
 ;  Segments expected <seg 1>DATA</seg 1><seg 2>DATA</seg 2>
"RTN","C0PWS2",276,0)
 ;                           ^   ^
"RTN","C0PWS2",277,0)
 S MSK=""   ; It turns out that some of the characters used were not reliable
"RTN","C0PWS2",278,0)
 F I=32:1:42,44:1:47,62:1:64,91:1:96 S MSK=MSK_$C(I)
"RTN","C0PWS2",279,0)
 F I=1:1:$L(INBF,"</")-1 D
"RTN","C0PWS2",280,0)
 . S TBF=$RE($P($RE($P(INBF,"</",I)),">"))
"RTN","C0PWS2",281,0)
 . ; Remove sample for testing
"RTN","C0PWS2",282,0)
 . ; Set the trigger, mostly included to show intent and associated code
"RTN","C0PWS2",283,0)
 . ;  this could be refined later if determined already obvious enough
"RTN","C0PWS2",284,0)
 . S TRG=0
"RTN","C0PWS2",285,0)
 . ;DO:$L(TBF)>20  ; If $TR doesn't remove anything, then these characters are not there
"RTN","C0PWS2",286,0)
 . ; gpl  trying to keep refills from crashing.. 20 chars is not enough
"RTN","C0PWS2",287,0)
 . DO:$L(TBF)>100  ; If $TR doesn't remove anything, then these characters are not there
"RTN","C0PWS2",288,0)
 . . I (TBF=$TR(TBF,MSK))   S TRG=1
"RTN","C0PWS2",289,0)
 . . ; I (TBF=$TR(TBF," <->@*!?.,:;#$%&[/|\]={}~")) S TRG=1
"RTN","C0PWS2",290,0)
 . . ;   <>!"#$%&'()*,-./67:;<>?@[\]^_`fqr{|}~  <<= Ignore 6,7,f,q, and r
"RTN","C0PWS2",291,0)
 . . ; Now we set up for the DECODE and replacement in INBF
"RTN","C0PWS2",292,0)
 . . DO:TRG
"RTN","C0PWS2",293,0)
 . . . N A,C,CC,CV,CCX,K,XBF,T,V
"RTN","C0PWS2",294,0)
 . . . DO
"RTN","C0PWS2",295,0)
 . . . . N I
"RTN","C0PWS2",296,0)
 . . . . S DBF=$$DECODER(TBF)
"RTN","C0PWS2",297,0)
 . . . .QUIT
"RTN","C0PWS2",298,0)
 . . . ;
"RTN","C0PWS2",299,0)
 . . . S CCX=""
"RTN","C0PWS2",300,0)
 . . . F K=1:1:$L(DBF) S CC=$E(DBF,K) S:CC?1C C=$A(CC),A(C)=$G(A(C))+1
"RTN","C0PWS2",301,0)
 . . . S C="",V=""
"RTN","C0PWS2",302,0)
 . . . F  S C=$O(A(C)) Q:C=""  S CCX=CCX_$C(C) S:A(C)>V V=A(C),CV=C
"RTN","C0PWS2",303,0)
 . . . S CC=$C(CV)
"RTN","C0PWS2",304,0)
 . . . ;  The "_$C(13,10)_" may need to be generalized, tested and set earlier
"RTN","C0PWS2",305,0)
 . . . ;    Expand embedded XML in XBF
"RTN","C0PWS2",306,0)
 . . . F K=1:1:$L(DBF,CC) S T=$P(DBF,CC,K),XBF(K)=$TR(T,CCX)
"RTN","C0PWS2",307,0)
 . . . S RCNT=RCNT+1
"RTN","C0PWS2",308,0)
 . . . M @RELOC@(RCNT)=XBF
"RTN","C0PWS2",309,0)
 . . . ;   Curley braces and = makes it so it won't trigger a second time by retest.                                
"RTN","C0PWS2",310,0)
 . . . S INBF=$P(INBF,TBF)_"<{REPLACED}="_RCNT_$P(INBF,TBF,2,999)
"RTN","C0PWS2",311,0)
 . . .QUIT
"RTN","C0PWS2",312,0)
 . .QUIT
"RTN","C0PWS2",313,0)
 .QUIT
"RTN","C0PWS2",314,0)
 ;  Now shorten the INBF so it gets smaller
"RTN","C0PWS2",315,0)
 ;S INBF=$P(INBF,">",I+1,99999)
"RTN","C0PWS2",316,0)
 QUIT
"RTN","C0PWS2",317,0)
 ;
"RTN","C0PWS2",318,0)
DECODER(BF) ; Decrypts the Encrypted Strings
"RTN","C0PWS2",319,0)
 QUIT $$DECODE^RGUTUU(BF)
"RTN","C0PWS2",320,0)
 ;
"RTN","C0PWS2",321,0)
NORMAL2(OUTXML,INXML) ;NORMALIZES AN ARRAY OF XML STRINGS PASSED BY NAME INXML
"RTN","C0PWS2",322,0)
 ; AS @INXML@(1) TO @INXML@(x) ALL NUMERIC
"RTN","C0PWS2",323,0)
 ; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME
"RTN","C0PWS2",324,0)
 ; this routine doesn't work unless the blocks are on xml tag boundaries - gpl
"RTN","C0PWS2",325,0)
 ; which is hard to do... this routine is left here awaiting future development
"RTN","C0PWS2",326,0)
 N ZI,ZN,ZJ
"RTN","C0PWS2",327,0)
 S ZJ=0
"RTN","C0PWS2",328,0)
 S ZN=1
"RTN","C0PWS2",329,0)
 F  S ZJ=$O(@INXML@(ZJ)) Q:+ZJ=0  D  ; FOR EACH XML STRING IN ARRAY
"RTN","C0PWS2",330,0)
 . S @OUTXML@(ZN)=$P(@INXML@(ZJ),"><",ZN)_">"
"RTN","C0PWS2",331,0)
 . S ZN=ZN+1
"RTN","C0PWS2",332,0)
 . F  S @OUTXML@(ZN)="<"_$P(@INXML@(ZJ),"><",ZN) Q:$P(@INXML@(ZJ),"><",ZN+1)=""  D  ;
"RTN","C0PWS2",333,0)
 . . S @OUTXML@(ZN)=@OUTXML@(ZN)_">"
"RTN","C0PWS2",334,0)
 . . S ZN=ZN+1
"RTN","C0PWS2",335,0)
 . .QUIT
"RTN","C0PWS2",336,0)
 .QUIT
"RTN","C0PWS2",337,0)
 QUIT
"RTN","C0PWS2",338,0)
 ;  ===============
"RTN","C0PWS2",339,0)
 ;
"RTN","C0PWS2",340,0)
UNWRAP(ZXML,ZI,ZNOM) ; EXTRINSIC TO LOCATE, DECODE AND PARSE AN EMBEDED XML DOC
"RTN","C0PWS2",341,0)
 ; RETURNS THE DOCID OF THE DOM
"RTN","C0PWS2",342,0)
 N ZS,ZX
"RTN","C0PWS2",343,0)
 S ZS=$P($P(@ZXML@(ZI),">",2),"<",1) ; PULL OUT THE ENCODED STRING
"RTN","C0PWS2",344,0)
 S ZX=$$DECODE^RGUTUU(ZS)
"RTN","C0PWS2",345,0)
 N ZZ
"RTN","C0PWS2",346,0)
 N ZY S ZY="<?xml version=""1.0"" encoding=""utf-8""?>"
"RTN","C0PWS2",347,0)
 I $E(ZX,1,5)'="<?xml" S ZZ(1)=ZY_ZX
"RTN","C0PWS2",348,0)
 E  S ZZ(1)=ZX
"RTN","C0PWS2",349,0)
 N ZI
"RTN","C0PWS2",350,0)
 ;F ZI=1:1 Q:$$REDUCE(.ZZ,ZI) ; CHOP THE STRING INTO 4000 CHAR ARRAY
"RTN","C0PWS2",351,0)
 S ZI=$$REDUCRCR(.ZZ,1) ; RECURSIVE VERSION OF REDUCE
"RTN","C0PWS2",352,0)
 S G=$$PARSE^C0PXEWD("ZZ",C0PNOM)
"RTN","C0PWS2",353,0)
 ; GTM Specific
"RTN","C0PWS2",354,0)
 ; I G=0 ZWR ^TMP("MXMLERR",$J,*) B
"RTN","C0PWS2",355,0)
 QUIT G
"RTN","C0PWS2",356,0)
 ;  =============
"RTN","C0PWS2",357,0)
REDUCE(ZARY,ZN) ; WILL REDUCE ZARY(ZN) BY CHOPPING IT TO 4000 CHARS
"RTN","C0PWS2",358,0)
 ; AND PUTTING THE REST IN ZARY(ZN+1)
"RTN","C0PWS2",359,0)
 ; ZARY IS PASSED BY REFERENCE
"RTN","C0PWS2",360,0)
 ; EXTRINSIC WHICH RETURNS FALSE IF THERE IS NOTHING TO REDUCE
"RTN","C0PWS2",361,0)
 I $L(ZARY(ZN))<4001   QUIT 0 ;NOTHING TO REDUCE
"RTN","C0PWS2",362,0)
 ;
"RTN","C0PWS2",363,0)
 S ZARY(ZN+1)=$E(ZARY(ZN),4001,$L(ZZ(ZN))) ;BREAK IT UP
"RTN","C0PWS2",364,0)
 S ZARY(ZN)=$E(ZARY(ZN),1,4000) ;  
"RTN","C0PWS2",365,0)
 QUIT 1  ;ACTUALLY REDUCED
"RTN","C0PWS2",366,0)
 ;  ===========
"RTN","C0PWS2",367,0)
REDUCRCR(ZARY,ZN) ; RECURSIVE VERSION OF REDUCE ABOVE
"RTN","C0PWS2",368,0)
 ; WILL REDUCE ZARY(ZN) BY CHOPPING IT TO 4000 CHARS
"RTN","C0PWS2",369,0)
 ; AND PUTTING THE REST IN ZARY(ZN+1)
"RTN","C0PWS2",370,0)
 ; ZARY IS PASSED BY REFERENCE
"RTN","C0PWS2",371,0)
 ; EXTRINSIC WHICH RETURNS FALSE IF THERE IS NOTHING TO REDUCE
"RTN","C0PWS2",372,0)
 I $L(ZARY(ZN))<4001 Q 0 ;NOTHING TO REDUCE
"RTN","C0PWS2",373,0)
 ; 
"RTN","C0PWS2",374,0)
 S ZARY(ZN+1)=$E(ZARY(ZN),4001,$L(ZZ(ZN))) ;BREAK IT UP
"RTN","C0PWS2",375,0)
 S ZARY(ZN)=$E(ZARY(ZN),1,4000) ;  
"RTN","C0PWS2",376,0)
 I '$$REDUCRCR(.ZARY,ZN+1) Q 1 ; CALL RECURSIVELY
"RTN","C0PWS2",377,0)
 ;  
"RTN","C0PWS2",378,0)
 QUIT 1  ;ACTUALLY REDUCED
"RTN","C0PWS2",379,0)
 ;
"RTN","C0PWS2",380,0)
DEMUXARY(OARY,IARY) ;CONVERT AN XPATH ARRAY PASSED AS IARY TO
"RTN","C0PWS2",381,0)
 ; FORMAT @OARY@(x,xpath) where x is the first multiple
"RTN","C0PWS2",382,0)
 N ZI,ZJ,ZK,ZL S ZI=""
"RTN","C0PWS2",383,0)
 F  S ZI=$O(@IARY@(ZI)) Q:ZI=""  D  ;
"RTN","C0PWS2",384,0)
 . D DEMUX^C0CMXP("ZJ",ZI)
"RTN","C0PWS2",385,0)
 . S ZK=$P(ZJ,"^",3)
"RTN","C0PWS2",386,0)
 . S ZK=$RE($P($RE(ZK),"/",1))
"RTN","C0PWS2",387,0)
 . S ZL=$P(ZJ,"^",1)
"RTN","C0PWS2",388,0)
 . I ZL="" S ZL=1
"RTN","C0PWS2",389,0)
 . S @OARY@(ZL,ZK)=@IARY@(ZI)
"RTN","C0PWS2",390,0)
 .QUIT
"RTN","C0PWS2",391,0)
 QUIT
"RTN","C0PWS2",392,0)
 ;
"RTN","C0PWS2",393,0)
PARSE(INXML,INDOC) ;CALL THE EWD PARSER ON INXML, PASSED BY NAME
"RTN","C0PWS2",394,0)
 ; INDOC IS PASSED AS THE DOCUMENT NAME TO EWD
"RTN","C0PWS2",395,0)
 ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY EWD
"RTN","C0PWS2",396,0)
 N ZR
"RTN","C0PWS2",397,0)
 M ^CacheTempEWD($j)=@INXML ;
"RTN","C0PWS2",398,0)
 S ZR=$$parseDocument^%zewdHTMLParser(INDOC)
"RTN","C0PWS2",399,0)
 K ^CacheTempEWD($j) ;clean up after
"RTN","C0PWS2",400,0)
 QUIT ZR
"RTN","C0PWS2",401,0)
 ;
"RTN","C0PWS2",402,0)
TBLD(INT) ; TEMPLATE BUILD OF TEMPLATE INT
"RTN","C0PWS2",403,0)
 ; want to break this up into pieces -  gpl
"RTN","C0PWS2",404,0)
 ; THE TEMPLATE NEEDS TO EXIST AND THE DEFINING XML URL MUST BE POPULATED
"RTN","C0PWS2",405,0)
 ; THEN THE DEFINING XML WILL BE RETRIVED AND STORED INTO THE RAW XML FIELD
"RTN","C0PWS2",406,0)
 ; IT WILL BE TRANSFORMED INTO A TEMPLATE AND STORED IN THE TEMPLATE FIELD
"RTN","C0PWS2",407,0)
 ; ALL THE XPATHs WILL BE EXTRACTED AND A BINDING MULTIPLE CREATED FOR EACH
"RTN","C0PWS2",408,0)
 ; ALL IN ONE SIMPLE ROUTINE
"RTN","C0PWS2",409,0)
 ; WHAT REMAINS IS FOR MANUAL ENTRY OF THE OTHER FIELDS IN THE BINDINGS
"RTN","C0PWS2",410,0)
 N C0PXTF S C0PXTF=113059001 ; XML TEMPLATE FILE
"RTN","C0PWS2",411,0)
 N C0PURL ; URL TO RETRIEVE THE DEFINING XML FOR THE TEMPLATE
"RTN","C0PWS2",412,0)
 S C0PURL=$$GET1^DIQ(C0PXTF,INT,2)
"RTN","C0PWS2",413,0)
 D GET1URL^C0PEWD2(C0PURL)
"RTN","C0PWS2",414,0)
 D CLEAN^DILF
"RTN","C0PWS2",415,0)
 ; D WP^DIE(ZF,ZIEN_",",1,,$NA(@ZOR@(ZD,ZI,"TX"))) ; WP OF ORDER TXT
"RTN","C0PWS2",416,0)
 D WP^DIE(C0PXTF,INT_",",2.1,,$NA(gpl))
"RTN","C0PWS2",417,0)
 D WP^DIE(C0PXTF,INT_",",3,,$NA(gplTEMP))
"RTN","C0PWS2",418,0)
 ;N C0PFDA ; DON'T NEW FOR TESTING
"RTN","C0PWS2",419,0)
 D ADDXP("gpl2",INT)
"RTN","C0PWS2",420,0)
 QUIT
"RTN","C0PWS2",421,0)
 ;  ==========
"RTN","C0PWS2",422,0)
COMPILE(INTID) ;COMPILE A XML TEMPLATE IN RECORD INTID
"RTN","C0PWS2",423,0)
 D INITXPF("C0PF") ;FILE ARRAY TO POINT TO C0P FILES
"RTN","C0PWS2",424,0)
 D COMPILE^C0CMXP(INTID,"C0PF") ;COMPILE THE TEMPLATE
"RTN","C0PWS2",425,0)
 QUIT
"RTN","C0PWS2",426,0)
 ;  ==========
"RTN","C0PWS2",427,0)
CPBIND(INID,OUTID,FORCE) ; COPIES XPATH BINDINGS FROM TEMPLATE INID
"RTN","C0PWS2",428,0)
 ; TO TEMPLATE OUTID - ONLY BINDINGS FOR MATCHING XPATHS ARE COPIED
"RTN","C0PWS2",429,0)
 ; NOTE - REDO THIS TO USE FILEMAN CALLS GPL
"RTN","C0PWS2",430,0)
 ; WILL NOT OVERWRITE UNLESS FORCE=1
"RTN","C0PWS2",431,0)
 N FARY,ZI
"RTN","C0PWS2",432,0)
 S FARY="C0PF"
"RTN","C0PWS2",433,0)
 D INITXPF("C0PF")
"RTN","C0PWS2",434,0)
 I +OUTID=0 S OUTID=$$RESTID^C0CSOAP(OUTID,FARY) ;RESOLVE TEMPLATE NAME
"RTN","C0PWS2",435,0)
 I +INID=0 S INID=$$RESTID^C0CSOAP(INID,FARY) ;RESOLVE TEMPLATE NAME
"RTN","C0PWS2",436,0)
 S ZI=0
"RTN","C0PWS2",437,0)
 F  S ZI=$O(^C0PX(OUTID,5,ZI)) Q:+ZI=0  D  ; FOR EACH XPATH IN OUTID
"RTN","C0PWS2",438,0)
 . W !,ZI," ",^C0PX(OUTID,5,ZI,0)
"RTN","C0PWS2",439,0)
 . S ZN=^C0PX(OUTID,5,ZI,0)
"RTN","C0PWS2",440,0)
 . I $D(^C0PX(OUTID,5,ZI,1)) D  ;Q  ;
"RTN","C0PWS2",441,0)
 . . W !,"ERROR XPATH BINDING EXISTS ",ZI
"RTN","C0PWS2",442,0)
 . .QUIT
"RTN","C0PWS2",443,0)
 . D  ; LOOK FOR MATCHING XPATH IN SOURCE
"RTN","C0PWS2",444,0)
 . . S ZJ=$O(^C0PX(INID,5,"B",ZN,""))
"RTN","C0PWS2",445,0)
 . . ;W " FOUND:",ZJ
"RTN","C0PWS2",446,0)
 . . I ZJ'="" D  ;
"RTN","C0PWS2",447,0)
 . . . ;W !,"SETTING ",$G(^C0PX(INID,5,ZJ,1))
"RTN","C0PWS2",448,0)
 . . . S ^C0PX(OUTID,5,ZI,0)=^C0PX(INID,5,ZJ,0) ;GET BOTH FIELDS
"RTN","C0PWS2",449,0)
 . . . S ^C0PX(OUTID,5,ZI,1)=$G(^C0PX(INID,5,ZJ,1))
"RTN","C0PWS2",450,0)
 QUIT
"RTN","C0PWS2",451,0)
 ;
"RTN","C0PWS2",452,0)
INITXPF(ARY) ;INITIAL XML/XPATH FILE ARRAY
"RTN","C0PWS2",453,0)
 ;
"RTN","C0PWS2",454,0)
 S @ARY@("XML FILE NUMBER")=113059001
"RTN","C0PWS2",455,0)
 S @ARY@("BINDING SUBFILE NUMBER")=113059001.04
"RTN","C0PWS2",456,0)
 S @ARY@("MIME TYPE")="2.3"
"RTN","C0PWS2",457,0)
 S @ARY@("PROXY SERVER")="2.4"
"RTN","C0PWS2",458,0)
 S @ARY@("REPLY TEMPLATE")=".03"
"RTN","C0PWS2",459,0)
 S @ARY@("TEMPLATE NAME")=".01"
"RTN","C0PWS2",460,0)
 S @ARY@("TEMPLATE XML")="3"
"RTN","C0PWS2",461,0)
 S @ARY@("URL")="1"
"RTN","C0PWS2",462,0)
 S @ARY@("WSDL URL")="2"
"RTN","C0PWS2",463,0)
 S @ARY@("XML")="2.1"
"RTN","C0PWS2",464,0)
 S @ARY@("XML HEADER")="2.2"
"RTN","C0PWS2",465,0)
 S @ARY@("XPATH REDUCTION STRING")="2.5"
"RTN","C0PWS2",466,0)
 S @ARY@("CCR VARIABLE")="4"
"RTN","C0PWS2",467,0)
 S @ARY@("FILEMAN FIELD NAME")="1"
"RTN","C0PWS2",468,0)
 S @ARY@("FILEMAN FIELD NUMBER")="1.2"
"RTN","C0PWS2",469,0)
 S @ARY@("FILEMAN FILE POINTER")="1.1"
"RTN","C0PWS2",470,0)
 S @ARY@("INDEXED BY")=".05"
"RTN","C0PWS2",471,0)
 S @ARY@("SQLI FIELD NAME")="3"
"RTN","C0PWS2",472,0)
 S @ARY@("VARIABLE NAME")="2"
"RTN","C0PWS2",473,0)
 QUIT
"RTN","C0PWS2",474,0)
 ;
"RTN","C0PWS2",475,0)
ADDXP(INARY,TID) ;ADD XPATH .01 FIELD TO BINDING SUBFILE OF TEMPLATE TID
"RTN","C0PWS2",476,0)
 N FARY
"RTN","C0PWS2",477,0)
 S FARY="C0PFILES"
"RTN","C0PWS2",478,0)
 D INITXPF(FARY)
"RTN","C0PWS2",479,0)
 D ADDXP^C0CMXP(INARY,TID,FARY) ;
"RTN","C0PWS2",480,0)
 QUIT
"RTN","C0PWS2",481,0)
 ;
"RTN","C0PWS2",482,0)
ADDXML(INXML,TEMPID) ;ADD XML TO A TEMPLATE ID TEMPID
"RTN","C0PWS2",483,0)
 ; INXML IS PASSED BY NAME
"RTN","C0PWS2",484,0)
 N FARY S FARY="C0PFILES"
"RTN","C0PWS2",485,0)
 D INITXPF(FARY)
"RTN","C0PWS2",486,0)
 D ADDXML^C0CMXP(INXML,TEMPID,FARY) ;CALL C0C ROUTINE TO ADD TO THE FILE
"RTN","C0PWS2",487,0)
 QUIT
"RTN","C0PWS2",488,0)
 ;
"RTN","C0PWS2",489,0)
ADDTEMP(INXML,TEMPID,FARY) ;ADD XML TEMPLATE TO TEMPLATE RECORD TEMPID FIELD 3
"RTN","C0PWS2",490,0)
 ;
"RTN","C0PWS2",491,0)
 N FARY
"RTN","C0PWS2",492,0)
 S FARY="C0PFILES"
"RTN","C0PWS2",493,0)
 D INITXPF(FARY)
"RTN","C0PWS2",494,0)
 D ADDTEMP^C0CMXP(INXML,TEMPID,FARY)
"RTN","C0PWS2",495,0)
 QUIT
"RTN","C0PWS2",496,0)
 ;
"RTN","C0PWS2",497,0)
GETXML(OUTXML,TEMPID,FARY) ;GET THE XML FROM TEMPLATE TEMPID
"RTN","C0PWS2",498,0)
 ;
"RTN","C0PWS2",499,0)
 N FARY
"RTN","C0PWS2",500,0)
 S FARY="C0PFILES"
"RTN","C0PWS2",501,0)
 D INITXPF(FARY)
"RTN","C0PWS2",502,0)
 N C0PUTID ; TEMPLATE IEN TO USE
"RTN","C0PWS2",503,0)
 D GETXML^C0CMXP(OUTXML,TEMPID,FARY)
"RTN","C0PWS2",504,0)
 QUIT
"RTN","C0PWS2",505,0)
 ;
"RTN","C0PWS2",506,0)
GETTEMP(OUTXML,TEMPID,FARY) ;GET THE TEMPLATE XML FROM TEMPLATE TEMPID
"RTN","C0PWS2",507,0)
 ;
"RTN","C0PWS2",508,0)
 N FARY
"RTN","C0PWS2",509,0)
 S FARY="C0PFILES"
"RTN","C0PWS2",510,0)
 D INITXPF(FARY)
"RTN","C0PWS2",511,0)
 N C0PUTID ; TEMPLATE IEN TO USE
"RTN","C0PWS2",512,0)
 D GETTEMP^C0CMXP(OUTXML,TEMPID,FARY)
"RTN","C0PWS2",513,0)
 QUIT
"RTN","C0PWS2",514,0)
 ;
"RTN","C0PWS2",515,0)
COPYHDR(ZS,ZD) ; COPY XML HEADER FROM RECORD ZS TO ZD
"RTN","C0PWS2",516,0)
 ; ASSUMES C0P XML TEMPLATE FILE
"RTN","C0PWS2",517,0)
 N FARY
"RTN","C0PWS2",518,0)
 D INITXPF("FARY")
"RTN","C0PWS2",519,0)
 D COPYWP^C0CMXP("XML HEADER",ZS,ZD,"FARY")
"RTN","C0PWS2",520,0)
 QUIT
"RTN","C0PWS2",521,0)
 ;
"RTN","C0PWS2",522,0)
UPDIE   ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
"RTN","C0PWS2",523,0)
 K ZERR
"RTN","C0PWS2",524,0)
 D CLEAN^DILF
"RTN","C0PWS2",525,0)
 D UPDATE^DIE("","C0PFDA","","ZERR")
"RTN","C0PWS2",526,0)
 I $D(ZERR) D ERROR^C0PMAIN(",U113059008,",$ST($ST,"PLACE"),"ERX-UPDIE-FAIL","Fileman Data Update Failure") QUIT
"RTN","C0PWS2",527,0)
 K C0PFDA
"RTN","C0PWS2",528,0)
 QUIT
"RTN","C0PXEWD")
0^5^B18300022
"RTN","C0PXEWD",1,0)
C0PXEWD   ; ERX/GPL - EWD based XPath utilities; 10/11/09 ; 5/4/12 4:29pm
"RTN","C0PXEWD",2,0)
 ;;1.0;C0P;;Apr 25, 2012;Build 103
"RTN","C0PXEWD",3,0)
 ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"RTN","C0PXEWD",4,0)
 ;General Public License See attached copy of the License.
"RTN","C0PXEWD",5,0)
 ;
"RTN","C0PXEWD",6,0)
 ;This program is free software; you can redistribute it and/or modify
"RTN","C0PXEWD",7,0)
 ;it under the terms of the GNU General Public License as published by
"RTN","C0PXEWD",8,0)
 ;the Free Software Foundation; either version 2 of the License, or
"RTN","C0PXEWD",9,0)
 ;(at your option) any later version.
"RTN","C0PXEWD",10,0)
 ;
"RTN","C0PXEWD",11,0)
 ;This program is distributed in the hope that it will be useful,
"RTN","C0PXEWD",12,0)
 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
"RTN","C0PXEWD",13,0)
 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"RTN","C0PXEWD",14,0)
 ;GNU General Public License for more details.
"RTN","C0PXEWD",15,0)
 ;
"RTN","C0PXEWD",16,0)
 ;You should have received a copy of the GNU General Public License along
"RTN","C0PXEWD",17,0)
 ;with this program; if not, write to the Free Software Foundation, Inc.,
"RTN","C0PXEWD",18,0)
 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
"RTN","C0PXEWD",19,0)
 ;
"RTN","C0PXEWD",20,0)
 Q
"RTN","C0PXEWD",21,0)
 ;
"RTN","C0PXEWD",22,0)
 ; gpl July, 2010. This routine interfaces with EWD to generate an XPath
"RTN","C0PXEWD",23,0)
 ; array from an XML file. It recursively visits the EWD DOM and creates
"RTN","C0PXEWD",24,0)
 ; an XPath index, an XPath array of node values, and an XPath template
"RTN","C0PXEWD",25,0)
 ; in three different variables. It is used to prepare incoming xml for
"RTN","C0PXEWD",26,0)
 ; processing by applications. 
"RTN","C0PXEWD",27,0)
 ;
"RTN","C0PXEWD",28,0)
TEST ;
"RTN","C0PXEWD",29,0)
 D XPATH($$FIRST($$ID("CCR1")),"/","GIDX","GARY")
"RTN","C0PXEWD",30,0)
 Q
"RTN","C0PXEWD",31,0)
 ;
"RTN","C0PXEWD",32,0)
TEST2 ;
"RTN","C0PXEWD",33,0)
 S REDUX="//soap:Envelope/soap:Body/GetPatientFullMedicationHistory5Response/GetPatientFullMedicationHistory5Result/patientDrugDetail"
"RTN","C0PXEWD",34,0)
 D XPATH($$FIRST($$ID("gpl")),"/","GIDX","GARY","",REDUX)
"RTN","C0PXEWD",35,0)
 Q
"RTN","C0PXEWD",36,0)
 ;
"RTN","C0PXEWD",37,0)
XPATH(ZOID,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
"RTN","C0PXEWD",38,0)
 ; THE XPATH INDEX ZXIDX, PASSED BY NAME
"RTN","C0PXEWD",39,0)
 ; THE XPATH ARRAY XPARY, PASSED BY NAME
"RTN","C0PXEWD",40,0)
 ; ZOID IS THE STARTING OID
"RTN","C0PXEWD",41,0)
 ; ZPATH IS THE STARTING XPATH, USUALLY "/"
"RTN","C0PXEWD",42,0)
 ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE
"RTN","C0PXEWD",43,0)
 ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT
"RTN","C0PXEWD",44,0)
 I '$D(ZREDUX) S ZREDUX=""
"RTN","C0PXEWD",45,0)
 N NEWPATH
"RTN","C0PXEWD",46,0)
 N NEWNUM S NEWNUM=""
"RTN","C0PXEWD",47,0)
 I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"
"RTN","C0PXEWD",48,0)
 S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE
"RTN","C0PXEWD",49,0)
 I $G(ZREDUX)'="" D  ; REDUX PROVIDED?
"RTN","C0PXEWD",50,0)
 . N GT S GT=$P(NEWPATH,ZREDUX,2)
"RTN","C0PXEWD",51,0)
 . I GT'="" S NEWPATH=GT
"RTN","C0PXEWD",52,0)
 S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX
"RTN","C0PXEWD",53,0)
 N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE
"RTN","C0PXEWD",54,0)
 I $D(GD(2)) M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY
"RTN","C0PXEWD",55,0)
 E  I $D(GD(1)) S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY
"RTN","C0PXEWD",56,0)
 I GD'="" S @ZXPARY@(NEWPATH)=GD ; IF YES, ADD IT TO THE XPATH ARRAY
"RTN","C0PXEWD",57,0)
 N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD
"RTN","C0PXEWD",58,0)
 I ZFRST'="" D  ; THERE IS A CHILD
"RTN","C0PXEWD",59,0)
 . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE
"RTN","C0PXEWD",60,0)
 . D XPATH(ZFRST,NEWPATH,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; DO THE CHILD
"RTN","C0PXEWD",61,0)
 N GNXT S GNXT=$$NXTSIB(ZOID)
"RTN","C0PXEWD",62,0)
 I GNXT'="" D  ; MOVE ON TO THE NEXT SIBLING
"RTN","C0PXEWD",63,0)
 . D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; DO NEXT SIB
"RTN","C0PXEWD",64,0)
 Q
"RTN","C0PXEWD",65,0)
 ;
"RTN","C0PXEWD",66,0)
PARSE(INXML,INDOC) ;CALL THE EWD PARSER ON INXML, PASSED BY NAME
"RTN","C0PXEWD",67,0)
 ; INDOC IS PASSED AS THE DOCUMENT NAME TO EWD
"RTN","C0PXEWD",68,0)
 ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY EWD
"RTN","C0PXEWD",69,0)
 N ZR
"RTN","C0PXEWD",70,0)
 K ^CacheTempEWD($j) ; CLEAN OUT ANYTHING THAT MIGHT HAVE BEEN THERE
"RTN","C0PXEWD",71,0)
 M ^CacheTempEWD($j)=@INXML ;
"RTN","C0PXEWD",72,0)
 S ZR=$$parseDocument^%zewdHTMLParser(INDOC)
"RTN","C0PXEWD",73,0)
 K ^CacheTempEWD($j) ;clean up after ourselves
"RTN","C0PXEWD",74,0)
 Q ZR
"RTN","C0PXEWD",75,0)
 ;
"RTN","C0PXEWD",76,0)
DELETE(INDOC) ; DELETE A PARSED DOCUMENT FROM THE EWD DOM 
"RTN","C0PXEWD",77,0)
 ; AFTER IT'S NO LONGER NEEDED
"RTN","C0PXEWD",78,0)
 N OK
"RTN","C0PXEWD",79,0)
 S OK=$$removeDocument^%zewdDOM(INDOC)
"RTN","C0PXEWD",80,0)
 Q OK
"RTN","C0PXEWD",81,0)
 ;
"RTN","C0PXEWD",82,0)
ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
"RTN","C0PXEWD",83,0)
 N ZN
"RTN","C0PXEWD",84,0)
 S ZN=$$NXTSIB(ZOID)
"RTN","C0PXEWD",85,0)
 I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
"RTN","C0PXEWD",86,0)
 Q 0
"RTN","C0PXEWD",87,0)
 ;
"RTN","C0PXEWD",88,0)
DETAIL(ZRTN,ZOID) ; RETURNS DETAIL FOR NODE ZOID IN ZRTN, PASSED BY NAME
"RTN","C0PXEWD",89,0)
 N DET
"RTN","C0PXEWD",90,0)
 D getElementDetails^%zewdXPath(ZOID,.DET)
"RTN","C0PXEWD",91,0)
 M @ZRTN=DET
"RTN","C0PXEWD",92,0)
 Q
"RTN","C0PXEWD",93,0)
 ;
"RTN","C0PXEWD",94,0)
ID(ZNAME) ;RETURNS THE docOID OF THE DOCUMENT NAMED ZNAME
"RTN","C0PXEWD",95,0)
 Q $$getDocumentNode^%zewdDOM(ZNAME)
"RTN","C0PXEWD",96,0)
 ;
"RTN","C0PXEWD",97,0)
NAME(ZOID) ;RETURNS THE NAME OF THE DOCUMENAT WITH docOID ZOID
"RTN","C0PXEWD",98,0)
 Q $$getDocumentName^%zewdDOM(ZOID)
"RTN","C0PXEWD",99,0)
 ;
"RTN","C0PXEWD",100,0)
FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
"RTN","C0PXEWD",101,0)
 N GOID
"RTN","C0PXEWD",102,0)
 S GOID=ZOID
"RTN","C0PXEWD",103,0)
 S GOID=$$getFirstChild^%zewdDOM(GOID)
"RTN","C0PXEWD",104,0)
 I GOID="" Q ""
"RTN","C0PXEWD",105,0)
 I $$getNodeType^%zewdDOM(GOID)'=1 S GOID=$$NXTCHLD(GOID)
"RTN","C0PXEWD",106,0)
 Q GOID
"RTN","C0PXEWD",107,0)
 ;
"RTN","C0PXEWD",108,0)
HASCHILD(ZOID) ; RETURNS TRUE IF ZOID HAS CHILD NODES
"RTN","C0PXEWD",109,0)
 Q $$hasChildNodes^%zewdDOM(ZOID)
"RTN","C0PXEWD",110,0)
 ;
"RTN","C0PXEWD",111,0)
CHILDREN(ZRTN,ZOID) ;RETURNS CHILDREN OF ZOID IN ARRAY ZRTN, PASSED BY NAME
"RTN","C0PXEWD",112,0)
 N childArray
"RTN","C0PXEWD",113,0)
 d getChildrenInOrder^%zewdDOM(ZOID,.childArray)
"RTN","C0PXEWD",114,0)
 m @ZRTN=childArray
"RTN","C0PXEWD",115,0)
 q
"RTN","C0PXEWD",116,0)
 ;
"RTN","C0PXEWD",117,0)
TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
"RTN","C0PXEWD",118,0)
 Q $$getName^%zewdDOM(ZOID)
"RTN","C0PXEWD",119,0)
 ;
"RTN","C0PXEWD",120,0)
NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
"RTN","C0PXEWD",121,0)
 Q $$getNextSibling^%zewdDOM(ZOID)
"RTN","C0PXEWD",122,0)
 ;
"RTN","C0PXEWD",123,0)
NXTCHLD(ZOID) ; RETURNS THE NEXT CHILD IN PARENT ZPAR
"RTN","C0PXEWD",124,0)
 N GOID
"RTN","C0PXEWD",125,0)
 S GOID=$$getNextChild^%zewdDOM($$PARENT(ZOID),ZOID)
"RTN","C0PXEWD",126,0)
 I GOID="" Q ""
"RTN","C0PXEWD",127,0)
 I $$getNodeType^%zewdDOM(GOID)'=1 S GOID=$$NXTCHLD(GOID)
"RTN","C0PXEWD",128,0)
 Q GOID
"RTN","C0PXEWD",129,0)
 ;
"RTN","C0PXEWD",130,0)
PARENT(ZOID) ; RETURNS PARENT OF ZOID
"RTN","C0PXEWD",131,0)
 Q $$getParentNode^%zewdDOM(ZOID)
"RTN","C0PXEWD",132,0)
 ;
"RTN","C0PXEWD",133,0)
DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
"RTN","C0PXEWD",134,0)
 N ZT2
"RTN","C0PXEWD",135,0)
 S ZT2=$$getElementText^%zewdDOM(ZOID,.ZT2)
"RTN","C0PXEWD",136,0)
 M @ZT=ZT2
"RTN","C0PXEWD",137,0)
 Q
"RTN","C0PXEWD",138,0)
 ;Q $$getTextValue^%zewdXPath(ZOID)
"RTN","C0PXEWD",139,0)
 ;Q $$getData^%zewdDOM(ZOID,.ZT)
"RTN","C0PXEWD",140,0)
 ;
"SEC","^DD",113059002,113059002,1.1,9)

"SEC","^DD",113059002,113059002,1.2,9)

"SEC","^DD",113059002,113059002,1.3,9)

"SEC","^DD",113059002,113059002,1.4,9)

"SEC","^DD",113059002,113059002,1.41,9)

"SEC","^DD",113059002,113059002,1.5,9)

"SEC","^DD",1130590010.002,1130590010.002,1.05,9)

"SEC","^DD",1130590010.002,1130590010.002,4.01,9)

"SEC","^DD",1130590010.002,1130590010.002,4.02,9)

"SEC","^DIC",113059001,113059001,0,"AUDIT")
@
"SEC","^DIC",113059001,113059001,0,"DD")
@
"SEC","^DIC",113059001,113059001,0,"DEL")
@
"SEC","^DIC",113059001,113059001,0,"LAYGO")
@
"SEC","^DIC",113059001,113059001,0,"RD")
@
"SEC","^DIC",113059001,113059001,0,"WR")
@
"SEC","^DIC",113059002,113059002,0,"AUDIT")
@
"SEC","^DIC",113059002,113059002,0,"DD")
@
"SEC","^DIC",113059002,113059002,0,"DEL")
@
"SEC","^DIC",113059002,113059002,0,"LAYGO")
@
"SEC","^DIC",113059002,113059002,0,"RD")
@
"SEC","^DIC",113059002,113059002,0,"WR")
@
"SEC","^DIC",113059003,113059003,0,"AUDIT")
@
"SEC","^DIC",113059003,113059003,0,"DD")
@
"SEC","^DIC",113059003,113059003,0,"DEL")
@
"SEC","^DIC",113059003,113059003,0,"LAYGO")
@
"SEC","^DIC",113059003,113059003,0,"RD")
@
"SEC","^DIC",113059003,113059003,0,"WR")
@
"SEC","^DIC",1130590010,1130590010,0,"AUDIT")
@
"SEC","^DIC",1130590010,1130590010,0,"DD")

"SEC","^DIC",1130590010,1130590010,0,"DEL")
@
"SEC","^DIC",1130590010,1130590010,0,"LAYGO")
@
"SEC","^DIC",1130590010,1130590010,0,"RD")

"SEC","^DIC",1130590010,1130590010,0,"WR")
@
"SEC","^DIC",1130590010.002,1130590010.002,0,"AUDIT")
@
"SEC","^DIC",1130590010.002,1130590010.002,0,"DD")
@
"SEC","^DIC",1130590010.002,1130590010.002,0,"DEL")
@
"SEC","^DIC",1130590010.002,1130590010.002,0,"LAYGO")
@
"SEC","^DIC",1130590010.002,1130590010.002,0,"RD")
@
"SEC","^DIC",1130590010.002,1130590010.002,0,"WR")
@
"SEC","^DIC",1130590011.001,1130590011.001,0,"AUDIT")
@
"SEC","^DIC",1130590011.001,1130590011.001,0,"DD")

"SEC","^DIC",1130590011.001,1130590011.001,0,"DEL")
@
"SEC","^DIC",1130590011.001,1130590011.001,0,"LAYGO")
@
"SEC","^DIC",1130590011.001,1130590011.001,0,"RD")

"SEC","^DIC",1130590011.001,1130590011.001,0,"WR")
@
"UP",44,44.113059,-1)
44^C0P
"UP",44,44.113059,0)
44.113059
"UP",200,200.113059,-1)
200^C0P
"UP",200,200.113059,0)
200.113059
"VER")
8.0^22.0
"^DD",44,44,113059001,0)
C0P ERX PHONE FAX^44.113059I^^C0P;0
"^DD",44,44,113059001,21,0)
^^3^3^3120504^
"^DD",44,44,113059001,21,1,0)
This subfile stores Phone and Fax numbers for locations that use
"^DD",44,44,113059001,21,2,0)
ePrescribing. Each location can have multiple phone and fax numbers. The 
"^DD",44,44,113059001,21,3,0)
ones that are to be used primarily should be given the highest priority.
"^DD",44,44,113059001,23,0)
^^21^21^3120504^
"^DD",44,44,113059001,23,1,0)
This subfile was created by George Lilly for the Oroville ePrescribing
"^DD",44,44,113059001,23,2,0)
project to store Phone and Fax numbers for locations that use 
"^DD",44,44,113059001,23,3,0)
ePrescribing. Each location can have multiple phone and fax numbers. The 
"^DD",44,44,113059001,23,4,0)
ones that are to be used primarily should be given the highest priority.
"^DD",44,44,113059001,23,5,0)
 
"^DD",44,44,113059001,23,6,0)
Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"^DD",44,44,113059001,23,7,0)
General Public License See attached copy of the License.
"^DD",44,44,113059001,23,8,0)
 
"^DD",44,44,113059001,23,9,0)
This program is free software; you can redistribute it and/or modify
"^DD",44,44,113059001,23,10,0)
it under the terms of the GNU General Public License as published by
"^DD",44,44,113059001,23,11,0)
the Free Software Foundation; either version 2 of the License, or
"^DD",44,44,113059001,23,12,0)
(at your option) any later version.
"^DD",44,44,113059001,23,13,0)
 
"^DD",44,44,113059001,23,14,0)
This program is distributed in the hope that it will be useful,
"^DD",44,44,113059001,23,15,0)
but WITHOUT ANY WARRANTY; without even the implied warranty of
"^DD",44,44,113059001,23,16,0)
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"^DD",44,44,113059001,23,17,0)
GNU General Public License for more details.
"^DD",44,44,113059001,23,18,0)
     
"^DD",44,44,113059001,23,19,0)
You should have received a copy of the GNU General Public License along
"^DD",44,44,113059001,23,20,0)
with this program; if not, write to the Free Software Foundation, Inc.,
"^DD",44,44,113059001,23,21,0)
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.   
"^DD",44,44,113059111,0)
C0P ERX STREET ADDRESS 1^F^^100;1^K:$L(X)>50!($L(X)<2) X
"^DD",44,44,113059111,.1)

"^DD",44,44,113059111,3)
eRx Street Address 1 to send to web service
"^DD",44,44,113059111,21,0)
^^1^1^3120504^^^
"^DD",44,44,113059111,21,1,0)
Enter first line of your street address for this hospital location.
"^DD",44,44,113059111,23,0)
^^16^16^3120504^
"^DD",44,44,113059111,23,1,0)
Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"^DD",44,44,113059111,23,2,0)
General Public License See attached copy of the License.
"^DD",44,44,113059111,23,3,0)
 
"^DD",44,44,113059111,23,4,0)
This program is free software; you can redistribute it and/or modify
"^DD",44,44,113059111,23,5,0)
it under the terms of the GNU General Public License as published by
"^DD",44,44,113059111,23,6,0)
the Free Software Foundation; either version 2 of the License, or
"^DD",44,44,113059111,23,7,0)
(at your option) any later version.
"^DD",44,44,113059111,23,8,0)
 
"^DD",44,44,113059111,23,9,0)
This program is distributed in the hope that it will be useful,
"^DD",44,44,113059111,23,10,0)
but WITHOUT ANY WARRANTY; without even the implied warranty of
"^DD",44,44,113059111,23,11,0)
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"^DD",44,44,113059111,23,12,0)
GNU General Public License for more details.
"^DD",44,44,113059111,23,13,0)
     
"^DD",44,44,113059111,23,14,0)
You should have received a copy of the GNU General Public License along
"^DD",44,44,113059111,23,15,0)
with this program; if not, write to the Free Software Foundation, Inc.,
"^DD",44,44,113059111,23,16,0)
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.   
"^DD",44,44,113059111,"DT")
3120504
"^DD",44,44,113059112,0)
C0P ERX STREET ADDRESS 2^F^^101;1^K:$L(X)>50!($L(X)<2) X
"^DD",44,44,113059112,.1)

"^DD",44,44,113059112,3)
eRx Street Address 1 to send to web service
"^DD",44,44,113059112,21,0)
^^1^1^3120504^^
"^DD",44,44,113059112,21,1,0)
Enter your second address line for ePrescribing.
"^DD",44,44,113059112,23,0)
^^16^16^3120504^^
"^DD",44,44,113059112,23,1,0)
Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"^DD",44,44,113059112,23,2,0)
General Public License See attached copy of the License.
"^DD",44,44,113059112,23,3,0)
 
"^DD",44,44,113059112,23,4,0)
This program is free software; you can redistribute it and/or modify
"^DD",44,44,113059112,23,5,0)
it under the terms of the GNU General Public License as published by
"^DD",44,44,113059112,23,6,0)
the Free Software Foundation; either version 2 of the License, or
"^DD",44,44,113059112,23,7,0)
(at your option) any later version.
"^DD",44,44,113059112,23,8,0)
 
"^DD",44,44,113059112,23,9,0)
This program is distributed in the hope that it will be useful,
"^DD",44,44,113059112,23,10,0)
but WITHOUT ANY WARRANTY; without even the implied warranty of
"^DD",44,44,113059112,23,11,0)
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"^DD",44,44,113059112,23,12,0)
GNU General Public License for more details.
"^DD",44,44,113059112,23,13,0)
     
"^DD",44,44,113059112,23,14,0)
You should have received a copy of the GNU General Public License along
"^DD",44,44,113059112,23,15,0)
with this program; if not, write to the Free Software Foundation, Inc.,
"^DD",44,44,113059112,23,16,0)
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.   
"^DD",44,44,113059112,"DT")
3120504
"^DD",44,44,113059114,0)
C0P ERX CITY^F^^102;1^K:$L(X)>50!($L(X)<2) X
"^DD",44,44,113059114,.1)
LOCATION CITY
"^DD",44,44,113059114,3)
City for Practice Location of Subscriber
"^DD",44,44,113059114,21,0)
^^2^2^3120504^^
"^DD",44,44,113059114,21,1,0)
Enter the city in which this hospital location is located. This city may 
"^DD",44,44,113059114,21,2,0)
be different from where the main institution is.
"^DD",44,44,113059114,23,0)
^^16^16^3120504^^
"^DD",44,44,113059114,23,1,0)
Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"^DD",44,44,113059114,23,2,0)
General Public License See attached copy of the License.
"^DD",44,44,113059114,23,3,0)
 
"^DD",44,44,113059114,23,4,0)
This program is free software; you can redistribute it and/or modify
"^DD",44,44,113059114,23,5,0)
it under the terms of the GNU General Public License as published by
"^DD",44,44,113059114,23,6,0)
the Free Software Foundation; either version 2 of the License, or
"^DD",44,44,113059114,23,7,0)
(at your option) any later version.
"^DD",44,44,113059114,23,8,0)
 
"^DD",44,44,113059114,23,9,0)
This program is distributed in the hope that it will be useful,
"^DD",44,44,113059114,23,10,0)
but WITHOUT ANY WARRANTY; without even the implied warranty of
"^DD",44,44,113059114,23,11,0)
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"^DD",44,44,113059114,23,12,0)
GNU General Public License for more details.
"^DD",44,44,113059114,23,13,0)
     
"^DD",44,44,113059114,23,14,0)
You should have received a copy of the GNU General Public License along
"^DD",44,44,113059114,23,15,0)
with this program; if not, write to the Free Software Foundation, Inc.,
"^DD",44,44,113059114,23,16,0)
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.   
"^DD",44,44,113059114,"DT")
3120504
"^DD",44,44,113059115,0)
C0P ERX STATE^P5'^DIC(5,^103;1^Q
"^DD",44,44,113059115,.1)
LOCATION STATE
"^DD",44,44,113059115,3)
State where the Hospital Location is located.
"^DD",44,44,113059115,21,0)
^^2^2^3120504^
"^DD",44,44,113059115,21,1,0)
Enter the state where the Hospital Location is located. This is 
"^DD",44,44,113059115,21,2,0)
transmitted to the web service.
"^DD",44,44,113059115,23,0)
^^16^16^3120504^
"^DD",44,44,113059115,23,1,0)
Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"^DD",44,44,113059115,23,2,0)
General Public License See attached copy of the License.
"^DD",44,44,113059115,23,3,0)
 
"^DD",44,44,113059115,23,4,0)
This program is free software; you can redistribute it and/or modify
"^DD",44,44,113059115,23,5,0)
it under the terms of the GNU General Public License as published by
"^DD",44,44,113059115,23,6,0)
the Free Software Foundation; either version 2 of the License, or
"^DD",44,44,113059115,23,7,0)
(at your option) any later version.
"^DD",44,44,113059115,23,8,0)
 
"^DD",44,44,113059115,23,9,0)
This program is distributed in the hope that it will be useful,
"^DD",44,44,113059115,23,10,0)
but WITHOUT ANY WARRANTY; without even the implied warranty of
"^DD",44,44,113059115,23,11,0)
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"^DD",44,44,113059115,23,12,0)
GNU General Public License for more details.
"^DD",44,44,113059115,23,13,0)
     
"^DD",44,44,113059115,23,14,0)
You should have received a copy of the GNU General Public License along
"^DD",44,44,113059115,23,15,0)
with this program; if not, write to the Free Software Foundation, Inc.,
"^DD",44,44,113059115,23,16,0)
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.   
"^DD",44,44,113059115,"DT")
3120504
"^DD",44,44,113059116,0)
C0P ERX ZIP CODE^F^^104;1^K:$L(X)>10!($L(X)<5)!'(X?5N!(X?5N1"-"4N)) X
"^DD",44,44,113059116,.1)

"^DD",44,44,113059116,3)
Zip code for this location
"^DD",44,44,113059116,21,0)
^^1^1^3120504^^^
"^DD",44,44,113059116,21,1,0)
Enter the zip code for this location for ePrescribing
"^DD",44,44,113059116,23,0)
^^16^16^3120504^^^
"^DD",44,44,113059116,23,1,0)
Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"^DD",44,44,113059116,23,2,0)
General Public License See attached copy of the License.
"^DD",44,44,113059116,23,3,0)
 
"^DD",44,44,113059116,23,4,0)
This program is free software; you can redistribute it and/or modify
"^DD",44,44,113059116,23,5,0)
it under the terms of the GNU General Public License as published by
"^DD",44,44,113059116,23,6,0)
the Free Software Foundation; either version 2 of the License, or
"^DD",44,44,113059116,23,7,0)
(at your option) any later version.
"^DD",44,44,113059116,23,8,0)
 
"^DD",44,44,113059116,23,9,0)
This program is distributed in the hope that it will be useful,
"^DD",44,44,113059116,23,10,0)
but WITHOUT ANY WARRANTY; without even the implied warranty of
"^DD",44,44,113059116,23,11,0)
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"^DD",44,44,113059116,23,12,0)
GNU General Public License for more details.
"^DD",44,44,113059116,23,13,0)
     
"^DD",44,44,113059116,23,14,0)
You should have received a copy of the GNU General Public License along
"^DD",44,44,113059116,23,15,0)
with this program; if not, write to the Free Software Foundation, Inc.,
"^DD",44,44,113059116,23,16,0)
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.   
"^DD",44,44,113059116,"DT")
3120504
"^DD",44,44.113059,0)
C0P ERX PHONE FAX SUB-FIELD^^3^4
"^DD",44,44.113059,0,"DT")
3120519
"^DD",44,44.113059,0,"ID",3)
W "   ",$P(^(0),U,4)
"^DD",44,44.113059,0,"IX","B",44.113059,.01)

"^DD",44,44.113059,0,"NM","C0P ERX PHONE FAX")

"^DD",44,44.113059,0,"UP")
44
"^DD",44,44.113059,.01,0)
C0P ERX PHONE FAX LABEL^MF^^0;1^K:$L(X)>30!($L(X)<3) X
"^DD",44,44.113059,.01,.1)

"^DD",44,44.113059,.01,1,0)
^.1
"^DD",44,44.113059,.01,1,1,0)
44.113059^B
"^DD",44,44.113059,.01,1,1,1)
S ^SC(DA(1),"C0P","B",$E(X,1,30),DA)=""
"^DD",44,44.113059,.01,1,1,2)
K ^SC(DA(1),"C0P","B",$E(X,1,30),DA)
"^DD",44,44.113059,.01,3)
Label for phone and fax number to use in ePrescribing
"^DD",44,44.113059,.01,23,0)
^^16^16^3120504^
"^DD",44,44.113059,.01,23,1,0)
Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"^DD",44,44.113059,.01,23,2,0)
General Public License See attached copy of the License.
"^DD",44,44.113059,.01,23,3,0)
 
"^DD",44,44.113059,.01,23,4,0)
This program is free software; you can redistribute it and/or modify
"^DD",44,44.113059,.01,23,5,0)
it under the terms of the GNU General Public License as published by
"^DD",44,44.113059,.01,23,6,0)
the Free Software Foundation; either version 2 of the License, or
"^DD",44,44.113059,.01,23,7,0)
(at your option) any later version.
"^DD",44,44.113059,.01,23,8,0)
 
"^DD",44,44.113059,.01,23,9,0)
This program is distributed in the hope that it will be useful,
"^DD",44,44.113059,.01,23,10,0)
but WITHOUT ANY WARRANTY; without even the implied warranty of
"^DD",44,44.113059,.01,23,11,0)
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"^DD",44,44.113059,.01,23,12,0)
GNU General Public License for more details.
"^DD",44,44.113059,.01,23,13,0)
     
"^DD",44,44.113059,.01,23,14,0)
You should have received a copy of the GNU General Public License along
"^DD",44,44.113059,.01,23,15,0)
with this program; if not, write to the Free Software Foundation, Inc.,
"^DD",44,44.113059,.01,23,16,0)
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.   
"^DD",44,44.113059,.01,"DT")
3120504
"^DD",44,44.113059,1,0)
C0P PHONE^RF^^0;2^K:$L(X)>30!($L(X)<3) X
"^DD",44,44.113059,1,.1)

"^DD",44,44.113059,1,3)
eRx Contact Phone Number
"^DD",44,44.113059,1,21,0)
^^2^2^3120504^
"^DD",44,44.113059,1,21,1,0)
This is the number which will be sent the pharmacy as the contact 
"^DD",44,44.113059,1,21,2,0)
information for a prescription provider
"^DD",44,44.113059,1,23,0)
^^16^16^3120504^
"^DD",44,44.113059,1,23,1,0)
Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"^DD",44,44.113059,1,23,2,0)
General Public License See attached copy of the License.
"^DD",44,44.113059,1,23,3,0)
 
"^DD",44,44.113059,1,23,4,0)
This program is free software; you can redistribute it and/or modify
"^DD",44,44.113059,1,23,5,0)
it under the terms of the GNU General Public License as published by
"^DD",44,44.113059,1,23,6,0)
the Free Software Foundation; either version 2 of the License, or
"^DD",44,44.113059,1,23,7,0)
(at your option) any later version.
"^DD",44,44.113059,1,23,8,0)
 
"^DD",44,44.113059,1,23,9,0)
This program is distributed in the hope that it will be useful,
"^DD",44,44.113059,1,23,10,0)
but WITHOUT ANY WARRANTY; without even the implied warranty of
"^DD",44,44.113059,1,23,11,0)
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"^DD",44,44.113059,1,23,12,0)
GNU General Public License for more details.
"^DD",44,44.113059,1,23,13,0)
     
"^DD",44,44.113059,1,23,14,0)
You should have received a copy of the GNU General Public License along
"^DD",44,44.113059,1,23,15,0)
with this program; if not, write to the Free Software Foundation, Inc.,
"^DD",44,44.113059,1,23,16,0)
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.   
"^DD",44,44.113059,1,"DT")
3120519
"^DD",44,44.113059,2,0)
C0P FAX^RF^^0;3^K:$L(X)>30!($L(X)<3) X
"^DD",44,44.113059,2,.1)

"^DD",44,44.113059,2,3)
Contact Fax Number
"^DD",44,44.113059,2,21,0)
^^2^2^3120504^
"^DD",44,44.113059,2,21,1,0)
This is the fax number which will be sent to the pharmacy as contact 
"^DD",44,44.113059,2,21,2,0)
information for the prescription provider
"^DD",44,44.113059,2,23,0)
^^16^16^3120504^
"^DD",44,44.113059,2,23,1,0)
Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"^DD",44,44.113059,2,23,2,0)
General Public License See attached copy of the License.
"^DD",44,44.113059,2,23,3,0)
 
"^DD",44,44.113059,2,23,4,0)
This program is free software; you can redistribute it and/or modify
"^DD",44,44.113059,2,23,5,0)
it under the terms of the GNU General Public License as published by
"^DD",44,44.113059,2,23,6,0)
the Free Software Foundation; either version 2 of the License, or
"^DD",44,44.113059,2,23,7,0)
(at your option) any later version.
"^DD",44,44.113059,2,23,8,0)
 
"^DD",44,44.113059,2,23,9,0)
This program is distributed in the hope that it will be useful,
"^DD",44,44.113059,2,23,10,0)
but WITHOUT ANY WARRANTY; without even the implied warranty of
"^DD",44,44.113059,2,23,11,0)
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"^DD",44,44.113059,2,23,12,0)
GNU General Public License for more details.
"^DD",44,44.113059,2,23,13,0)
     
"^DD",44,44.113059,2,23,14,0)
You should have received a copy of the GNU General Public License along
"^DD",44,44.113059,2,23,15,0)
with this program; if not, write to the Free Software Foundation, Inc.,
"^DD",44,44.113059,2,23,16,0)
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.   
"^DD",44,44.113059,2,"DT")
3120519
"^DD",44,44.113059,3,0)
C0P PRIORITY^RNJ4,0^^0;4^K:+X'=X!(X>1000)!(X<1)!(X?.E1"."1.N) X
"^DD",44,44.113059,3,.1)

"^DD",44,44.113059,3,3)
Phone fax combination priority - 1 is highest priority
"^DD",44,44.113059,3,21,0)
^^3^3^3120504^^
"^DD",44,44.113059,3,21,1,0)
The priority that should be given to this phone and fax number 
"^DD",44,44.113059,3,21,2,0)
combination 1 is the highest priority. The Highest priority combination 
"^DD",44,44.113059,3,21,3,0)
will be used and the others will be ignored.
"^DD",44,44.113059,3,23,0)
^^24^24^3120504^^^
"^DD",44,44.113059,3,23,1,0)
This field was created by George Lilly for the Oroville ePrescribing 
"^DD",44,44.113059,3,23,2,0)
project. It is used to select which phone and fax number pair will be 
"^DD",44,44.113059,3,23,3,0)
send to the pharmacy for this location. 1 is the highest priority. All 
"^DD",44,44.113059,3,23,4,0)
combinations other than the highest priority one will be ignored. The
"^DD",44,44.113059,3,23,5,0)
intention is to allow the administrator to set up in advance multiple 
"^DD",44,44.113059,3,23,6,0)
phone and fax number combinations, and to easily switch to a backup pair 
"^DD",44,44.113059,3,23,7,0)
by changing the priorities.
"^DD",44,44.113059,3,23,8,0)
 
"^DD",44,44.113059,3,23,9,0)
Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"^DD",44,44.113059,3,23,10,0)
General Public License See attached copy of the License.
"^DD",44,44.113059,3,23,11,0)
 
"^DD",44,44.113059,3,23,12,0)
This program is free software; you can redistribute it and/or modify
"^DD",44,44.113059,3,23,13,0)
it under the terms of the GNU General Public License as published by
"^DD",44,44.113059,3,23,14,0)
the Free Software Foundation; either version 2 of the License, or
"^DD",44,44.113059,3,23,15,0)
(at your option) any later version.
"^DD",44,44.113059,3,23,16,0)
 
"^DD",44,44.113059,3,23,17,0)
This program is distributed in the hope that it will be useful,
"^DD",44,44.113059,3,23,18,0)
but WITHOUT ANY WARRANTY; without even the implied warranty of
"^DD",44,44.113059,3,23,19,0)
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"^DD",44,44.113059,3,23,20,0)
GNU General Public License for more details.
"^DD",44,44.113059,3,23,21,0)
     
"^DD",44,44.113059,3,23,22,0)
You should have received a copy of the GNU General Public License along
"^DD",44,44.113059,3,23,23,0)
with this program; if not, write to the Free Software Foundation, Inc.,
"^DD",44,44.113059,3,23,24,0)
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.   
"^DD",44,44.113059,3,"DT")
3120519
"^DD",200,200,113059003,0)
C0P SUBSCRIPTION^200.113059S^^C0P;0
"^DD",200,200,113059003,21,0)
^^1^1^3120504^
"^DD",200,200,113059003,21,1,0)
This multiple contains subscriptions to web services for this user.
"^DD",200,200,113059003,23,0)
^^16^16^3120504^
"^DD",200,200,113059003,23,1,0)
Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"^DD",200,200,113059003,23,2,0)
General Public License See attached copy of the License.
"^DD",200,200,113059003,23,3,0)
 
"^DD",200,200,113059003,23,4,0)
This program is free software; you can redistribute it and/or modify
"^DD",200,200,113059003,23,5,0)
it under the terms of the GNU General Public License as published by
"^DD",200,200,113059003,23,6,0)
the Free Software Foundation; either version 2 of the License, or
"^DD",200,200,113059003,23,7,0)
(at your option) any later version.
"^DD",200,200,113059003,23,8,0)
 
"^DD",200,200,113059003,23,9,0)
This program is distributed in the hope that it will be useful,
"^DD",200,200,113059003,23,10,0)
but WITHOUT ANY WARRANTY; without even the implied warranty of
"^DD",200,200,113059003,23,11,0)
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"^DD",200,200,113059003,23,12,0)
GNU General Public License for more details.
"^DD",200,200,113059003,23,13,0)
     
"^DD",200,200,113059003,23,14,0)
You should have received a copy of the GNU General Public License along
"^DD",200,200,113059003,23,15,0)
with this program; if not, write to the Free Software Foundation, Inc.,
"^DD",200,200,113059003,23,16,0)
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.   
"^DD",200,200.113059,0)
C0P SUBSCRIPTION SUB-FIELD^^6^9
"^DD",200,200.113059,0,"DT")
3120504
"^DD",200,200.113059,0,"IX","B",200.113059,.01)

"^DD",200,200.113059,0,"NM","C0P SUBSCRIPTION")

"^DD",200,200.113059,0,"UP")
200
"^DD",200,200.113059,.01,0)
C0P SUBSCRIPTION TYPE^S^ERX:EPRESCRIBING;WS:WEB SERVICE;^0;1^Q
"^DD",200,200.113059,.01,.1)
SUBSCRIPTION TYPE
"^DD",200,200.113059,.01,1,0)
^.1
"^DD",200,200.113059,.01,1,1,0)
200.113059^B
"^DD",200,200.113059,.01,1,1,1)
S ^VA(200,DA(1),"C0P","B",$E(X,1,30),DA)=""
"^DD",200,200.113059,.01,1,1,2)
K ^VA(200,DA(1),"C0P","B",$E(X,1,30),DA)
"^DD",200,200.113059,.01,3)
Subscription Type - ERX or WS
"^DD",200,200.113059,.01,21,0)
^^2^2^3120504^
"^DD",200,200.113059,.01,21,1,0)
The type of web service that this person has a subscription to. 
"^DD",200,200.113059,.01,21,2,0)
ePrescribing is ERX. All others are type WS for Web Service.
"^DD",200,200.113059,.01,23,0)
^^21^21^3120504^
"^DD",200,200.113059,.01,23,1,0)
This subfile was created by George Lilly for the Oroville ePrescribing project.
"^DD",200,200.113059,.01,23,2,0)
 
"^DD",200,200.113059,.01,23,3,0)
It contains information required for each subscriber to connect them to 
"^DD",200,200.113059,.01,23,4,0)
the eRx web service.
"^DD",200,200.113059,.01,23,5,0)
 
"^DD",200,200.113059,.01,23,6,0)
Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"^DD",200,200.113059,.01,23,7,0)
General Public License See attached copy of the License.
"^DD",200,200.113059,.01,23,8,0)
 
"^DD",200,200.113059,.01,23,9,0)
This program is free software; you can redistribute it and/or modify
"^DD",200,200.113059,.01,23,10,0)
it under the terms of the GNU General Public License as published by
"^DD",200,200.113059,.01,23,11,0)
the Free Software Foundation; either version 2 of the License, or
"^DD",200,200.113059,.01,23,12,0)
(at your option) any later version.
"^DD",200,200.113059,.01,23,13,0)
 
"^DD",200,200.113059,.01,23,14,0)
This program is distributed in the hope that it will be useful,
"^DD",200,200.113059,.01,23,15,0)
but WITHOUT ANY WARRANTY; without even the implied warranty of
"^DD",200,200.113059,.01,23,16,0)
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"^DD",200,200.113059,.01,23,17,0)
GNU General Public License for more details.
"^DD",200,200.113059,.01,23,18,0)
     
"^DD",200,200.113059,.01,23,19,0)
You should have received a copy of the GNU General Public License along
"^DD",200,200.113059,.01,23,20,0)
with this program; if not, write to the Free Software Foundation, Inc.,
"^DD",200,200.113059,.01,23,21,0)
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.   
"^DD",200,200.113059,.01,"DT")
3120504
"^DD",200,200.113059,1,0)
C0P ACCOUNT^P113059002'^C0PS(^0;2^Q
"^DD",200,200.113059,1,.1)
WEB SERVICE ACCOUNT POINTER
"^DD",200,200.113059,1,3)
Web Service Account to use for E-Prescribing
"^DD",200,200.113059,1,21,0)
^^2^2^3120504^
"^DD",200,200.113059,1,21,1,0)
This field points to the web service account that this person is 
"^DD",200,200.113059,1,21,2,0)
subscribed under. 
"^DD",200,200.113059,1,23,0)
^^21^21^3120504^
"^DD",200,200.113059,1,23,1,0)
This field is a pointer to the C0P WS ACCT file, which contains 
"^DD",200,200.113059,1,23,2,0)
information a the account level for the web service that is being 
"^DD",200,200.113059,1,23,3,0)
subscribed to. It was created by George Lilly for the Oroville 
"^DD",200,200.113059,1,23,4,0)
ePrescribing project on September 9, 2009.
"^DD",200,200.113059,1,23,5,0)
 
"^DD",200,200.113059,1,23,6,0)
Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"^DD",200,200.113059,1,23,7,0)
General Public License See attached copy of the License.
"^DD",200,200.113059,1,23,8,0)
 
"^DD",200,200.113059,1,23,9,0)
This program is free software; you can redistribute it and/or modify
"^DD",200,200.113059,1,23,10,0)
it under the terms of the GNU General Public License as published by
"^DD",200,200.113059,1,23,11,0)
the Free Software Foundation; either version 2 of the License, or
"^DD",200,200.113059,1,23,12,0)
(at your option) any later version.
"^DD",200,200.113059,1,23,13,0)
 
"^DD",200,200.113059,1,23,14,0)
This program is distributed in the hope that it will be useful,
"^DD",200,200.113059,1,23,15,0)
but WITHOUT ANY WARRANTY; without even the implied warranty of
"^DD",200,200.113059,1,23,16,0)
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"^DD",200,200.113059,1,23,17,0)
GNU General Public License for more details.
"^DD",200,200.113059,1,23,18,0)
     
"^DD",200,200.113059,1,23,19,0)
You should have received a copy of the GNU General Public License along
"^DD",200,200.113059,1,23,20,0)
with this program; if not, write to the Free Software Foundation, Inc.,
"^DD",200,200.113059,1,23,21,0)
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.   
"^DD",200,200.113059,1,"DT")
3120504
"^DD",200,200.113059,2,0)
C0P LOCATION^P44'^SC(^0;3^Q
"^DD",200,200.113059,2,.1)
LOCATION FOR PHONE AND FAX NUMBER
"^DD",200,200.113059,2,3)
Location for phone and fax number
"^DD",200,200.113059,2,21,0)
^^2^2^3120504^^
"^DD",200,200.113059,2,21,1,0)
Which Hospital Location has the phone and fax number to be used for this 
"^DD",200,200.113059,2,21,2,0)
web service subscriber?
"^DD",200,200.113059,2,23,0)
^^21^21^3120504^^
"^DD",200,200.113059,2,23,1,0)
This field was created by George Lilly for the Oroville ePrescribing 
"^DD",200,200.113059,2,23,2,0)
Project. It point to the HOSPITAL LOCATION file for the purpose of 
"^DD",200,200.113059,2,23,3,0)
obtaining the phone and fax number to be sent via web services to the 
"^DD",200,200.113059,2,23,4,0)
pharmacy for this provider.
"^DD",200,200.113059,2,23,5,0)
 
"^DD",200,200.113059,2,23,6,0)
Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"^DD",200,200.113059,2,23,7,0)
General Public License See attached copy of the License.
"^DD",200,200.113059,2,23,8,0)
 
"^DD",200,200.113059,2,23,9,0)
This program is free software; you can redistribute it and/or modify
"^DD",200,200.113059,2,23,10,0)
it under the terms of the GNU General Public License as published by
"^DD",200,200.113059,2,23,11,0)
the Free Software Foundation; either version 2 of the License, or
"^DD",200,200.113059,2,23,12,0)
(at your option) any later version.
"^DD",200,200.113059,2,23,13,0)
 
"^DD",200,200.113059,2,23,14,0)
This program is distributed in the hope that it will be useful,
"^DD",200,200.113059,2,23,15,0)
but WITHOUT ANY WARRANTY; without even the implied warranty of
"^DD",200,200.113059,2,23,16,0)
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"^DD",200,200.113059,2,23,17,0)
GNU General Public License for more details.
"^DD",200,200.113059,2,23,18,0)
     
"^DD",200,200.113059,2,23,19,0)
You should have received a copy of the GNU General Public License along
"^DD",200,200.113059,2,23,20,0)
with this program; if not, write to the Free Software Foundation, Inc.,
"^DD",200,200.113059,2,23,21,0)
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.   
"^DD",200,200.113059,2,"DT")
3120504
"^DD",200,200.113059,3,0)
DISABLE SERVICE?^S^1:YES;0:NO;^0;4^Q
"^DD",200,200.113059,3,3)
Disable service for this specific user?
"^DD",200,200.113059,3,21,0)
^^1^1^3120504^^
"^DD",200,200.113059,3,21,1,0)
Use this field to disable this specific web service for this user.
"^DD",200,200.113059,3,23,0)
^^16^16^3120504^
"^DD",200,200.113059,3,23,1,0)
Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"^DD",200,200.113059,3,23,2,0)
General Public License See attached copy of the License.
"^DD",200,200.113059,3,23,3,0)
 
"^DD",200,200.113059,3,23,4,0)
This program is free software; you can redistribute it and/or modify
"^DD",200,200.113059,3,23,5,0)
it under the terms of the GNU General Public License as published by
"^DD",200,200.113059,3,23,6,0)
the Free Software Foundation; either version 2 of the License, or
"^DD",200,200.113059,3,23,7,0)
(at your option) any later version.
"^DD",200,200.113059,3,23,8,0)
 
"^DD",200,200.113059,3,23,9,0)
This program is distributed in the hope that it will be useful,
"^DD",200,200.113059,3,23,10,0)
but WITHOUT ANY WARRANTY; without even the implied warranty of
"^DD",200,200.113059,3,23,11,0)
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"^DD",200,200.113059,3,23,12,0)
GNU General Public License for more details.
"^DD",200,200.113059,3,23,13,0)
     
"^DD",200,200.113059,3,23,14,0)
You should have received a copy of the GNU General Public License along
"^DD",200,200.113059,3,23,15,0)
with this program; if not, write to the Free Software Foundation, Inc.,
"^DD",200,200.113059,3,23,16,0)
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.   
"^DD",200,200.113059,3,"DT")
3120504
"^DD",200,200.113059,4,0)
C0P USER TYPE^S^P:LicensedPrescriber;S:Staff;M:MidlevelPrescriber;V:SupervisingDoctor;^0;5^Q
"^DD",200,200.113059,4,.1)
USER TYPE
"^DD",200,200.113059,4,3)
Choose a value from the below
"^DD",200,200.113059,4,21,0)
^^1^1^3120504^^^
"^DD",200,200.113059,4,21,1,0)
Enter the user type for the e-Prescription Service.
"^DD",200,200.113059,4,23,0)
^^16^16^3120504^
"^DD",200,200.113059,4,23,1,0)
Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"^DD",200,200.113059,4,23,2,0)
General Public License See attached copy of the License.
"^DD",200,200.113059,4,23,3,0)
 
"^DD",200,200.113059,4,23,4,0)
This program is free software; you can redistribute it and/or modify
"^DD",200,200.113059,4,23,5,0)
it under the terms of the GNU General Public License as published by
"^DD",200,200.113059,4,23,6,0)
the Free Software Foundation; either version 2 of the License, or
"^DD",200,200.113059,4,23,7,0)
(at your option) any later version.
"^DD",200,200.113059,4,23,8,0)
 
"^DD",200,200.113059,4,23,9,0)
This program is distributed in the hope that it will be useful,
"^DD",200,200.113059,4,23,10,0)
but WITHOUT ANY WARRANTY; without even the implied warranty of
"^DD",200,200.113059,4,23,11,0)
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"^DD",200,200.113059,4,23,12,0)
GNU General Public License for more details.
"^DD",200,200.113059,4,23,13,0)
     
"^DD",200,200.113059,4,23,14,0)
You should have received a copy of the GNU General Public License along
"^DD",200,200.113059,4,23,15,0)
with this program; if not, write to the Free Software Foundation, Inc.,
"^DD",200,200.113059,4,23,16,0)
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.   
"^DD",200,200.113059,4,"DT")
3120504
"^DD",200,200.113059,4.1,0)
C0P USER ROLE^S^D:doctor;N:nurse;A:admin;M:manager;SD:supervisingDoctor;MP:midlevelPrescriber;^1;2^Q
"^DD",200,200.113059,4.1,.1)
USER ROLE
"^DD",200,200.113059,4.1,3)
Role for user in the New Crop WebService
"^DD",200,200.113059,4.1,23,0)
^^16^16^3120504^^
"^DD",200,200.113059,4.1,23,1,0)
Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"^DD",200,200.113059,4.1,23,2,0)
General Public License See attached copy of the License.
"^DD",200,200.113059,4.1,23,3,0)
 
"^DD",200,200.113059,4.1,23,4,0)
This program is free software; you can redistribute it and/or modify
"^DD",200,200.113059,4.1,23,5,0)
it under the terms of the GNU General Public License as published by
"^DD",200,200.113059,4.1,23,6,0)
the Free Software Foundation; either version 2 of the License, or
"^DD",200,200.113059,4.1,23,7,0)
(at your option) any later version.
"^DD",200,200.113059,4.1,23,8,0)
 
"^DD",200,200.113059,4.1,23,9,0)
This program is distributed in the hope that it will be useful,
"^DD",200,200.113059,4.1,23,10,0)
but WITHOUT ANY WARRANTY; without even the implied warranty of
"^DD",200,200.113059,4.1,23,11,0)
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"^DD",200,200.113059,4.1,23,12,0)
GNU General Public License for more details.
"^DD",200,200.113059,4.1,23,13,0)
     
"^DD",200,200.113059,4.1,23,14,0)
You should have received a copy of the GNU General Public License along
"^DD",200,200.113059,4.1,23,15,0)
with this program; if not, write to the Free Software Foundation, Inc.,
"^DD",200,200.113059,4.1,23,16,0)
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.   
"^DD",200,200.113059,4.1,"DT")
3120504
"^DD",200,200.113059,4.2,0)
C0P REQUESTED PAGE^S^C:compose;A:admin;M:manager;S:status;ME:medentry;P:patientDetail;H:maintainHealthplans;R:reports-rx-daily;^1;3^Q
"^DD",200,200.113059,4.2,.1)

"^DD",200,200.113059,4.2,3)
Start Page for E-Prescribing
"^DD",200,200.113059,4.2,21,0)
^^1^1^3120504^
"^DD",200,200.113059,4.2,21,1,0)
Start Page for the E-Prescribing New Crop Application.
"^DD",200,200.113059,4.2,23,0)
^^16^16^3120504^
"^DD",200,200.113059,4.2,23,1,0)
Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"^DD",200,200.113059,4.2,23,2,0)
General Public License See attached copy of the License.
"^DD",200,200.113059,4.2,23,3,0)
 
"^DD",200,200.113059,4.2,23,4,0)
This program is free software; you can redistribute it and/or modify
"^DD",200,200.113059,4.2,23,5,0)
it under the terms of the GNU General Public License as published by
"^DD",200,200.113059,4.2,23,6,0)
the Free Software Foundation; either version 2 of the License, or
"^DD",200,200.113059,4.2,23,7,0)
(at your option) any later version.
"^DD",200,200.113059,4.2,23,8,0)
 
"^DD",200,200.113059,4.2,23,9,0)
This program is distributed in the hope that it will be useful,
"^DD",200,200.113059,4.2,23,10,0)
but WITHOUT ANY WARRANTY; without even the implied warranty of
"^DD",200,200.113059,4.2,23,11,0)
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"^DD",200,200.113059,4.2,23,12,0)
GNU General Public License for more details.
"^DD",200,200.113059,4.2,23,13,0)
     
"^DD",200,200.113059,4.2,23,14,0)
You should have received a copy of the GNU General Public License along
"^DD",200,200.113059,4.2,23,15,0)
with this program; if not, write to the Free Software Foundation, Inc.,
"^DD",200,200.113059,4.2,23,16,0)
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.   
"^DD",200,200.113059,4.2,"DT")
3120504
"^DD",200,200.113059,5,0)
C0P SUBSCRIPTION ID^FI^^1;1^K:$L(X)>240!($L(X)<1) X
"^DD",200,200.113059,5,.1)

"^DD",200,200.113059,5,3)
UUID SUBSCRIPTION ID FOR ERX. Automatically generated.
"^DD",200,200.113059,5,21,0)
^^2^2^3120504^^
"^DD",200,200.113059,5,21,1,0)
Programatically generated UUID populated here automatically when the New 
"^DD",200,200.113059,5,21,2,0)
Crop Web Service is made if it is empty.
"^DD",200,200.113059,5,23,0)
^^16^16^3120504^
"^DD",200,200.113059,5,23,1,0)
Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"^DD",200,200.113059,5,23,2,0)
General Public License See attached copy of the License.
"^DD",200,200.113059,5,23,3,0)
 
"^DD",200,200.113059,5,23,4,0)
This program is free software; you can redistribute it and/or modify
"^DD",200,200.113059,5,23,5,0)
it under the terms of the GNU General Public License as published by
"^DD",200,200.113059,5,23,6,0)
the Free Software Foundation; either version 2 of the License, or
"^DD",200,200.113059,5,23,7,0)
(at your option) any later version.
"^DD",200,200.113059,5,23,8,0)
 
"^DD",200,200.113059,5,23,9,0)
This program is distributed in the hope that it will be useful,
"^DD",200,200.113059,5,23,10,0)
but WITHOUT ANY WARRANTY; without even the implied warranty of
"^DD",200,200.113059,5,23,11,0)
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"^DD",200,200.113059,5,23,12,0)
GNU General Public License for more details.
"^DD",200,200.113059,5,23,13,0)
     
"^DD",200,200.113059,5,23,14,0)
You should have received a copy of the GNU General Public License along
"^DD",200,200.113059,5,23,15,0)
with this program; if not, write to the Free Software Foundation, Inc.,
"^DD",200,200.113059,5,23,16,0)
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.   
"^DD",200,200.113059,5,"DT")
3120504
"^DD",200,200.113059,6,0)
C0P SUPERVISING DOCTOR^P200'^VA(200,^2;1^Q
"^DD",200,200.113059,6,.1)
SUPERVISING DOCTOR
"^DD",200,200.113059,6,3)
Enter Supervising Doctor for prescribers requiring a supervising doctor
"^DD",200,200.113059,6,21,0)
^^1^1^3120504^
"^DD",200,200.113059,6,21,1,0)
For mid-level and staff user, the default supervising doctor.
"^DD",200,200.113059,6,23,0)
^^16^16^3120504^
"^DD",200,200.113059,6,23,1,0)
Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"^DD",200,200.113059,6,23,2,0)
General Public License See attached copy of the License.
"^DD",200,200.113059,6,23,3,0)
 
"^DD",200,200.113059,6,23,4,0)
This program is free software; you can redistribute it and/or modify
"^DD",200,200.113059,6,23,5,0)
it under the terms of the GNU General Public License as published by
"^DD",200,200.113059,6,23,6,0)
the Free Software Foundation; either version 2 of the License, or
"^DD",200,200.113059,6,23,7,0)
(at your option) any later version.
"^DD",200,200.113059,6,23,8,0)
 
"^DD",200,200.113059,6,23,9,0)
This program is distributed in the hope that it will be useful,
"^DD",200,200.113059,6,23,10,0)
but WITHOUT ANY WARRANTY; without even the implied warranty of
"^DD",200,200.113059,6,23,11,0)
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"^DD",200,200.113059,6,23,12,0)
GNU General Public License for more details.
"^DD",200,200.113059,6,23,13,0)
     
"^DD",200,200.113059,6,23,14,0)
You should have received a copy of the GNU General Public License along
"^DD",200,200.113059,6,23,15,0)
with this program; if not, write to the Free Software Foundation, Inc.,
"^DD",200,200.113059,6,23,16,0)
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.   
"^DD",200,200.113059,6,"DT")
3120504
"^DD",113059001,113059001,0)
FIELD^^5^13
"^DD",113059001,113059001,0,"DDA")
N
"^DD",113059001,113059001,0,"DT")
3091016
"^DD",113059001,113059001,0,"IX","B",113059001,.01)

"^DD",113059001,113059001,0,"NM","C0P XML TEMPLATE")

"^DD",113059001,113059001,0,"PT",113059001,.03)

"^DD",113059001,113059001,0,"PT",113059001.05,1)

"^DD",113059001,113059001,0,"PT",113059003.02,2)

"^DD",113059001,113059001,0,"PT",113059003.03,.01)

"^DD",113059001,113059001,0,"PT",113059003.04,1)

"^DD",113059001,113059001,0,"VRPK")
C0P
"^DD",113059001,113059001,.01,0)
TEMPLATE NAME^RF^^0;1^K:$L(X)>30!($L(X)<3)!'(X'?1P.E) X
"^DD",113059001,113059001,.01,.1)
NAME OF THE TEMPLATE
"^DD",113059001,113059001,.01,1,0)
^.1
"^DD",113059001,113059001,.01,1,1,0)
113059001^B
"^DD",113059001,113059001,.01,1,1,1)
S ^C0PX("B",$E(X,1,30),DA)=""
"^DD",113059001,113059001,.01,1,1,2)
K ^C0PX("B",$E(X,1,30),DA)
"^DD",113059001,113059001,.01,3)
TEMPLATE NAME
"^DD",113059001,113059001,.01,"DT")
3091015
"^DD",113059001,113059001,.02,0)
BELONGS TO WEB SERVICE^P113059003^C0PW(^6;1^Q
"^DD",113059001,113059001,.02,.1)
WEB SERVICE THAT THIS TEMPLATE BELONGS TO
"^DD",113059001,113059001,.02,3)
WEB SERVICE THAT THIS TEMPLATE BELONGS TO
"^DD",113059001,113059001,.02,"DT")
3091015
"^DD",113059001,113059001,.03,0)
REPLY TEMPLATE^P113059001^C0PX(^9;2^Q
"^DD",113059001,113059001,.03,.1)
TEMPLATE TO PROCESS THE REPLY FROM REQUEST TEMPLATE
"^DD",113059001,113059001,.03,"DT")
3091015
"^DD",113059001,113059001,1,0)
URL^F^^1;1^K:$L(X)>240!($L(X)<3) X
"^DD",113059001,113059001,1,.1)
URL FOR USE WITH THIS TEMPLATE
"^DD",113059001,113059001,1,3)

"^DD",113059001,113059001,1,21,0)
^^1^1^3120504^
"^DD",113059001,113059001,1,21,1,0)
This is the Soap Request endpoint where the Soap Request must be sent.
"^DD",113059001,113059001,1,"DT")
3120504
"^DD",113059001,113059001,2,0)
WSDL URL^F^^2;1^K:$L(X)>240!($L(X)<3) X
"^DD",113059001,113059001,2,.1)
URL WHERE THE WSDL XML IS FOUND
"^DD",113059001,113059001,2,3)
URL WHERE THE WSDL XML IS FOUND
"^DD",113059001,113059001,2,"DT")
3091015
"^DD",113059001,113059001,2.1,0)
XML^113059001.01^^3;0
"^DD",113059001,113059001,2.1,21,0)
^^2^2^3120504^
"^DD",113059001,113059001,2.1,21,1,0)
Contains sample XML Soaps to send to the web service. These are then 
"^DD",113059001,113059001,2.1,21,2,0)
compiled to form the Template XML stored in the Template XML field.
"^DD",113059001,113059001,2.1,"DT")
3091015
"^DD",113059001,113059001,2.2,0)
XML HEADER^113059001.02^^7;0
"^DD",113059001,113059001,2.2,21,0)
^^2^2^3120504^
"^DD",113059001,113059001,2.2,21,1,0)
This contains the HTTP request headers for getting the XML field. It does 
"^DD",113059001,113059001,2.2,21,2,0)
not contain the XML <? xml ... ?> header.
"^DD",113059001,113059001,2.2,"DT")
3090925
"^DD",113059001,113059001,2.3,0)
MIME TYPE^F^^8;1^K:$L(X)>100!($L(X)<3) X
"^DD",113059001,113059001,2.3,.1)
MIME TYPE FOR THE XML MESSAGE
"^DD",113059001,113059001,2.3,3)
MIME TYPE FOR THE XML MESSAGE i.e. text/xml
"^DD",113059001,113059001,2.3,"DT")
3120504
"^DD",113059001,113059001,2.4,0)
PROXY SERVER^F^^8;2^K:$L(X)>100!($L(X)<3) X
"^DD",113059001,113059001,2.4,.1)

"^DD",113059001,113059001,2.4,3)
OPTIONAL PROXY SERVER TO USE
"^DD",113059001,113059001,2.4,"DT")
3120504
"^DD",113059001,113059001,2.5,0)
XPATH REDUCTION STRING^F^^9;1^K:$L(X)>240!($L(X)<3) X
"^DD",113059001,113059001,2.5,.1)

"^DD",113059001,113059001,2.5,3)
Answer must be 3-240 characters in length
"^DD",113059001,113059001,2.5,21,0)
^^1^1^3120504^
"^DD",113059001,113059001,2.5,21,1,0)
XPATH STRING TO REDUCE XPATH SIZE
"^DD",113059001,113059001,2.5,"DT")
3120504
"^DD",113059001,113059001,3,0)
TEMPLATE XML^113059001.03^^4;0
"^DD",113059001,113059001,3,21,0)
^^20^20^3120504^
"^DD",113059001,113059001,3,21,1,0)
This field holds a compliled XML template (generated by COMPILE^C0PSOAP) 
"^DD",113059001,113059001,3,21,2,0)
that contains prototype XML with @@ escaped fields for substitution 
"^DD",113059001,113059001,3,21,3,0)
processing by MAP^C0CXPATH
"^DD",113059001,113059001,3,21,4,0)
 
"^DD",113059001,113059001,3,21,5,0)
Example of variable interpolation:
"^DD",113059001,113059001,3,21,6,0)
<Name>@@PATIENTNAME@@</Name>
"^DD",113059001,113059001,3,21,7,0)
 
"^DD",113059001,113059001,3,21,8,0)
becomes:
"^DD",113059001,113059001,3,21,9,0)
 
"^DD",113059001,113059001,3,21,10,0)
<Name>Mouse,Mickey</Name>
"^DD",113059001,113059001,3,21,11,0)
 
"^DD",113059001,113059001,3,21,12,0)
Example of field interpolation based on an XPATH:
"^DD",113059001,113059001,3,21,13,0)
<PatientID>
"^DD",113059001,113059001,3,21,14,0)
//soap:Envelope/soap:Body/GetPatientFullMedicationHistory5/patientRequest
"^DD",113059001,113059001,3,21,15,0)
/PatientId
"^DD",113059001,113059001,3,21,16,0)
</PatientID>
"^DD",113059001,113059001,3,21,17,0)
 
"^DD",113059001,113059001,3,21,18,0)
becomes:
"^DD",113059001,113059001,3,21,19,0)
 
"^DD",113059001,113059001,3,21,20,0)
<PatientID>98129749824</PatientID) 
"^DD",113059001,113059001,3,"DT")
3091015
"^DD",113059001,113059001,4,0)
BINDING^113059001.04^^5;0
"^DD",113059001,113059001,4,21,0)
^^5^5^3120507^
"^DD",113059001,113059001,4,21,1,0)
This multiple contains data which is used to drive the XML Template 
"^DD",113059001,113059001,4,21,2,0)
Processor to replace @@...@@ elements in the Template XML with actual 
"^DD",113059001,113059001,4,21,3,0)
data. After actual data is in place, it is sent over to the WebService.
"^DD",113059001,113059001,4,21,4,0)
 
"^DD",113059001,113059001,4,21,5,0)
The code that does the processing is in BIND^C0PMAIN.
"^DD",113059001,113059001,4,"DT")
3091015
"^DD",113059001,113059001,5,0)
INCLUDE TEMPLATE^113059001.05^^10;0
"^DD",113059001,113059001,5,21,0)
^^4^4^3120507^
"^DD",113059001,113059001,5,21,1,0)
This multiple will allow a more dynamic slicing of Template XMLs where 
"^DD",113059001,113059001,5,21,2,0)
specific sections can be included as part of a bigger XML.
"^DD",113059001,113059001,5,21,3,0)
 
"^DD",113059001,113059001,5,21,4,0)
Currently not used in eRx 1.0.
"^DD",113059001,113059001.01,0)
XML SUB-FIELD^^.01^1
"^DD",113059001,113059001.01,0,"DT")
3090913
"^DD",113059001,113059001.01,0,"NM","XML")

"^DD",113059001,113059001.01,0,"UP")
113059001
"^DD",113059001,113059001.01,.01,0)
XML^WLx^^0;1
"^DD",113059001,113059001.01,.01,.1)

"^DD",113059001,113059001.01,.01,3)

"^DD",113059001,113059001.01,.01,"DT")
3120504
"^DD",113059001,113059001.02,0)
XML HEADER SUB-FIELD^^.01^1
"^DD",113059001,113059001.02,0,"DT")
3090925
"^DD",113059001,113059001.02,0,"NM","XML HEADER")

"^DD",113059001,113059001.02,0,"UP")
113059001
"^DD",113059001,113059001.02,.01,0)
XML HEADERS^WLx^^0;1
"^DD",113059001,113059001.02,.01,.1)

"^DD",113059001,113059001.02,.01,3)

"^DD",113059001,113059001.02,.01,"DT")
3120504
"^DD",113059001,113059001.03,0)
TEMPLATE XML SUB-FIELD^^.01^1
"^DD",113059001,113059001.03,0,"DT")
3090913
"^DD",113059001,113059001.03,0,"NM","TEMPLATE XML")

"^DD",113059001,113059001.03,0,"UP")
113059001
"^DD",113059001,113059001.03,.01,0)
TEMPLATE XML^WLx^^0;1
"^DD",113059001,113059001.03,.01,.1)

"^DD",113059001,113059001.03,.01,3)

"^DD",113059001,113059001.03,.01,"DT")
3120504
"^DD",113059001,113059001.04,0)
BINDING SUB-FIELD^^4^8
"^DD",113059001,113059001.04,0,"DT")
3091015
"^DD",113059001,113059001.04,0,"NM","BINDING")

"^DD",113059001,113059001.04,0,"UP")
113059001
"^DD",113059001,113059001.04,.01,0)
XPATH^MF^^0;1^K:$L(X)>240!($L(X)<3) X
"^DD",113059001,113059001.04,.01,.1)
BINDING XPATH
"^DD",113059001,113059001.04,.01,1,0)
^.1^^0
"^DD",113059001,113059001.04,.01,3)
XPATH or Variable Name
"^DD",113059001,113059001.04,.01,21,0)
^^1^1^3120507^
"^DD",113059001,113059001.04,.01,21,1,0)
Contains either the XPATH or variable name in @@..@@ to substitute.
"^DD",113059001,113059001.04,.01,"DT")
3120507
"^DD",113059001,113059001.04,.05,0)
INDEXED BY^S^DFN:PATIENT;DUZ:PROVIDER;ACCT:ACCOUNT;LOC:LOCATION;^0;2^Q
"^DD",113059001,113059001.04,.05,.1)

"^DD",113059001,113059001.04,.05,3)
INDEXED BY - DFN OR DUZ OR ACCOUNT OR LOCATION
"^DD",113059001,113059001.04,.05,21,0)
^^2^2^3120507^
"^DD",113059001,113059001.04,.05,21,1,0)
This functions almost as a 'variable pointer' for the code. The code 
"^DD",113059001,113059001.04,.05,21,2,0)
uses this to figure out which file to retrieve data from.
"^DD",113059001,113059001.04,.05,"DT")
3120507
"^DD",113059001,113059001.04,1,0)
FILEMAN FIELD NAME^F^^1;1^K:$L(X)>80!($L(X)<3) X
"^DD",113059001,113059001.04,1,.1)
NAME OF FILEMAN FIELD
"^DD",113059001,113059001.04,1,3)
FILEMAN FIELD NAME
"^DD",113059001,113059001.04,1,21,0)
^^2^2^3120507^
"^DD",113059001,113059001.04,1,21,1,0)
This field is for documentation only; the actual field is in #1.2 FILEMAN
"^DD",113059001,113059001.04,1,21,2,0)
FIELD NUMBER.
"^DD",113059001,113059001.04,1,"DT")
3120507
"^DD",113059001,113059001.04,1.1,0)
FILEMAN FILE POINTER^P1'^DIC(^1;2^Q
"^DD",113059001,113059001.04,1.1,.1)

"^DD",113059001,113059001.04,1.1,3)
Fileman File
"^DD",113059001,113059001.04,1.1,21,0)
^^1^1^3120507^
"^DD",113059001,113059001.04,1.1,21,1,0)
Fileman file to retrieve data from for the element.
"^DD",113059001,113059001.04,1.1,"DT")
3120507
"^DD",113059001,113059001.04,1.2,0)
FILEMAN FIELD NUMBER^NJ22,9^^1;3^K:+X'=X!(X>999999999999)!(X<.000000001)!(X?.E1"."10.N) X
"^DD",113059001,113059001.04,1.2,.1)

"^DD",113059001,113059001.04,1.2,3)
FILEMAN FIELD NUMBER
"^DD",113059001,113059001.04,1.2,21,0)
^^1^1^3120507^
"^DD",113059001,113059001.04,1.2,21,1,0)
Field to use for the file entered (1.1  FILEMAN FILE POINTER)
"^DD",113059001,113059001.04,1.2,"DT")
3120507
"^DD",113059001,113059001.04,2,0)
VARIABLE NAME^F^^1;4^K:$L(X)>80!($L(X)<3) X
"^DD",113059001,113059001.04,2,.1)

"^DD",113059001,113059001.04,2,3)
Name of a runtime variable
"^DD",113059001,113059001.04,2,21,0)
^^3^3^3120507^
"^DD",113059001,113059001.04,2,21,1,0)
Runtime Variable to use for the data (instead of retrieving data from 
"^DD",113059001,113059001.04,2,21,2,0)
Fileman File/Field). If this is specified, it override Fileman File/Field 
"^DD",113059001,113059001.04,2,21,3,0)
data in the runtime processor.
"^DD",113059001,113059001.04,2,"DT")
3120507
"^DD",113059001,113059001.04,3,0)
SQLI FIELD NAME^F^^2;1^K:$L(X)>80!($L(X)<3) X
"^DD",113059001,113059001.04,3,.1)

"^DD",113059001,113059001.04,3,3)

"^DD",113059001,113059001.04,3,21,0)
^^1^1^3120507^
"^DD",113059001,113059001.04,3,21,1,0)
Not used in eRx.
"^DD",113059001,113059001.04,3,"DT")
3120507
"^DD",113059001,113059001.04,4,0)
CCR VARIABLE^P170^C0CDIC(170,^2;2^Q
"^DD",113059001,113059001.04,4,.1)

"^DD",113059001,113059001.04,4,21,0)
^^1^1^3120507^
"^DD",113059001,113059001.04,4,21,1,0)
Pointer to the CCR dictionary for binding. Not used in eRx.
"^DD",113059001,113059001.04,4,"DT")
3120507
"^DD",113059001,113059001.05,0)
INCLUDE TEMPLATE SUB-FIELD^^1^2
"^DD",113059001,113059001.05,0,"DT")
3091016
"^DD",113059001,113059001.05,0,"IX","B",113059001.05,.01)

"^DD",113059001,113059001.05,0,"NM","INCLUDE TEMPLATE")

"^DD",113059001,113059001.05,0,"UP")
113059001
"^DD",113059001,113059001.05,.01,0)
INCLUDE TEMPLATE NAME^MF^^0;1^K:$L(X)>30!($L(X)<3) X
"^DD",113059001,113059001.05,.01,.1)

"^DD",113059001,113059001.05,.01,1,0)
^.1
"^DD",113059001,113059001.05,.01,1,1,0)
113059001.05^B
"^DD",113059001,113059001.05,.01,1,1,1)
S ^C0PX(DA(1),10,"B",$E(X,1,30),DA)=""
"^DD",113059001,113059001.05,.01,1,1,2)
K ^C0PX(DA(1),10,"B",$E(X,1,30),DA)
"^DD",113059001,113059001.05,.01,3)
Templates to be included during processing
"^DD",113059001,113059001.05,.01,"DT")
3120507
"^DD",113059001,113059001.05,1,0)
INCLUDE TEMPLATE POINTER^P113059001^C0PX(^0;2^Q
"^DD",113059001,113059001.05,1,.1)

"^DD",113059001,113059001.05,1,3)
Pointer to the Included Template
"^DD",113059001,113059001.05,1,"DT")
3120507
"^DD",113059002,113059002,0)
FIELD^^3^23
"^DD",113059002,113059002,0,"DDA")
N
"^DD",113059002,113059002,0,"DT")
3120519
"^DD",113059002,113059002,0,"IX","B",113059002,.01)

"^DD",113059002,113059002,0,"NM","C0P WS ACCT")

"^DD",113059002,113059002,0,"PT",200.113059,1)

"^DD",113059002,113059002,0,"VRPK")
C0P
"^DD",113059002,113059002,.01,0)
C0P ACCT NAME^RF^^0;1^K:$L(X)>30!(X?.N)!($L(X)<3)!'(X'?1P.E) X
"^DD",113059002,113059002,.01,.1)
ACCOUNT NAME
"^DD",113059002,113059002,.01,1,0)
^.1
"^DD",113059002,113059002,.01,1,1,0)
113059002^B
"^DD",113059002,113059002,.01,1,1,1)
S ^C0PS("B",$E(X,1,30),DA)=""
"^DD",113059002,113059002,.01,1,1,2)
K ^C0PS("B",$E(X,1,30),DA)
"^DD",113059002,113059002,.01,3)
Free Text Name must be 3-30 characters that starts with a letter
"^DD",113059002,113059002,.01,21,0)
^^2^2^3120519^
"^DD",113059002,113059002,.01,21,1,0)
Enter a Name for this Account. This name is for your reference and isn't 
"^DD",113059002,113059002,.01,21,2,0)
derived from New Crop.
"^DD",113059002,113059002,.01,"DT")
3120519
"^DD",113059002,113059002,1,0)
C0P SUBSCRIPTION LOCATION^RP4'^DIC(4,^0;2^Q
"^DD",113059002,113059002,1,.1)
SUBSCRIPTION LOCATION
"^DD",113059002,113059002,1,3)
Institution to use for Address Data
"^DD",113059002,113059002,1,21,0)
^^9^9^3120519^
"^DD",113059002,113059002,1,21,1,0)
The institution to use for the address to send to New Crop.
"^DD",113059002,113059002,1,21,2,0)
 
"^DD",113059002,113059002,1,21,3,0)
The address is sent twice:
"^DD",113059002,113059002,1,21,4,0)
- Main address of Institution.
"^DD",113059002,113059002,1,21,5,0)
- Provider Address.
"^DD",113059002,113059002,1,21,6,0)
 
"^DD",113059002,113059002,1,21,7,0)
For individual providers, if the hospital location they practice at has 
"^DD",113059002,113059002,1,21,8,0)
the Hospital Location field C0P ERX STREET ADDRESS 1 filled out, the
"^DD",113059002,113059002,1,21,9,0)
address in the Hospital Location fileds is used rather than this address.
"^DD",113059002,113059002,1,"DT")
3120519
"^DD",113059002,113059002,1.1,0)
C0P ADDRESS^CJ80^^ ; ^X ^DD(113059002,1.1,9.2) S Y(113059002,1.1,101)=$S($D(^DIC(4,D0,1)):^(1),1:"") S X=$P(Y(113059002,1.1,101),U,1) S D0=Y(113059002,1.1,80)
"^DD",113059002,113059002,1.1,.1)
FIRST LINE OF ADDRESS
"^DD",113059002,113059002,1.1,9.01)
4^1.01;113059002^1
"^DD",113059002,113059002,1.1,9.1)
C0P SUBSCRIPTION LOCATION:STREET ADDR. 1
"^DD",113059002,113059002,1.1,9.2)
S Y(113059002,1.1,80)=$G(D0),Y(113059002,1.1,1)=$S($D(^C0PS(D0,0)):^(0),1:""),D0=$P(Y(113059002,1.1,1),U,2) S:'D0!'$D(^DIC(4,+D0,0)) D0=-1
"^DD",113059002,113059002,1.1,"DT")
3090824
"^DD",113059002,113059002,1.2,0)
C0P ADDRESS2^CJ80^^ ; ^X ^DD(113059002,1.2,9.2) S Y(113059002,1.2,101)=$S($D(^DIC(4,D0,1)):^(1),1:"") S X=$P(Y(113059002,1.2,101),U,2) S D0=Y(113059002,1.2,80)
"^DD",113059002,113059002,1.2,.1)
LINE 2 OF ADDRESS
"^DD",113059002,113059002,1.2,9.01)
4^1.02;113059002^1
"^DD",113059002,113059002,1.2,9.1)
C0P SUBSCRIPTION LOCATION:STREET ADDR. 2
"^DD",113059002,113059002,1.2,9.2)
S Y(113059002,1.2,80)=$G(D0),Y(113059002,1.2,1)=$S($D(^C0PS(D0,0)):^(0),1:""),D0=$P(Y(113059002,1.2,1),U,2) S:'D0!'$D(^DIC(4,+D0,0)) D0=-1
"^DD",113059002,113059002,1.2,"DT")
3090824
"^DD",113059002,113059002,1.3,0)
C0P CITY^CJ30^^ ; ^X ^DD(113059002,1.3,9.2) S Y(113059002,1.3,101)=$S($D(^DIC(4,D0,1)):^(1),1:"") S X=$P(Y(113059002,1.3,101),U,3) S D0=Y(113059002,1.3,80)
"^DD",113059002,113059002,1.3,.1)
ADDRESS CITY
"^DD",113059002,113059002,1.3,9.01)
4^1.03;113059002^1
"^DD",113059002,113059002,1.3,9.1)
C0P SUBSCRIPTION LOCATION:CITY
"^DD",113059002,113059002,1.3,9.2)
S Y(113059002,1.3,80)=$G(D0),Y(113059002,1.3,1)=$S($D(^C0PS(D0,0)):^(0),1:""),D0=$P(Y(113059002,1.3,1),U,2) S:'D0!'$D(^DIC(4,+D0,0)) D0=-1
"^DD",113059002,113059002,1.3,"DT")
3090824
"^DD",113059002,113059002,1.4,0)
C0P STATE^Cp5^^ ; ^X ^DD(113059002,1.4,9.2) S Y(113059002,1.4,101)=$S($D(^DIC(4,D0,0)):^(0),1:"") S X=$P(Y(113059002,1.4,101),U,2),X=X S X=X S D0=Y(113059002,1.4,80)
"^DD",113059002,113059002,1.4,.1)
ADDRESS STATE
"^DD",113059002,113059002,1.4,9.01)
4^.02;113059002^1
"^DD",113059002,113059002,1.4,9.1)
INTERNAL(C0P SUBSCRIPTION LOCATION:STATE)
"^DD",113059002,113059002,1.4,9.2)
S Y(113059002,1.4,80)=$G(D0),Y(113059002,1.4,1)=$S($D(^C0PS(D0,0)):^(0),1:""),D0=$P(Y(113059002,1.4,1),U,2) S:'D0!'$D(^DIC(4,+D0,0)) D0=-1
"^DD",113059002,113059002,1.4,"DT")
3090824
"^DD",113059002,113059002,1.41,0)
C0P STATE ABBREVIATION^CJ2^^ ; ^X ^DD(113059002,1.41,9.2) S Y(113059002,1.41,101)=$S($D(^DIC(5,D0,0)):^(0),1:"") S X=$P(Y(113059002,1.41,101),U,2) S D0=Y(113059002,1.41,80)
"^DD",113059002,113059002,1.41,.1)
STATE ABBREVIATION FROM STATE FILE
"^DD",113059002,113059002,1.41,9.01)
5^1;113059002^1.4
"^DD",113059002,113059002,1.41,9.1)
C0P STATE:ABBREVIATION
"^DD",113059002,113059002,1.41,9.2)
X "N I,Y "_$P(^DD(113059002,1.4,0),U,5,99) S Y(113059002,1.41,1)=X S Y(113059002,1.41,80)=$G(D0),D0=Y(113059002,1.41,1) S:'D0!'$D(^DIC(5,+D0,0)) D0=-1
"^DD",113059002,113059002,1.41,"DT")
3090824
"^DD",113059002,113059002,1.5,0)
C0P ZIP^CJ20^^ ; ^X ^DD(113059002,1.5,9.2) S Y(113059002,1.5,101)=$S($D(^DIC(4,D0,1)):^(1),1:"") S X=$P(Y(113059002,1.5,101),U,4) S D0=Y(113059002,1.5,80)
"^DD",113059002,113059002,1.5,.1)
ADDRESS ZIP
"^DD",113059002,113059002,1.5,9.01)
4^1.04;113059002^1
"^DD",113059002,113059002,1.5,9.1)
C0P SUBSCRIPTION LOCATION:ZIP
"^DD",113059002,113059002,1.5,9.2)
S Y(113059002,1.5,80)=$G(D0),Y(113059002,1.5,1)=$S($D(^C0PS(D0,0)):^(0),1:""),D0=$P(Y(113059002,1.5,1),U,2) S:'D0!'$D(^DIC(4,+D0,0)) D0=-1
"^DD",113059002,113059002,1.5,"DT")
3090824
"^DD",113059002,113059002,2,0)
C0P ACCOUNT NAME^RF^^0;3^K:$L(X)>30!($L(X)<1) X
"^DD",113059002,113059002,2,.1)
ACCOUNT NAME
"^DD",113059002,113059002,2,3)
Subscription Account Name supplied by New Crop (1-30 chars)
"^DD",113059002,113059002,2,"DT")
3120519
"^DD",113059002,113059002,2.1,0)
C0P PRIMARY FAX NUMBER^RF^^0;4^K:$L(X)>20!($L(X)<1) X
"^DD",113059002,113059002,2.1,.1)
PRIMARY FAX NUMBER
"^DD",113059002,113059002,2.1,3)
Primary Fax Number for NewCrop Account
"^DD",113059002,113059002,2.1,"DT")
3120519
"^DD",113059002,113059002,2.2,0)
C0P PRIMARY PHONE NUMBER^RF^^0;5^K:$L(X)>30!($L(X)<1) X
"^DD",113059002,113059002,2.2,.1)
PRIMARY PHONE NUMBER
"^DD",113059002,113059002,2.2,3)
Primary Phone Number for NewCrop Account
"^DD",113059002,113059002,2.2,"DT")
3120519
"^DD",113059002,113059002,2.3,0)
C0P SITE ID^RF^^0;6^K:$L(X)>30!($L(X)<1) X
"^DD",113059002,113059002,2.3,.1)
SITE ID
"^DD",113059002,113059002,2.3,3)
Subscription Site ID supplied by New Crop
"^DD",113059002,113059002,2.3,"DT")
3120519
"^DD",113059002,113059002,2.4,0)
C0P ACCOUNT ID^RF^^1;6^K:$L(X)>80!($L(X)<2) X
"^DD",113059002,113059002,2.4,.1)
ACCOUNT ID 
"^DD",113059002,113059002,2.4,3)
Account ID as supplied by NewCrop
"^DD",113059002,113059002,2.4,"DT")
3120519
"^DD",113059002,113059002,3,0)
C0P CREDENTIAL NAME^RF^^1;9^K:$L(X)>36!($L(X)<1) X
"^DD",113059002,113059002,3,.1)
CREDENTIAL NAME
"^DD",113059002,113059002,3,3)
Credential Name or User ID supplied by New Crop
"^DD",113059002,113059002,3,21,0)
^^2^2^3120519^^
"^DD",113059002,113059002,3,21,1,0)
This is the Credential Name or User ID supplied by New Crop. In a 
"^DD",113059002,113059002,3,21,2,0)
production account, this would be a GUID.
"^DD",113059002,113059002,3,"DT")
3120519
"^DD",113059002,113059002,3.1,0)
C0P PARTNER NAME^RF^^0;8^K:$L(X)>30!($L(X)<1) X
"^DD",113059002,113059002,3.1,.1)
PARTNER NAME
"^DD",113059002,113059002,3.1,3)
Partner Name supplied by New Crop
"^DD",113059002,113059002,3.1,"DT")
3120519
"^DD",113059002,113059002,3.2,0)
C0P PARTNER PASSWORD^RF^^0;9^K:$L(X)>36!($L(X)<1) X
"^DD",113059002,113059002,3.2,.1)
PARTNER PASSWORD
"^DD",113059002,113059002,3.2,3)
Answer must be 1-36 characters in length.
"^DD",113059002,113059002,3.2,21,0)
^^1^1^3120519^
"^DD",113059002,113059002,3.2,21,1,0)
Enter the partner password supplied by New Crop.
"^DD",113059002,113059002,3.2,"DT")
3120519
"^DD",113059002,113059002,3.3,0)
C0P PRODUCT NAME^RF^^1;1^K:$L(X)>30!($L(X)<1) X
"^DD",113059002,113059002,3.3,.1)
PRODUCT NAME
"^DD",113059002,113059002,3.3,3)
Answer must be 1-30 characters.
"^DD",113059002,113059002,3.3,21,0)
^^2^2^3120519^
"^DD",113059002,113059002,3.3,21,1,0)
Enter the product name to be sent to New Crop. The value of this field 
"^DD",113059002,113059002,3.3,21,2,0)
isn't provided by New Crop but is used to identify the product.
"^DD",113059002,113059002,3.3,"DT")
3120519
"^DD",113059002,113059002,3.4,0)
C0P PRODUCT VERSION^RF^^1;2^K:$L(X)>30!($L(X)<1) X
"^DD",113059002,113059002,3.4,.1)
PRODUCT VERSION
"^DD",113059002,113059002,3.4,3)
Answer must be 1-30 characters long
"^DD",113059002,113059002,3.4,21,0)
^^2^2^3120519^^
"^DD",113059002,113059002,3.4,21,1,0)
Enter the Product Version. The product version is free-text and is used 
"^DD",113059002,113059002,3.4,21,2,0)
to identify the product. It's not supplied by New Crop.
"^DD",113059002,113059002,3.4,"DT")
3120519
"^DD",113059002,113059002,4,0)
C0P WEB SERVICE^RP113059003'^C0PW(^1;3^Q
"^DD",113059002,113059002,4,.1)
WEB SERVICE
"^DD",113059002,113059002,4,3)
Enter a Web Service to use for this account
"^DD",113059002,113059002,4,21,0)
^^3^3^3120519^
"^DD",113059002,113059002,4,21,1,0)
The web service decides which SOAP XML Templates to use to send to the 
"^DD",113059002,113059002,4,21,2,0)
remote endpoint. This field must be chosen correctly, as incorrect 
"^DD",113059002,113059002,4,21,3,0)
templates will not work.
"^DD",113059002,113059002,4,"DT")
3120519
"^DD",113059002,113059002,5,0)
C0P PREFERED LICENSE STATE^RP5'^DIC(5,^1;4^Q
"^DD",113059002,113059002,5,.1)
PREFERED LICENSE STATE
"^DD",113059002,113059002,5,3)
Enter a Prefered License State for providers
"^DD",113059002,113059002,5,21,0)
^^6^6^3120519^
"^DD",113059002,113059002,5,21,1,0)
Pointer to the state file of the State who's license is prefered for use
"^DD",113059002,113059002,5,21,2,0)
with this account. Providers can be licensed in several States, and if 
"^DD",113059002,113059002,5,21,3,0)
they are not licensed in the prefered state, another state license will 
"^DD",113059002,113059002,5,21,4,0)
be used. For legal reasons, a provider should use the license of the 
"^DD",113059002,113059002,5,21,5,0)
state they practice in; this field makes sure that the program tries to 
"^DD",113059002,113059002,5,21,6,0)
fetch that state's license first from the New Person file.
"^DD",113059002,113059002,5,"DT")
3120519
"^DD",113059002,113059002,6,0)
C0P PRIMARY ERX SUBSCRIBER^RP200'^VA(200,^1;5^Q
"^DD",113059002,113059002,6,.1)
PRIMARY ERX SUBSCRIBER
"^DD",113059002,113059002,6,3)
Enter the Primary Subscriber to use for Background Web Services
"^DD",113059002,113059002,6,21,0)
^^4^4^3120519^
"^DD",113059002,113059002,6,21,1,0)
This field is a pointer to an eRx subscriber in the New Person file whose
"^DD",113059002,113059002,6,21,2,0)
credentials will be use in eRx batch web service calls. It should point to
"^DD",113059002,113059002,6,21,3,0)
a person who is fully set up and active for eRx and who has been 
"^DD",113059002,113059002,6,21,4,0)
registered with the eRx provider. 
"^DD",113059002,113059002,6,"DT")
3120519
"^DD",113059002,113059002,7,0)
C0P PRODUCTION FLAG^RS^P:PRODUCTION;T:TEST;^1;7^Q
"^DD",113059002,113059002,7,.1)
PRODUCTION FLAG
"^DD",113059002,113059002,7,3)
Enter P or T for Production or Test
"^DD",113059002,113059002,7,21,0)
^^4^4^3120519^
"^DD",113059002,113059002,7,21,1,0)
This field should only be set to P to turn on an eRx production 
"^DD",113059002,113059002,7,21,2,0)
environment. It is used to determine the URL that will be used to connect 
"^DD",113059002,113059002,7,21,3,0)
to the ePrescribing web service. If it is null, a TEST environment will 
"^DD",113059002,113059002,7,21,4,0)
be assumed.
"^DD",113059002,113059002,7,"DT")
3120519
"^DD",113059002,113059002,8,0)
C0P USE NPI FOR SID^S^1:YES;0:NO;^1;8^Q
"^DD",113059002,113059002,8,.1)
USE NPI FOR SID
"^DD",113059002,113059002,8,3)
Enter Yes or No
"^DD",113059002,113059002,8,21,0)
^^2^2^3120519^
"^DD",113059002,113059002,8,21,1,0)
For Test Systems, use the NPI for the Subscriber ID rather than 
"^DD",113059002,113059002,8,21,2,0)
generating a unique UUID for the Subscriber ID (Legacy Support).
"^DD",113059002,113059002,8,"DT")
3120519
"^DD",113059003,113059003,0)
FIELD^^4^6
"^DD",113059003,113059003,0,"DDA")
N
"^DD",113059003,113059003,0,"DT")
3100214
"^DD",113059003,113059003,0,"IX","B",113059003,.01)

"^DD",113059003,113059003,0,"NM","C0P WEB SERVICE")

"^DD",113059003,113059003,0,"PT",113059001,.02)

"^DD",113059003,113059003,0,"PT",113059002,4)

"^DD",113059003,113059003,0,"VRPK")
C0P
"^DD",113059003,113059003,.01,0)
C0PW WS NAME^RF^^0;1^K:$L(X)>30!(X?.N)!($L(X)<3)!'(X'?1P.E) X
"^DD",113059003,113059003,.01,1,0)
^.1
"^DD",113059003,113059003,.01,1,1,0)
113059003^B
"^DD",113059003,113059003,.01,1,1,1)
S ^C0PW("B",$E(X,1,30),DA)=""
"^DD",113059003,113059003,.01,1,1,2)
K ^C0PW("B",$E(X,1,30),DA)
"^DD",113059003,113059003,.01,3)
NAME MUST BE 3-30 CHARACTERS, NOT NUMERIC OR STARTING WITH PUNCTUATION
"^DD",113059003,113059003,.01,"DT")
3090730
"^DD",113059003,113059003,.05,0)
C0PW CONTEXT^S^PP:PATIENT PROVIDER;SYS:SYSTEM;^4;1^Q
"^DD",113059003,113059003,.05,.1)
WEB SERVICE CONTEXT
"^DD",113059003,113059003,.05,21,0)
^^3^3^3090922^
"^DD",113059003,113059003,.05,21,1,0)
This field is a set of codes which define the "context" of the web service being defined. The Context will dictate which sets of variables will be initialized at the beginning of whenever the web service is used. Contexted so far defined are:
"^DD",113059003,113059003,.05,21,2,0)
Patient Provider (PP) which is used for ePrescribing and will initialize    the SUBSRIBER, ACCOUNT, and PATIENT variables. See C0PSUB AND C0PPAT    for details on variable names. System (SYS) which is for web services that do not require
"^DD",113059003,113059003,.05,21,3,0)
variables to    be initialized
"^DD",113059003,113059003,.05,"DT")
3090922
"^DD",113059003,113059003,1,0)
C0PW DEFINING XML^113059003.01^^1;0
"^DD",113059003,113059003,2,0)
C0PW BUTTON^113059003.02^^2;0
"^DD",113059003,113059003,3,0)
C0PW TEMPLATES^113059003.03P^^3;0
"^DD",113059003,113059003,4,0)
C0PW ROLE MAPPING^113059003.04^^5;0
"^DD",113059003,113059003.01,0)
C0PW DEFINING XML SUB-FIELD^^.01^1
"^DD",113059003,113059003.01,0,"DT")
3090730
"^DD",113059003,113059003.01,0,"NM","C0PW DEFINING XML")

"^DD",113059003,113059003.01,0,"UP")
113059003
"^DD",113059003,113059003.01,.01,0)
C0PW DEFINING XML^WLx^^0;1
"^DD",113059003,113059003.01,.01,.1)
XML TO DEFINE THE WEB SERVICE
"^DD",113059003,113059003.01,.01,3)
XML TO DEFINE THE WEB SERVICE
"^DD",113059003,113059003.01,.01,"DT")
3090730
"^DD",113059003,113059003.02,0)
C0PW BUTTON SUB-FIELD^^2^3
"^DD",113059003,113059003.02,0,"DT")
3090913
"^DD",113059003,113059003.02,0,"IX","B",113059003.02,.01)

"^DD",113059003,113059003.02,0,"NM","C0PW BUTTON")

"^DD",113059003,113059003.02,0,"UP")
113059003
"^DD",113059003,113059003.02,.01,0)
C0PW BUTTON^F^^0;1^K:$L(X)>30!($L(X)<1) X
"^DD",113059003,113059003.02,.01,.1)
BUTTON ENTRY POINTS FOR THE WEB SERVICE
"^DD",113059003,113059003.02,.01,1,0)
^.1
"^DD",113059003,113059003.02,.01,1,1,0)
113059003.02^B
"^DD",113059003,113059003.02,.01,1,1,1)
S ^C0PW(DA(1),2,"B",$E(X,1,30),DA)=""
"^DD",113059003,113059003.02,.01,1,1,2)
K ^C0PW(DA(1),2,"B",$E(X,1,30),DA)
"^DD",113059003,113059003.02,.01,3)
BUTTON ENTRY POINTS FOR THE WEB SERVICE
"^DD",113059003,113059003.02,.01,"DT")
3090730
"^DD",113059003,113059003.02,1,0)
C0PW BUTTON URL^F^^0;2^K:$L(X)>100!($L(X)<1) X
"^DD",113059003,113059003.02,1,.1)
BUTTON URL
"^DD",113059003,113059003.02,1,3)
BUTTON URL
"^DD",113059003,113059003.02,1,"DT")
3090730
"^DD",113059003,113059003.02,2,0)
C0PW BUTTON TEMPLATE NAME^P113059001^C0PX(^0;3^Q
"^DD",113059003,113059003.02,2,.1)
BUTTON TEMPLATE POINTER
"^DD",113059003,113059003.02,2,3)
BUTTON TEMPLATE POINTER
"^DD",113059003,113059003.02,2,"DT")
3090913
"^DD",113059003,113059003.03,0)
C0PW TEMPLATES SUB-FIELD^^1^2
"^DD",113059003,113059003.03,0,"DT")
3090913
"^DD",113059003,113059003.03,0,"IX","B",113059003.03,.01)

"^DD",113059003,113059003.03,0,"NM","C0PW TEMPLATES")

"^DD",113059003,113059003.03,0,"UP")
113059003
"^DD",113059003,113059003.03,.01,0)
C0PW TEMPLATES^MP113059001^C0PX(^0;1^Q
"^DD",113059003,113059003.03,.01,.1)
POINTER TO XML TEMPLATE
"^DD",113059003,113059003.03,.01,1,0)
^.1
"^DD",113059003,113059003.03,.01,1,1,0)
113059003.03^B
"^DD",113059003,113059003.03,.01,1,1,1)
S ^C0PW(DA(1),3,"B",$E(X,1,30),DA)=""
"^DD",113059003,113059003.03,.01,1,1,2)
K ^C0PW(DA(1),3,"B",$E(X,1,30),DA)
"^DD",113059003,113059003.03,.01,3)
POINTER TO TEMPLATE FILE
"^DD",113059003,113059003.03,.01,"DT")
3090913
"^DD",113059003,113059003.03,1,0)
C0PW USE^S^IN:INPUT;OUT:OUPUT;^0;2^Q
"^DD",113059003,113059003.03,1,.1)
TEMPLATE USE - INPUT OR OUTPUT
"^DD",113059003,113059003.03,1,3)
TEMPLATE USE - INPUT OR OUTPUT
"^DD",113059003,113059003.03,1,"DT")
3090913
"^DD",113059003,113059003.04,0)
C0PW ROLE MAPPING SUB-FIELD^^1^2
"^DD",113059003,113059003.04,0,"DT")
3100214
"^DD",113059003,113059003.04,0,"IX","B",113059003.04,.01)

"^DD",113059003,113059003.04,0,"NM","C0PW ROLE MAPPING")

"^DD",113059003,113059003.04,0,"UP")
113059003
"^DD",113059003,113059003.04,.01,0)
C0PW ROLE MAPPING^MF^^0;1^K:$L(X)>30!($L(X)<1) X
"^DD",113059003,113059003.04,.01,.1)
ROLE MAPPINGS FOR ERX WEB SERVICES
"^DD",113059003,113059003.04,.01,1,0)
^.1
"^DD",113059003,113059003.04,.01,1,1,0)
113059003.04^B
"^DD",113059003,113059003.04,.01,1,1,1)
S ^C0PW(DA(1),5,"B",$E(X,1,30),DA)=""
"^DD",113059003,113059003.04,.01,1,1,2)
K ^C0PW(DA(1),5,"B",$E(X,1,30),DA)
"^DD",113059003,113059003.04,.01,3)
ROLE MAPPINGS FOR ERX WEB SERVICES
"^DD",113059003,113059003.04,.01,"DT")
3100214
"^DD",113059003,113059003.04,1,0)
TEMPLATE TO USE^P113059001'^C0PX(^0;2^Q
"^DD",113059003,113059003.04,1,.1)
TEMPLATE TO USE FOR CLICKTHROUGH FOR THIS ROLE
"^DD",113059003,113059003.04,1,3)
TEMPLATE TO USE FOR CLICKTHROUGH FOR THIS ROLE
"^DD",113059003,113059003.04,1,"DT")
3100214
"^DD",1130590010,1130590010,0)
FIELD^^31^38
"^DD",1130590010,1130590010,0,"DDA")
N
"^DD",1130590010,1130590010,0,"DT")
3091205
"^DD",1130590010,1130590010,0,"ID",6)
W:$D(^(2)) "   ",$P(^(2),U,1)
"^DD",1130590010,1130590010,0,"IX","B",1130590010,.01)

"^DD",1130590010,1130590010,0,"IX","GCN",1130590010,1)

"^DD",1130590010,1130590010,0,"NM","FIRST DATABANK DRUGS")

"^DD",1130590010,1130590010,0,"PT",1130590010.001,.01)

"^DD",1130590010,1130590010,0,"PT",1130590010.002,1.02)

"^DD",1130590010,1130590010,0,"VRPK")
C0P
"^DD",1130590010,1130590010,.01,0)
MEDID^RNJ15,0X^^0;1^S X=+X
"^DD",1130590010,1130590010,.01,1,0)
^.1
"^DD",1130590010,1130590010,.01,1,1,0)
1130590010^B
"^DD",1130590010,1130590010,.01,1,1,1)
S ^C0P("FDB","B",$E(X,1,30),DA)=""
"^DD",1130590010,1130590010,.01,1,1,2)
K ^C0P("FDB","B",$E(X,1,30),DA)
"^DD",1130590010,1130590010,.01,3)
Medicaiton ID
"^DD",1130590010,1130590010,.01,"DT")
3120420
"^DD",1130590010,1130590010,1,0)
GCN SEQNO^NJ15,0X^^0;2^S X=+X
"^DD",1130590010,1130590010,1,1,0)
^.1
"^DD",1130590010,1130590010,1,1,1,0)
1130590010^GCN
"^DD",1130590010,1130590010,1,1,1,1)
S ^C0P("FDB","GCN",$E(X,1,30),DA)=""
"^DD",1130590010,1130590010,1,1,1,2)
K ^C0P("FDB","GCN",$E(X,1,30),DA)
"^DD",1130590010,1130590010,1,1,1,"%D",0)
^^7^7^3091205^
"^DD",1130590010,1130590010,1,1,1,"%D",1,0)
This cross reference indexes drugs by the Generic Drug Entity Sequence 
"^DD",1130590010,1130590010,1,1,1,"%D",2,0)
Number. This number is found in RxNorm and can be used as a link between 
"^DD",1130590010,1130590010,1,1,1,"%D",3,0)
the RxNorm file and this file. Each entry represents a clinical drug. 
"^DD",1130590010,1130590010,1,1,1,"%D",4,0)
Therefore, the number for Simvastatin 20mg tab vs the number for 
"^DD",1130590010,1130590010,1,1,1,"%D",5,0)
Simvastatin 40mg tab will be different; however, it will be the same for 
"^DD",1130590010,1130590010,1,1,1,"%D",6,0)
all marketed formulations of Simvastatin 20mg tab deemed bio-equivalent 
"^DD",1130590010,1130590010,1,1,1,"%D",7,0)
by the FDA.
"^DD",1130590010,1130590010,1,1,1,"DT")
3091205
"^DD",1130590010,1130590010,1,3)
Generic Name Sequence Number
"^DD",1130590010,1130590010,1,"DT")
3120420
"^DD",1130590010,1130590010,2,0)
MED NAME ID^NJ15,0^^0;3^K:+X'=X!(X>999999999999999)!(X<0)!(X?.E1"."1.N) X
"^DD",1130590010,1130590010,2,1,0)
^.1^^0
"^DD",1130590010,1130590010,2,"DT")
3091205
"^DD",1130590010,1130590010,3,0)
MED NAME^F^^0;4^K:$L(X)>60!($L(X)<1) X
"^DD",1130590010,1130590010,3,3)
Answer must be 1-60 characters in length
"^DD",1130590010,1130590010,3,"DT")
3091202
"^DD",1130590010,1130590010,4,0)
MED ROUTED MED ID DESC^F^^0;5^K:$L(X)>120!($L(X)<1) X
"^DD",1130590010,1130590010,4,3)
Answer must be 1-120 characters in length
"^DD",1130590010,1130590010,4,"DT")
3091202
"^DD",1130590010,1130590010,5,0)
MED ROUTED DF MED ID DESC^F^^1;1^K:$L(X)>120!($L(X)<1) X
"^DD",1130590010,1130590010,5,3)
Answer must be 1-120 characters in length
"^DD",1130590010,1130590010,5,"DT")
3091202
"^DD",1130590010,1130590010,6,0)
MED MEDID DESC^F^^2;1^K:$L(X)>140!($L(X)<1) X
"^DD",1130590010,1130590010,6,1,0)
^.1^^0
"^DD",1130590010,1130590010,6,3)
Answer must be 1-140 characters in length
"^DD",1130590010,1130590010,6,"DT")
3091205
"^DD",1130590010,1130590010,7,0)
MED STATUS CD^F^^2;2^K:$L(X)>2!($L(X)<1) X
"^DD",1130590010,1130590010,7,3)
Answer must be 1-2 characters in length
"^DD",1130590010,1130590010,7,"DT")
3091202
"^DD",1130590010,1130590010,8,0)
MED ROUTE ID^NJ15,0^^2;3^K:+X'=X!(X>999999999999999)!(X<0)!(X?.E1"."1.N) X
"^DD",1130590010,1130590010,8,3)

"^DD",1130590010,1130590010,8,"DT")
3091202
"^DD",1130590010,1130590010,9,0)
ROUTED MED ID^NJ15,0^^2;4^K:+X'=X!(X>999999999999999)!(X<0)!(X?.E1"."1.N) X
"^DD",1130590010,1130590010,9,"DT")
3091202
"^DD",1130590010,1130590010,10,0)
ROUTED DOSAGE FORM MED ID^NJ15,0^^2;5^K:+X'=X!(X>999999999999999)!(X<0)!(X?.E1"."1.N) X
"^DD",1130590010,1130590010,10,"DT")
3091202
"^DD",1130590010,1130590010,11,0)
MED STRENGTH^F^^2;6^K:$L(X)>30!($L(X)<1) X
"^DD",1130590010,1130590010,11,3)
Answer must be 1-30 characters in length
"^DD",1130590010,1130590010,11,"DT")
3091202
"^DD",1130590010,1130590010,12,0)
MED STRENGTH UOM^F^^3;1^K:$L(X)>30!($L(X)<1) X
"^DD",1130590010,1130590010,12,3)
Answer must be 1-30 characters in length
"^DD",1130590010,1130590010,12,"DT")
3091202
"^DD",1130590010,1130590010,13,0)
MED ROUTE ABBR^F^^3;2^K:$L(X)>8!($L(X)<1) X
"^DD",1130590010,1130590010,13,3)
Answer must be 1-8 characters in length
"^DD",1130590010,1130590010,13,"DT")
3091202
"^DD",1130590010,1130590010,14,0)
MED ROUTE DESC^F^^3;3^K:$L(X)>60!($L(X)<1) X
"^DD",1130590010,1130590010,14,3)
Answer must be 1-60 characters in length
"^DD",1130590010,1130590010,14,"DT")
3091202
"^DD",1130590010,1130590010,15,0)
MED DOSAGE FORM ABBR^F^^3;4^K:$L(X)>8!($L(X)<1) X
"^DD",1130590010,1130590010,15,3)
Answer must be 1-8 characters in length
"^DD",1130590010,1130590010,15,"DT")
3091202
"^DD",1130590010,1130590010,16,0)
MED DOSAGE FORM DESC^F^^3;5^K:$L(X)>60!($L(X)<1) X
"^DD",1130590010,1130590010,16,3)
Answer must be 1-60 characters in length
"^DD",1130590010,1130590010,16,"DT")
3091202
"^DD",1130590010,1130590010,17,0)
GENERIC DRUG NAME^F^^3;6^K:$L(X)>60!($L(X)<1) X
"^DD",1130590010,1130590010,17,3)
Answer must be 1-60 characters in length
"^DD",1130590010,1130590010,17,"DT")
3091202
"^DD",1130590010,1130590010,18,0)
DOSAGE FORM OVERRIDE^F^^4;1^K:$L(X)>100!($L(X)<1) X
"^DD",1130590010,1130590010,18,3)
Answer must be 1-100 characters in length
"^DD",1130590010,1130590010,18,"DT")
3091202
"^DD",1130590010,1130590010,19,0)
MED REF DEA CD^F^^4;2^K:$L(X)>2!($L(X)<1) X
"^DD",1130590010,1130590010,19,3)
Answer must be 1-2 characters in length
"^DD",1130590010,1130590010,19,"DT")
3091202
"^DD",1130590010,1130590010,20,0)
MED REF DEA CD DESC^F^^4;3^K:$L(X)>120!($L(X)<1) X
"^DD",1130590010,1130590010,20,3)
Answer must be 1-120 characters in length
"^DD",1130590010,1130590010,20,"DT")
3100911
"^DD",1130590010,1130590010,21,0)
MED REF MULTI SOURCE CD^F^^4;4^K:$L(X)>2!($L(X)<1) X
"^DD",1130590010,1130590010,21,3)
Answer must be 1-2 characters in length
"^DD",1130590010,1130590010,21,"DT")
3091202
"^DD",1130590010,1130590010,22,0)
MED REF MULTI SOURCE CD DESC^F^^5;1^K:$L(X)>180!($L(X)<1) X
"^DD",1130590010,1130590010,22,3)
Answer must be 1-180 characters in length
"^DD",1130590010,1130590010,22,"DT")
3091202
"^DD",1130590010,1130590010,23,0)
MED REF GEN DRUG NAME CD^F^^5;2^K:$L(X)>2!($L(X)<1) X
"^DD",1130590010,1130590010,23,3)
Answer must be 1-2 characters in length
"^DD",1130590010,1130590010,23,"DT")
3091202
"^DD",1130590010,1130590010,24,0)
MED REF GEN DRUG NAME CD DESC^F^^6;1^K:$L(X)>180!($L(X)<1) X
"^DD",1130590010,1130590010,24,3)
Answer must be 1-180 characters in length
"^DD",1130590010,1130590010,24,"DT")
3100911
"^DD",1130590010,1130590010,25,0)
MED REF FED LEGEND IND^F^^6;2^K:$L(X)>2!($L(X)<1) X
"^DD",1130590010,1130590010,25,3)
Answer must be 1-2 characters in length
"^DD",1130590010,1130590010,25,"DT")
3091202
"^DD",1130590010,1130590010,26,0)
MED REF FED LEGEND IND DESC^F^^7;1^K:$L(X)>120!($L(X)<1) X
"^DD",1130590010,1130590010,26,3)
Answer must be 1-120 characters in length
"^DD",1130590010,1130590010,26,"DT")
3091202
"^DD",1130590010,1130590010,27,0)
GENERIC MEDID^NJ15,0^^7;2^K:+X'=X!(X>999999999999999)!(X<0)!(X?.E1"."1.N) X
"^DD",1130590010,1130590010,27,"DT")
3091202
"^DD",1130590010,1130590010,28,0)
MED NAME TYPE CD^F^^7;3^K:$L(X)>2!($L(X)<1) X
"^DD",1130590010,1130590010,28,3)
Answer must be 1-2 characters in length
"^DD",1130590010,1130590010,28,"DT")
3091202
"^DD",1130590010,1130590010,29,0)
GENERIC MED REF GEN NAME CD^F^^7;4^K:$L(X)>2!($L(X)<1) X
"^DD",1130590010,1130590010,29,3)
Answer must be 1-2 characters in length
"^DD",1130590010,1130590010,29,"DT")
3091202
"^DD",1130590010,1130590010,30,0)
MED NAME SOURCE CD^F^^7;5^K:$L(X)>2!($L(X)<1) X
"^DD",1130590010,1130590010,30,3)
Answer must be 1-2 characters in length
"^DD",1130590010,1130590010,30,"DT")
3091202
"^DD",1130590010,1130590010,32,0)
DRUG INFO^F^^9;1^K:$L(X)>140!($L(X)<1) X
"^DD",1130590010,1130590010,32,3)
Answer must be 1-140 characters in length
"^DD",1130590010,1130590010,32,"DT")
3091202
"^DD",1130590010,1130590010,33,0)
GENERIC DRUG NAME OVERRIDE^F^^10;1^K:$L(X)>140!($L(X)<1) X
"^DD",1130590010,1130590010,33,3)
Answer must be 1-140 characters in length
"^DD",1130590010,1130590010,33,"DT")
3091202
"^DD",1130590010,1130590010,34,0)
FORMULARY DRUG ID^NJ15,0^^10;2^K:+X'=X!(X>999999999999999)!(X<0)!(X?.E1"."1.N) X
"^DD",1130590010,1130590010,34,"DT")
3091202
"^DD",1130590010,1130590010,35,0)
MANUFACTURER^F^^10;3^K:$L(X)>30!($L(X)<1) X
"^DD",1130590010,1130590010,35,3)
Answer must be 1-30 characters in length
"^DD",1130590010,1130590010,35,"DT")
3091202
"^DD",1130590010,1130590010,36,0)
STATUS^F^^10;4^K:$L(X)>2!($L(X)<1) X
"^DD",1130590010,1130590010,36,3)
Answer must be 1-2 characters in length
"^DD",1130590010,1130590010,36,"DT")
3091202
"^DD",1130590010,1130590010,37,0)
TOUCH DATE^F^^10;5^K:$L(X)>16!($L(X)<1) X
"^DD",1130590010,1130590010,37,3)
Answer must be 1-16 characters in length
"^DD",1130590010,1130590010,37,"DT")
3091202
"^DD",1130590010,1130590010,38,0)
DRUG TYPE ID^F^^10;6^K:$L(X)>2!($L(X)<1) X
"^DD",1130590010,1130590010,38,3)
Answer must be 1-2 characters in length
"^DD",1130590010,1130590010,38,"DT")
3091202
"^DD",1130590010.002,1130590010.002,0)
FIELD^^1.05^16
"^DD",1130590010.002,1130590010.002,0,"DDA")
N
"^DD",1130590010.002,1130590010.002,0,"DT")
3100912
"^DD",1130590010.002,1130590010.002,0,"ID",2.02)
W:$D(^(2)) "   ",$P(^(2),U,1)
"^DD",1130590010.002,1130590010.002,0,"ID",2.03)
W:$D(^(2)) "   ",$P(^(2),U,3)
"^DD",1130590010.002,1130590010.002,0,"IX","B",1130590010.002,.01)

"^DD",1130590010.002,1130590010.002,0,"NM","C0P RXNORM FDB VUID MAPPING")

"^DD",1130590010.002,1130590010.002,0,"VRPK")
C0P
"^DD",1130590010.002,1130590010.002,.01,0)
RXNCUI^RF^^0;1^K:$L(X)>30!($L(X)<3)!'(X'?1P.E) X
"^DD",1130590010.002,1130590010.002,.01,.1)
RXNORM CONCEPT ID FOR MAPPING FDB TO VUID
"^DD",1130590010.002,1130590010.002,.01,1,0)
^.1
"^DD",1130590010.002,1130590010.002,.01,1,1,0)
1130590010.002^B
"^DD",1130590010.002,1130590010.002,.01,1,1,1)
S ^C0PRXN("B",$E(X,1,30),DA)=""
"^DD",1130590010.002,1130590010.002,.01,1,1,2)
K ^C0PRXN("B",$E(X,1,30),DA)
"^DD",1130590010.002,1130590010.002,.01,3)
Answer must be 3-30 characters in length.
"^DD",1130590010.002,1130590010.002,.01,"DT")
3100910
"^DD",1130590010.002,1130590010.002,.02,0)
MEDID^F^^0;2^K:$L(X)>30!($L(X)<3) X
"^DD",1130590010.002,1130590010.002,.02,.1)
FIRST DATABANK MEDID
"^DD",1130590010.002,1130590010.002,.02,3)
Answer must be 3-30 characters in length.
"^DD",1130590010.002,1130590010.002,.02,"DT")
3100912
"^DD",1130590010.002,1130590010.002,.03,0)
VUID^F^^0;3^K:$L(X)>30!($L(X)<3) X
"^DD",1130590010.002,1130590010.002,.03,.1)
VISTA VUID
"^DD",1130590010.002,1130590010.002,.03,3)
Answer must be 3-30 characters in length.
"^DD",1130590010.002,1130590010.002,.03,"DT")
3100912
"^DD",1130590010.002,1130590010.002,.04,0)
GCN^F^^2;2^K:$L(X)>30!($L(X)<3) X
"^DD",1130590010.002,1130590010.002,.04,.1)
GENERIC CONCEPT NUMBER
"^DD",1130590010.002,1130590010.002,.04,3)
Answer must be 3-30 characters in length.
"^DD",1130590010.002,1130590010.002,.04,"DT")
3100910
"^DD",1130590010.002,1130590010.002,1.01,0)
RXNORM CONCEPT^P1130590011.001'^C0P("RXN",^0;4^Q
"^DD",1130590010.002,1130590010.002,1.01,.1)
POINTERE TO RXNORM CONCEPT
"^DD",1130590010.002,1130590010.002,1.01,"DT")
3100910
"^DD",1130590010.002,1130590010.002,1.02,0)
FIRST DATABANK DRUG^P1130590010'^C0P("FDB",^0;5^Q
"^DD",1130590010.002,1130590010.002,1.02,.1)
POINTER TO FIRST DATABANK DRUG
"^DD",1130590010.002,1130590010.002,1.02,"DT")
3100912
"^DD",1130590010.002,1130590010.002,1.03,0)
VISTA DRUG^P50'^PSDRUG(^0;6^Q
"^DD",1130590010.002,1130590010.002,1.03,.1)
POINTER TO THE VISTA DRUG FILE
"^DD",1130590010.002,1130590010.002,1.03,"DT")
3100910
"^DD",1130590010.002,1130590010.002,1.04,0)
VISTA PRODUCT^P50.68'^PSNDF(50.68,^0;7^Q
"^DD",1130590010.002,1130590010.002,1.04,.1)
POINTER TO THE VA PRODUCT FILE (NDF)
"^DD",1130590010.002,1130590010.002,1.04,"DT")
3100912
"^DD",1130590010.002,1130590010.002,1.05,0)
VISTA PHARMACY ORDERABLE ITIEM^CJ^^ ; ^X ^DD(1130590010.002,1.05,9.3) S X=$P($G(^PS(50.7,+$P(Y(1130590010.002,1.05,101),U,1),0)),U) S D0=Y(1130590010.002,1.05,80)
"^DD",1130590010.002,1130590010.002,1.05,.1)
COMPUTED PHARMACY ORDERABLE ITEM
"^DD",1130590010.002,1130590010.002,1.05,9.01)
50^2.1;1130590010.002^1.03
"^DD",1130590010.002,1130590010.002,1.05,9.1)
VISTA DRUG:PHARMACY ORDERABLE ITEM
"^DD",1130590010.002,1130590010.002,1.05,9.2)
S Y(1130590010.002,1.05,80)=$G(D0),Y(1130590010.002,1.05,1)=$S($D(^C0PRXN(D0,0)):^(0),1:"")
"^DD",1130590010.002,1130590010.002,1.05,9.3)
X ^DD(1130590010.002,1.05,9.2) S D0=$P(Y(1130590010.002,1.05,1),U,6) S:'D0!'$D(^PSDRUG(+D0,0)) D0=-1 S Y(1130590010.002,1.05,101)=$S($D(^PSDRUG(D0,2)):^(2),1:"")
"^DD",1130590010.002,1130590010.002,1.05,"DT")
3100912
"^DD",1130590010.002,1130590010.002,2.01,0)
RXNORM CONCEPT LABEL^F^^1;1^K:$L(X)>240!($L(X)<3) X
"^DD",1130590010.002,1130590010.002,2.01,.1)
TEXT LABEL FOR RXNORM CONCEPT
"^DD",1130590010.002,1130590010.002,2.01,3)
Answer must be 3-240 characters in length.
"^DD",1130590010.002,1130590010.002,2.01,"DT")
3100910
"^DD",1130590010.002,1130590010.002,2.02,0)
FDBNAME^F^^2;1^K:$L(X)>30!($L(X)<3) X
"^DD",1130590010.002,1130590010.002,2.02,.1)
FIRST DATABANK NAME
"^DD",1130590010.002,1130590010.002,2.02,3)
Answer must be 3-30 characters in length.
"^DD",1130590010.002,1130590010.002,2.02,"DT")
3100912
"^DD",1130590010.002,1130590010.002,2.03,0)
VANAME^F^^2;3^K:$L(X)>30!($L(X)<3) X
"^DD",1130590010.002,1130590010.002,2.03,.1)
VA DRUG FILE NAME
"^DD",1130590010.002,1130590010.002,2.03,3)
Answer must be 3-30 characters in length.
"^DD",1130590010.002,1130590010.002,2.03,"DT")
3100912
"^DD",1130590010.002,1130590010.002,2.04,0)
VA PRODUCT NAME^F^^2;5^K:$L(X)>80!($L(X)<3) X
"^DD",1130590010.002,1130590010.002,2.04,.1)
TEXT OF VA PRODUCT NAME
"^DD",1130590010.002,1130590010.002,2.04,3)
Answer must be 3-80 characters in length.
"^DD",1130590010.002,1130590010.002,2.04,"DT")
3100910
"^DD",1130590010.002,1130590010.002,3,0)
MAPPING TYPE^S^1:TYPE 1 EXACT MATCH;2:TYPE 2 DRUG FILE MATCH;3:TYPE 3 NDF MATCH;4:TYPE 4 NO MEDID TO VUID MATCH;5:TYPE 5 NO VUID TO MEDID MATCH;^2;4^Q
"^DD",1130590010.002,1130590010.002,3,.1)
MAPPING ANALYSIS RESULT
"^DD",1130590010.002,1130590010.002,3,"DT")
3100910
"^DD",1130590010.002,1130590010.002,4.01,0)
FDB META CODE^CJ^^ ; ^X ^DD(1130590010.002,4.01,9.3) S X=$P(Y(1130590010.002,4.01,101),U,2) S D0=Y(1130590010.002,4.01,80)
"^DD",1130590010.002,1130590010.002,4.01,.1)
FDB META CODE 1 IS GENERIC 2 IS BRANDED
"^DD",1130590010.002,1130590010.002,4.01,9.01)
1130590010^23;1130590010.002^1.02
"^DD",1130590010.002,1130590010.002,4.01,9.1)
FIRST DATABANK DRUG:23
"^DD",1130590010.002,1130590010.002,4.01,9.2)
S Y(1130590010.002,4.01,80)=$G(D0),Y(1130590010.002,4.01,1)=$S($D(^C0PRXN(D0,0)):^(0),1:"")
"^DD",1130590010.002,1130590010.002,4.01,9.3)
X ^DD(1130590010.002,4.01,9.2) S D0=$P(Y(1130590010.002,4.01,1),U,5) S:'D0!'$D(^C0P("FDB",+D0,0)) D0=-1 S Y(1130590010.002,4.01,101)=$S($D(^C0P("FDB",D0,5)):^(5),1:"")
"^DD",1130590010.002,1130590010.002,4.01,"DT")
3100911
"^DD",1130590010.002,1130590010.002,4.02,0)
FDB META DESC^CJ^^ ; ^X ^DD(1130590010.002,4.02,9.3) S X=$P(Y(1130590010.002,4.02,101),U,1) S D0=Y(1130590010.002,4.02,80)
"^DD",1130590010.002,1130590010.002,4.02,.1)
FDB META DESCRIPTION BRANDED, GENERIC, ETC
"^DD",1130590010.002,1130590010.002,4.02,9.01)
1130590010^24;1130590010.002^1.02
"^DD",1130590010.002,1130590010.002,4.02,9.1)
FIRST DATABANK DRUG:24
"^DD",1130590010.002,1130590010.002,4.02,9.2)
S Y(1130590010.002,4.02,80)=$G(D0),Y(1130590010.002,4.02,1)=$S($D(^C0PRXN(D0,0)):^(0),1:"")
"^DD",1130590010.002,1130590010.002,4.02,9.3)
X ^DD(1130590010.002,4.02,9.2) S D0=$P(Y(1130590010.002,4.02,1),U,5) S:'D0!'$D(^C0P("FDB",+D0,0)) D0=-1 S Y(1130590010.002,4.02,101)=$S($D(^C0P("FDB",D0,6)):^(6),1:"")
"^DD",1130590010.002,1130590010.002,4.02,"DT")
3100911
"^DD",1130590011.001,1130590011.001,0)
FIELD^^5^6
"^DD",1130590011.001,1130590011.001,0,"DDA")
N
"^DD",1130590011.001,1130590011.001,0,"DT")
3110610
"^DD",1130590011.001,1130590011.001,0,"ID",2)
W "   ",$P(^(0),U,3)
"^DD",1130590011.001,1130590011.001,0,"ID",3)
W "   ",$P(^(0),U,4)
"^DD",1130590011.001,1130590011.001,0,"ID",4)
W "   ",$P(^(0),U,5)
"^DD",1130590011.001,1130590011.001,0,"IX","B",1130590011.001,.01)

"^DD",1130590011.001,1130590011.001,0,"IX","CODE",1130590011.001,4)

"^DD",1130590011.001,1130590011.001,0,"NM","RXNORM CONCEPTS C0P")

"^DD",1130590011.001,1130590011.001,0,"PT",1130590010.002,1.01)

"^DD",1130590011.001,1130590011.001,0,"VRPK")
C0P
"^DD",1130590011.001,1130590011.001,.01,0)
RXCUI^RNJ7,0^^0;1^K:+X'=X!(X>9999999)!(X<1)!(X?.E1"."1.N) X
"^DD",1130590011.001,1130590011.001,.01,.1)
RxNorm Concept Unique Identifier
"^DD",1130590011.001,1130590011.001,.01,1,0)
^.1
"^DD",1130590011.001,1130590011.001,.01,1,1,0)
1130590011.001^B
"^DD",1130590011.001,1130590011.001,.01,1,1,1)
S ^C0P("RXN","B",$E(X,1,30),DA)=""
"^DD",1130590011.001,1130590011.001,.01,1,1,2)
K ^C0P("RXN","B",$E(X,1,30),DA)
"^DD",1130590011.001,1130590011.001,.01,3)
RXCUI from RxNORM
"^DD",1130590011.001,1130590011.001,.01,10)
Piece 1 from RxNorm file RXNCONSO.RRF
"^DD",1130590011.001,1130590011.001,.01,"DT")
3091229
"^DD",1130590011.001,1130590011.001,1,0)
RXAUI^NJ7,0^^0;2^K:+X'=X!(X>9999999)!(X<1)!(X?.E1"."1.N) X
"^DD",1130590011.001,1130590011.001,1,.1)
RxNorm Atom Unique ID
"^DD",1130590011.001,1130590011.001,1,3)
RXAUI from RxNorm
"^DD",1130590011.001,1130590011.001,1,10)
Piece 8 from RXCONSO.RRF
"^DD",1130590011.001,1130590011.001,1,"DT")
3081117
"^DD",1130590011.001,1130590011.001,2,0)
SAB^F^^0;3^K:$L(X)>15!($L(X)<2) X
"^DD",1130590011.001,1130590011.001,2,.1)
Source Abbreviation. See Description.
"^DD",1130590011.001,1130590011.001,2,3)
Source Abbreviation from RxNorm
"^DD",1130590011.001,1130590011.001,2,10)
Piece 12 from RXCONSO.RRF
"^DD",1130590011.001,1130590011.001,2,21,0)
^^3^3^3081116^
"^DD",1130590011.001,1130590011.001,2,21,1,0)
Abbreviation of the source of the attribute. Possible values 
"^DD",1130590011.001,1130590011.001,2,21,2,0)
appear in RXNSAB.RRF and are listed in Appendix B.4 of the Metathesaurus 
"^DD",1130590011.001,1130590011.001,2,21,3,0)
documentation
"^DD",1130590011.001,1130590011.001,2,"DT")
3091229
"^DD",1130590011.001,1130590011.001,3,0)
TTY^F^^0;4^K:$L(X)>11!($L(X)<2) X
"^DD",1130590011.001,1130590011.001,3,.1)
Term Type in Source. See Description.
"^DD",1130590011.001,1130590011.001,3,3)
Term Type
"^DD",1130590011.001,1130590011.001,3,10)
Piece 13 from RXNCONSO.RRF
"^DD",1130590011.001,1130590011.001,3,21,0)
^^254^254^3081226^
"^DD",1130590011.001,1130590011.001,3,21,1,0)
 TTY     (Term Type in Source)
"^DD",1130590011.001,1130590011.001,3,21,2,0)
 AA      Attribute type abbreviation
"^DD",1130590011.001,1130590011.001,3,21,3,0)
 AB      Abbreviation in any source vocabulary
"^DD",1130590011.001,1130590011.001,3,21,4,0)
 ACR     Acronym
"^DD",1130590011.001,1130590011.001,3,21,5,0)
 AC      Activities
"^DD",1130590011.001,1130590011.001,3,21,6,0)
 AD      Adjective
"^DD",1130590011.001,1130590011.001,3,21,7,0)
 AM      Short form of modifier
"^DD",1130590011.001,1130590011.001,3,21,8,0)
 AS      Attribute type synonym
"^DD",1130590011.001,1130590011.001,3,21,9,0)
 AT      Attribute type
"^DD",1130590011.001,1130590011.001,3,21,10,0)
 BD      Fully-specified drug brand name that can be prescribed
"^DD",1130590011.001,1130590011.001,3,21,11,0)
 BN      Fully-specified drug brand name that can not be prescribed
"^DD",1130590011.001,1130590011.001,3,21,12,0)
 BPCK    Branded Drug Delivery Device
"^DD",1130590011.001,1130590011.001,3,21,13,0)
 BSY     Broad synonym
"^DD",1130590011.001,1130590011.001,3,21,14,0)
 BioCPT  BioCarta PT
"^DD",1130590011.001,1130590011.001,3,21,15,0)
 CA2     ISO 3166-1 standard country code in alpha-2 (two-letter) format
"^DD",1130590011.001,1130590011.001,3,21,16,0)
 CA3     ISO 3166-1 standard country code in alpha-3 (three-letter) format
"^DD",1130590011.001,1130590011.001,3,21,17,0)
 CCN     Chemical code name
"^DD",1130590011.001,1130590011.001,3,21,18,0)
 CCS     FIPS 10-4 country code
"^DD",1130590011.001,1130590011.001,3,21,19,0)
 CC      Trimmed ICPC component process
"^DD",1130590011.001,1130590011.001,3,21,20,0)
 CDA     Clinical drug name in abbreviated format
"^DD",1130590011.001,1130590011.001,3,21,21,0)
 CDCPT   Centers for Disease Control and Prevention PT
"^DD",1130590011.001,1130590011.001,3,21,22,0)
 CDC     Clinical drug name in concatenated format (NDDF), Clinical drug 
"^DD",1130590011.001,1130590011.001,3,21,23,0)
         name (NDFRT)
"^DD",1130590011.001,1130590011.001,3,21,24,0)
 CDD     Clinical drug name in delimited format
"^DD",1130590011.001,1130590011.001,3,21,25,0)
 CDISCPT Clinical Data Interchange Standards Consortium PT
"^DD",1130590011.001,1130590011.001,3,21,26,0)
 CDISCSY Clinical Data Interchange Standards Consortium SY
"^DD",1130590011.001,1130590011.001,3,21,27,0)
 CD      Clinical Drug
"^DD",1130590011.001,1130590011.001,3,21,28,0)
 CE      Entry "term" to a Supplementary Concept "term"
"^DD",1130590011.001,1130590011.001,3,21,29,0)
 CHN     Chemical structure name
"^DD",1130590011.001,1130590011.001,3,21,30,0)
 CL      Class
"^DD",1130590011.001,1130590011.001,3,21,31,0)
 CMN     Common name
"^DD",1130590011.001,1130590011.001,3,21,32,0)
 CN      LOINC official component name
"^DD",1130590011.001,1130590011.001,3,21,33,0)
 CO      Component name (these are hierarchical terms, as opposed to the 
"^DD",1130590011.001,1130590011.001,3,21,34,0)
 LOINC component names which are analytes)
"^DD",1130590011.001,1130590011.001,3,21,35,0)
 CP      ICPC component process (in original form)
"^DD",1130590011.001,1130590011.001,3,21,36,0)
 CSN     Chemical Structure Name
"^DD",1130590011.001,1130590011.001,3,21,37,0)
 CS      Short component process in ICPC, i.e. include some abbreviations
"^DD",1130590011.001,1130590011.001,3,21,38,0)
 CTCAEPT Common Terminology Criteria for Adverse Events Preferred Term
"^DD",1130590011.001,1130590011.001,3,21,39,0)
 CU      Common usage
"^DD",1130590011.001,1130590011.001,3,21,40,0)
 CV      Content view
"^DD",1130590011.001,1130590011.001,3,21,41,0)
 CX      Component process in ICPC with abbreviations expanded
"^DD",1130590011.001,1130590011.001,3,21,42,0)
 DCPPT   Division of Cancer Prevention Program PT
"^DD",1130590011.001,1130590011.001,3,21,43,0)
 DCPSY   Division of Cancer Prevention Program Synonym
"^DD",1130590011.001,1130590011.001,3,21,44,0)
 DEV     Descriptor entry version
"^DD",1130590011.001,1130590011.001,3,21,45,0)
 DE      Descriptor
"^DD",1130590011.001,1130590011.001,3,21,46,0)
 DF      Dose Form
"^DD",1130590011.001,1130590011.001,3,21,47,0)
 DI      Disease name
"^DD",1130590011.001,1130590011.001,3,21,48,0)
 DN      Display Name
"^DD",1130590011.001,1130590011.001,3,21,49,0)
 DO      Domain
"^DD",1130590011.001,1130590011.001,3,21,50,0)
 DP      Drug Product
"^DD",1130590011.001,1130590011.001,3,21,51,0)
 DSV     Descriptor sort version
"^DD",1130590011.001,1130590011.001,3,21,52,0)
 DS      Short form of descriptor
"^DD",1130590011.001,1130590011.001,3,21,53,0)
 DTPPT   NCI Developmental Therapeutics Program Preferred Term
"^DD",1130590011.001,1130590011.001,3,21,54,0)
 DTPSY   Developmental Therapeutics Program SY
"^DD",1130590011.001,1130590011.001,3,21,55,0)
 DT      Definitional term, present in the Metathesaurus because of its 
"^DD",1130590011.001,1130590011.001,3,21,56,0)
         connection to a Dorland's definition or to a definition created 
"^DD",1130590011.001,1130590011.001,3,21,57,0)
         especially for the Metathesaurus
"^DD",1130590011.001,1130590011.001,3,21,58,0)
 DX      Diagnosis
"^DD",1130590011.001,1130590011.001,3,21,59,0)
 EN      MeSH nonprint entry "term"
"^DD",1130590011.001,1130590011.001,3,21,60,0)
 EP      Entry "term"
"^DD",1130590011.001,1130590011.001,3,21,61,0)
 EQ      Equivalent name
"^DD",1130590011.001,1130590011.001,3,21,62,0)
 ES      Short form of entry term
"^DD",1130590011.001,1130590011.001,3,21,63,0)
 ETAV    Entry Term Allelic Variant
"^DD",1130590011.001,1130590011.001,3,21,64,0)
 ET      Entry "term"
"^DD",1130590011.001,1130590011.001,3,21,65,0)
 EX      Expanded form of entry term
"^DD",1130590011.001,1130590011.001,3,21,66,0)
 FBD     Foreign brand name
"^DD",1130590011.001,1130590011.001,3,21,67,0)
 FDAAB   Food and Drug Administration AB
"^DD",1130590011.001,1130590011.001,3,21,68,0)
 FDAPT   Food and Drug Administration PT
"^DD",1130590011.001,1130590011.001,3,21,69,0)
 FDASY   Food and Drug Administration SY
"^DD",1130590011.001,1130590011.001,3,21,70,0)
 FI      Finding name
"^DD",1130590011.001,1130590011.001,3,21,71,0)
 FN      Full form of descriptor
"^DD",1130590011.001,1130590011.001,3,21,72,0)
 GN      Generic drug name
"^DD",1130590011.001,1130590011.001,3,21,73,0)
 GO      Goal
"^DD",1130590011.001,1130590011.001,3,21,74,0)
 GPCK    Generic Drug Delivery Device
"^DD",1130590011.001,1130590011.001,3,21,75,0)
 GT      Glossary "term"
"^DD",1130590011.001,1130590011.001,3,21,76,0)
 HC      Hierarchical class
"^DD",1130590011.001,1130590011.001,3,21,77,0)
 HD      Hierarchical descriptor
"^DD",1130590011.001,1130590011.001,3,21,78,0)
 HGJKN1  Japanese High Level Group Term (kana1)
"^DD",1130590011.001,1130590011.001,3,21,79,0)
 HGJKN   Japanese High Level Group Term (kana)
"^DD",1130590011.001,1130590011.001,3,21,80,0)
 HG      High Level Group Term
"^DD",1130590011.001,1130590011.001,3,21,81,0)
 HS      Short or alternate version of hierarchical term
"^DD",1130590011.001,1130590011.001,3,21,82,0)
 HTJKN1  Japanese Hierarchical term (kana1)
"^DD",1130590011.001,1130590011.001,3,21,83,0)
 HTJKN   Japanese Hierarchical term (kana)
"^DD",1130590011.001,1130590011.001,3,21,84,0)
 HTN     HL7 Table Name
"^DD",1130590011.001,1130590011.001,3,21,85,0)
 HT      Hierarchical term
"^DD",1130590011.001,1130590011.001,3,21,86,0)
 HX      Expanded version of short hierarchical term
"^DD",1130590011.001,1130590011.001,3,21,87,0)
 ID      Nursing indicator
"^DD",1130590011.001,1130590011.001,3,21,88,0)
 INP     Ingredient preparation
"^DD",1130590011.001,1130590011.001,3,21,89,0)
 IN      Name for an ingredient
"^DD",1130590011.001,1130590011.001,3,21,90,0)
 IS      Obsolete Synonym
"^DD",1130590011.001,1130590011.001,3,21,91,0)
 IT      Index "term", i.e., derived from the index to any non-MeSH source
"^DD",1130590011.001,1130590011.001,3,21,92,0)
         vocabulary
"^DD",1130590011.001,1130590011.001,3,21,93,0)
 IVC     Intervention categories
"^DD",1130590011.001,1130590011.001,3,21,94,0)
 IV      Intervention
"^DD",1130590011.001,1130590011.001,3,21,95,0)
 JAXPT   NCI Mouse Terminology PT
"^DD",1130590011.001,1130590011.001,3,21,96,0)
 JAXSY   NCI Mouse Terminology SY
"^DD",1130590011.001,1130590011.001,3,21,97,0)
 KEGGPT  Kyoto Encyclopedia of Genes and Genomes PT
"^DD",1130590011.001,1130590011.001,3,21,98,0)
 LN      LOINC official fully specified name
"^DD",1130590011.001,1130590011.001,3,21,99,0)
 LO      Obsolete official fully specified name
"^DD",1130590011.001,1130590011.001,3,21,100,0)
 LPDN    LOINC parts display name
"^DD",1130590011.001,1130590011.001,3,21,101,0)
 LPN     LOINC parts name
"^DD",1130590011.001,1130590011.001,3,21,102,0)
 LS      Expanded system/sample type (The expanded version was created for
"^DD",1130590011.001,1130590011.001,3,21,103,0)
         the Metathesaurus and includes the full name of some
"^DD",1130590011.001,1130590011.001,3,21,104,0)
         abbreviations.)
"^DD",1130590011.001,1130590011.001,3,21,105,0)
 LTJKN1  Japanese Lower Level Term (kana1)
"^DD",1130590011.001,1130590011.001,3,21,106,0)
 LTJKN   Japanese Lower Level Term (kana)
"^DD",1130590011.001,1130590011.001,3,21,107,0)
 LT      Lower Level Term
"^DD",1130590011.001,1130590011.001,3,21,108,0)
 LV      Lexical variant
"^DD",1130590011.001,1130590011.001,3,21,109,0)
 LX      Official fully specified name with expanded abbreviations
"^DD",1130590011.001,1130590011.001,3,21,110,0)
 MD      CCS multi-level diagnosis categories
"^DD",1130590011.001,1130590011.001,3,21,111,0)
 MH      Main heading
"^DD",1130590011.001,1130590011.001,3,21,112,0)
 MOA     Mechanism of action
"^DD",1130590011.001,1130590011.001,3,21,113,0)
 MP      Preferred names of modifiers
"^DD",1130590011.001,1130590011.001,3,21,114,0)
 MS      Multum names of branded and generic supplies or supplements
"^DD",1130590011.001,1130590011.001,3,21,115,0)
 MTH_AB  MTH abbreviation
"^DD",1130590011.001,1130590011.001,3,21,116,0)
 MTH_ACR MTH acronym
"^DD",1130590011.001,1130590011.001,3,21,117,0)
 MTH_BD  MTH fully-specified drug brand name that can be prescribed
"^DD",1130590011.001,1130590011.001,3,21,118,0)
 MTH_BSY Metathesaurus broad synonym expanded
"^DD",1130590011.001,1130590011.001,3,21,119,0)
 MTH_CHN MTH chemical structure name
"^DD",1130590011.001,1130590011.001,3,21,120,0)
 MTH_EP  MTH entry "term"
"^DD",1130590011.001,1130590011.001,3,21,121,0)
 MTH_FN  MTH Full form of descriptor
"^DD",1130590011.001,1130590011.001,3,21,122,0)
 MTH_HG  MTH High Level Group Term
"^DD",1130590011.001,1130590011.001,3,21,123,0)
 MTH_HT  MTH Hierarchical term
"^DD",1130590011.001,1130590011.001,3,21,124,0)
 MTH_ID  Metathesaurus expanded form of nursing indicator
"^DD",1130590011.001,1130590011.001,3,21,125,0)
 MTH_IS  Metathesaurus-supplied form of obsolete synonym
"^DD",1130590011.001,1130590011.001,3,21,126,0)
 MTH_LT  MTH Lower Level Term
"^DD",1130590011.001,1130590011.001,3,21,127,0)
 MTH_LV  MTH lexical variant
"^DD",1130590011.001,1130590011.001,3,21,128,0)
 MTH_MH  MTH main heading
"^DD",1130590011.001,1130590011.001,3,21,129,0)
 MTH_NPT MTH non-preferred for language term
"^DD",1130590011.001,1130590011.001,3,21,130,0)
 MTH_NSY Metathesaurus narrow synonym expanded
"^DD",1130590011.001,1130590011.001,3,21,131,0)
 MTH_OF  Metathesaurus-supplied form of obsolete fully specified name
"^DD",1130590011.001,1130590011.001,3,21,132,0)
 MTH_OL  MTH Non-current Lower Level Term
"^DD",1130590011.001,1130590011.001,3,21,133,0)
 MTH_OPN Metathesaurus obsolete preferred term, natural language form
"^DD",1130590011.001,1130590011.001,3,21,134,0)
 MTH_OP  Metathesaurus obsolete preferred term
"^DD",1130590011.001,1130590011.001,3,21,135,0)
 MTH_OS  MTH System-organ class
"^DD",1130590011.001,1130590011.001,3,21,136,0)
 MTH_PEP MTH preferred entry "term"
"^DD",1130590011.001,1130590011.001,3,21,137,0)
 MTH_PTGB        Metathesaurus-supplied form of British preferred term
"^DD",1130590011.001,1130590011.001,3,21,138,0)
 MTH_PTN Metathesaurus preferred term, natural language form
"^DD",1130590011.001,1130590011.001,3,21,139,0)
 MTH_PT  Metathesaurus preferred term
"^DD",1130590011.001,1130590011.001,3,21,140,0)
 MTH_RLS Metathesaurus related synonym expanded
"^DD",1130590011.001,1130590011.001,3,21,141,0)
 MTH_RXN_BD      RxNorm Created BD
"^DD",1130590011.001,1130590011.001,3,21,142,0)
 MTH_RXN_CD      RxNorm Created CD
"^DD",1130590011.001,1130590011.001,3,21,143,0)
 MTH_RXN_DP      RxNorm Created DP
"^DD",1130590011.001,1130590011.001,3,21,144,0)
 MTH_SI  MTH Sign or symptom of
"^DD",1130590011.001,1130590011.001,3,21,145,0)
 MTH_SMQ Metathesaurus version of Standardised MedDRA Query
"^DD",1130590011.001,1130590011.001,3,21,146,0)
 MTH_SYGB        Metathesaurus-supplied form of British synonym
"^DD",1130590011.001,1130590011.001,3,21,147,0)
 MTH_SY  MTH Designated synonym
"^DD",1130590011.001,1130590011.001,3,21,148,0)
 MV      Multi-level procedure category
"^DD",1130590011.001,1130590011.001,3,21,149,0)
 N1      Chemical Abstracts Service Type 1 name of a chemical
"^DD",1130590011.001,1130590011.001,3,21,150,0)
 NCI-GLOSSPT     NCI-GLOSS PT
"^DD",1130590011.001,1130590011.001,3,21,151,0)
 NCI-GLOSSSY     NCI-GLOSS SY
"^DD",1130590011.001,1130590011.001,3,21,152,0)
 NM      Supplementary chemical "term", a name of a substance
"^DD",1130590011.001,1130590011.001,3,21,153,0)
 NPT     HL7 non-preferred for language term
"^DD",1130590011.001,1130590011.001,3,21,154,0)
 NP      Non-preferred term
"^DD",1130590011.001,1130590011.001,3,21,155,0)
 NSY     Narrow synonym
"^DD",1130590011.001,1130590011.001,3,21,156,0)
 NS      Short form of non-preferred term
"^DD",1130590011.001,1130590011.001,3,21,157,0)
 NX      Expanded form of non-preferred term
"^DD",1130590011.001,1130590011.001,3,21,158,0)
 OAM     Obsolete Modifier Abbreviation
"^DD",1130590011.001,1130590011.001,3,21,159,0)
 OA      Obsolete abbreviation
"^DD",1130590011.001,1130590011.001,3,21,160,0)
 OBS     Obsolete broad synonym
"^DD",1130590011.001,1130590011.001,3,21,161,0)
 OB      Obsolete term
"^DD",1130590011.001,1130590011.001,3,21,162,0)
 OCD     Obsolete clinical drug
"^DD",1130590011.001,1130590011.001,3,21,163,0)
 OC      Nursing outcomes
"^DD",1130590011.001,1130590011.001,3,21,164,0)
 OF      Obsolete fully specified name
"^DD",1130590011.001,1130590011.001,3,21,165,0)
 OLJKN1  Japanese Non-current Lower Level Term (kana1)
"^DD",1130590011.001,1130590011.001,3,21,166,0)
 OLJKN   Japanese Non-current Lower Level Term (kana)
"^DD",1130590011.001,1130590011.001,3,21,167,0)
 OLX     Expanded LOINC obsolete fully specified name
"^DD",1130590011.001,1130590011.001,3,21,168,0)
 OL      Non-current Lower Level Term
"^DD",1130590011.001,1130590011.001,3,21,169,0)
 OM      Obsolete modifiers in HCPCS
"^DD",1130590011.001,1130590011.001,3,21,170,0)
 ONP     Obsolete non-preferred for language term
"^DD",1130590011.001,1130590011.001,3,21,171,0)
 ONS     Obsolete narrow synonym
"^DD",1130590011.001,1130590011.001,3,21,172,0)
 OOSN    Obsolete official short name
"^DD",1130590011.001,1130590011.001,3,21,173,0)
 OPN     Obsolete preferred term, natural language form
"^DD",1130590011.001,1130590011.001,3,21,174,0)
 OP      Obsolete preferred term
"^DD",1130590011.001,1130590011.001,3,21,175,0)
 ORS     Obsolete related synonym
"^DD",1130590011.001,1130590011.001,3,21,176,0)
 OR      Orders
"^DD",1130590011.001,1130590011.001,3,21,177,0)
 OSJKN1  Japanese System-organ class in the WHO Adverse Reaction 
"^DD",1130590011.001,1130590011.001,3,21,178,0)
         Terminology (kana1)
"^DD",1130590011.001,1130590011.001,3,21,179,0)
 OSJKN   Japanese System-organ class in the WHO Adverse Reaction 
"^DD",1130590011.001,1130590011.001,3,21,180,0)
         Terminology (kana)
"^DD",1130590011.001,1130590011.001,3,21,181,0)
 OSN     Official short name
"^DD",1130590011.001,1130590011.001,3,21,182,0)
 OS      System-organ class in the WHO Adverse Reaction Terminology
"^DD",1130590011.001,1130590011.001,3,21,183,0)
 OWL     rdf:ID of the owl class
"^DD",1130590011.001,1130590011.001,3,21,184,0)
 PCE     Preferred entry "term" to a Supplementary Concept "term"
"^DD",1130590011.001,1130590011.001,3,21,185,0)
 PC      Preferred "trimmed term" in ICPC
"^DD",1130590011.001,1130590011.001,3,21,186,0)
 PEN     Preferred MeSH nonprint entry "term"
"^DD",1130590011.001,1130590011.001,3,21,187,0)
 PEP     Preferred entry "term"
"^DD",1130590011.001,1130590011.001,3,21,188,0)
 PE      Physiologic effect
"^DD",1130590011.001,1130590011.001,3,21,189,0)
 PK      Pharmacokinetics
"^DD",1130590011.001,1130590011.001,3,21,190,0)
 PM      Machine permutation
"^DD",1130590011.001,1130590011.001,3,21,191,0)
 PN      Metathesaurus preferred name
"^DD",1130590011.001,1130590011.001,3,21,192,0)
 PQ      Qualifier for a problem
"^DD",1130590011.001,1130590011.001,3,21,193,0)
 PR      Name of a problem
"^DD",1130590011.001,1130590011.001,3,21,194,0)
 PSC     Protocol selection criteria
"^DD",1130590011.001,1130590011.001,3,21,195,0)
 PS      Short forms that needed full specification
"^DD",1130590011.001,1130590011.001,3,21,196,0)
 PTAV    Preferred Allelic Variant
"^DD",1130590011.001,1130590011.001,3,21,197,0)
 PTCS    Preferred Clinical Synopsis
"^DD",1130590011.001,1130590011.001,3,21,198,0)
 PTGB    British preferred term
"^DD",1130590011.001,1130590011.001,3,21,199,0)
 PTJKN1  Japanese Designated preferred name (kana1)
"^DD",1130590011.001,1130590011.001,3,21,200,0)
 PTJKN   Japanese Designated preferred name (kana)
"^DD",1130590011.001,1130590011.001,3,21,201,0)
 PTN     Preferred term, natural language form
"^DD",1130590011.001,1130590011.001,3,21,202,0)
 PT      Designated preferred name
"^DD",1130590011.001,1130590011.001,3,21,203,0)
 PXQ     Preferred term in preferred qualifier concept.
"^DD",1130590011.001,1130590011.001,3,21,204,0)
 PX      Expanded preferred terms (pair with PS)
"^DD",1130590011.001,1130590011.001,3,21,205,0)
 QAB     Qualifier abbreviation
"^DD",1130590011.001,1130590011.001,3,21,206,0)
 QEV     Qualifier entry version
"^DD",1130590011.001,1130590011.001,3,21,207,0)
 QSV     Qualifier sort version
"^DD",1130590011.001,1130590011.001,3,21,208,0)
 RAB     Root abbreviation
"^DD",1130590011.001,1130590011.001,3,21,209,0)
 RENIDN  Registry Nomenclature Information Display Name
"^DD",1130590011.001,1130590011.001,3,21,210,0)
 RHT     Root hierarchical term
"^DD",1130590011.001,1130590011.001,3,21,211,0)
 RLS     Related synonym
"^DD",1130590011.001,1130590011.001,3,21,212,0)
 RPT     Root preferred term
"^DD",1130590011.001,1130590011.001,3,21,213,0)
 RSY     Root synonym
"^DD",1130590011.001,1130590011.001,3,21,214,0)
 RS      Extracted related names in SNOMED2
"^DD",1130590011.001,1130590011.001,3,21,215,0)
 RT      Designated related "term"
"^DD",1130590011.001,1130590011.001,3,21,216,0)
 SBDC    Semantic Branded Drug Component
"^DD",1130590011.001,1130590011.001,3,21,217,0)
 SBDF    Semantic branded drug and form
"^DD",1130590011.001,1130590011.001,3,21,218,0)
 SBD     Semantic branded drug
"^DD",1130590011.001,1130590011.001,3,21,219,0)
 SB      Named subset of a source
"^DD",1130590011.001,1130590011.001,3,21,220,0)
 SCALE   Scale
"^DD",1130590011.001,1130590011.001,3,21,221,0)
 SCDC    Semantic Drug Component
"^DD",1130590011.001,1130590011.001,3,21,222,0)
 SCDF    Semantic clinical drug and form
"^DD",1130590011.001,1130590011.001,3,21,223,0)
 SCD     Semantic Clinical Drug
"^DD",1130590011.001,1130590011.001,3,21,224,0)
 SCN     Scientific name
"^DD",1130590011.001,1130590011.001,3,21,225,0)
 SC      Special Category term
"^DD",1130590011.001,1130590011.001,3,21,226,0)
 SD      CCS single-level diagnosis categories
"^DD",1130590011.001,1130590011.001,3,21,227,0)
 SI      Name of a sign or symptom of a problem
"^DD",1130590011.001,1130590011.001,3,21,228,0)
 SMQ     Standardised MedDRA Query
"^DD",1130590011.001,1130590011.001,3,21,229,0)
 SN      Official component synonym in LOINC
"^DD",1130590011.001,1130590011.001,3,21,230,0)
 SP      CCS single-level procedure categories
"^DD",1130590011.001,1130590011.001,3,21,231,0)
 SSN     Source short name, used in the UMLS Knowledge Source Server
"^DD",1130590011.001,1130590011.001,3,21,232,0)
 SS      Synonymous "short" forms
"^DD",1130590011.001,1130590011.001,3,21,233,0)
 ST      Step
"^DD",1130590011.001,1130590011.001,3,21,234,0)
 SU      Active Substance
"^DD",1130590011.001,1130590011.001,3,21,235,0)
 SX      Mixed-case component synonym with expanded abbreviations
"^DD",1130590011.001,1130590011.001,3,21,236,0)
 SYGB    British synonym
"^DD",1130590011.001,1130590011.001,3,21,237,0)
 SYN     Designated alias
"^DD",1130590011.001,1130590011.001,3,21,238,0)
 SY      Designated synonym
"^DD",1130590011.001,1130590011.001,3,21,239,0)
 TA      Task
"^DD",1130590011.001,1130590011.001,3,21,240,0)
 TC      Term class
"^DD",1130590011.001,1130590011.001,3,21,241,0)
 TG      Name of the target of an intervention
"^DD",1130590011.001,1130590011.001,3,21,242,0)
 TQ      Topical qualifier
"^DD",1130590011.001,1130590011.001,3,21,243,0)
 TX      CCPSS synthesized problems for TC termgroup
"^DD",1130590011.001,1130590011.001,3,21,244,0)
 UCN     Unique common name
"^DD",1130590011.001,1130590011.001,3,21,245,0)
 UE      Unique equivalent name
"^DD",1130590011.001,1130590011.001,3,21,246,0)
 USN     Unique scientific name
"^DD",1130590011.001,1130590011.001,3,21,247,0)
 USY     Unique synonym
"^DD",1130590011.001,1130590011.001,3,21,248,0)
 VAB     Versioned abbreviation
"^DD",1130590011.001,1130590011.001,3,21,249,0)
 VPT     Versioned preferred term
"^DD",1130590011.001,1130590011.001,3,21,250,0)
 VSY     Versioned synonym
"^DD",1130590011.001,1130590011.001,3,21,251,0)
 XD      Expanded descriptor in AOD
"^DD",1130590011.001,1130590011.001,3,21,252,0)
 XM      Cross mapping set
"^DD",1130590011.001,1130590011.001,3,21,253,0)
 XQ      Alternate name for a qualifier
"^DD",1130590011.001,1130590011.001,3,21,254,0)
 XX      Expanded string
"^DD",1130590011.001,1130590011.001,3,"DT")
3091229
"^DD",1130590011.001,1130590011.001,4,0)
CODE^F^^0;5^K:$L(X)>30!($L(X)<1) X
"^DD",1130590011.001,1130590011.001,4,.1)
Most useful identifier. See Description.
"^DD",1130590011.001,1130590011.001,4,1,0)
^.1
"^DD",1130590011.001,1130590011.001,4,1,1,0)
1130590011.001^CODE
"^DD",1130590011.001,1130590011.001,4,1,1,1)
S ^C0P("RXN","CODE",$E(X,1,30),DA)=""
"^DD",1130590011.001,1130590011.001,4,1,1,2)
K ^C0P("RXN","CODE",$E(X,1,30),DA)
"^DD",1130590011.001,1130590011.001,4,1,1,"%D",0)
^^2^2^3091206^
"^DD",1130590011.001,1130590011.001,4,1,1,"%D",1,0)
This cross reference is to enable users and programmers to lookup a value 
"^DD",1130590011.001,1130590011.001,4,1,1,"%D",2,0)
by raw code.
"^DD",1130590011.001,1130590011.001,4,1,1,"DT")
3091206
"^DD",1130590011.001,1130590011.001,4,3)
Code for the entry
"^DD",1130590011.001,1130590011.001,4,10)
Piece 14 from RXNCONSO.RRF
"^DD",1130590011.001,1130590011.001,4,21,0)
^^3^3^3081116^
"^DD",1130590011.001,1130590011.001,4,21,1,0)
"Most useful" source asserted identifier (if the source vocabulary has 
"^DD",1130590011.001,1130590011.001,4,21,2,0)
more than one identifier), or a Metathesaurus-generated source entry 
"^DD",1130590011.001,1130590011.001,4,21,3,0)
identifier (if the source vocabulary has none.)
"^DD",1130590011.001,1130590011.001,4,"DT")
3091229
"^DD",1130590011.001,1130590011.001,5,0)
STR^1130590011.0015^^1;0
"^DD",1130590011.001,1130590011.0015,0)
STR SUB-FIELD^^.01^1
"^DD",1130590011.001,1130590011.0015,0,"DT")
3110610
"^DD",1130590011.001,1130590011.0015,0,"NM","STR")

"^DD",1130590011.001,1130590011.0015,0,"UP")
1130590011.001
"^DD",1130590011.001,1130590011.0015,.01,0)
STR^W^^0;1^Q
"^DD",1130590011.001,1130590011.0015,.01,.1)
String
"^DD",1130590011.001,1130590011.0015,.01,3)
Expanded Name of the Entry
"^DD",1130590011.001,1130590011.0015,.01,10)
Piece 15 from RXNCONSO.RRF
"^DD",1130590011.001,1130590011.0015,.01,"DT")
3110610
"^DIC",113059001,113059001,0)
C0P XML TEMPLATE^113059001
"^DIC",113059001,113059001,0,"GL")
^C0PX(
"^DIC",113059001,113059001,"%",0)
^1.005^^0
"^DIC",113059001,113059001,"%D",0)
^^38^38^3120504^
"^DIC",113059001,113059001,"%D",1,0)
Copyright 2009 George Lilly.  Licensed under the terms of the GNU General
"^DIC",113059001,113059001,"%D",2,0)
Public License See attached copy of the License.
"^DIC",113059001,113059001,"%D",3,0)
 
"^DIC",113059001,113059001,"%D",4,0)
This program is free software; you can redistribute it and/or modify it
"^DIC",113059001,113059001,"%D",5,0)
under the terms of the GNU General Public License as published by the Free
"^DIC",113059001,113059001,"%D",6,0)
Software Foundation; either version 2 of the License, or (at your option)
"^DIC",113059001,113059001,"%D",7,0)
any later version.
"^DIC",113059001,113059001,"%D",8,0)
 
"^DIC",113059001,113059001,"%D",9,0)
This program is distributed in the hope that it will be useful, but
"^DIC",113059001,113059001,"%D",10,0)
WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
"^DIC",113059001,113059001,"%D",11,0)
or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
"^DIC",113059001,113059001,"%D",12,0)
for more details.
"^DIC",113059001,113059001,"%D",13,0)
     
"^DIC",113059001,113059001,"%D",14,0)
You should have received a copy of the GNU General Public License along
"^DIC",113059001,113059001,"%D",15,0)
with this program; if not, write to the Free Software Foundation, Inc., 51
"^DIC",113059001,113059001,"%D",16,0)
Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.   
"^DIC",113059001,113059001,"%D",17,0)
 
"^DIC",113059001,113059001,"%D",18,0)
This file was created by George Lilly for the Oroville Hospital
"^DIC",113059001,113059001,"%D",19,0)
ePrescribing project. 
"^DIC",113059001,113059001,"%D",20,0)
 
"^DIC",113059001,113059001,"%D",21,0)
It stores XML templates that define web services for use in VistA. 
"^DIC",113059001,113059001,"%D",22,0)
 
"^DIC",113059001,113059001,"%D",23,0)
Each template has a name and a pointer to a Web Service record in the C0P
"^DIC",113059001,113059001,"%D",24,0)
WEB SERVICE file #113059003. For templates that define external web
"^DIC",113059001,113059001,"%D",25,0)
services, there is automation to generate most of this file. If a template
"^DIC",113059001,113059001,"%D",26,0)
record has a name and a pointer to its webservice, and a URL to its WSDL
"^DIC",113059001,113059001,"%D",27,0)
definition on the external web service, TBLD^C0PWS1(DA) will download the
"^DIC",113059001,113059001,"%D",28,0)
WSDL xml, put it in the Raw XML WP field, call INDEX^C0CXPATH to generate
"^DIC",113059001,113059001,"%D",29,0)
a template, store the template in the Template WP field, and then generate
"^DIC",113059001,113059001,"%D",30,0)
a XPath binding subfile for each XPath in the xml. It will also look to
"^DIC",113059001,113059001,"%D",31,0)
see if the XPath binding has already been created for a different template
"^DIC",113059001,113059001,"%D",32,0)
pointing to the same web service, and if so, will copy the VistA bindings
"^DIC",113059001,113059001,"%D",33,0)
from that definition. Often, multiple templates for the same web service
"^DIC",113059001,113059001,"%D",34,0)
will have many XPath definitions in common. So when adding a new web
"^DIC",113059001,113059001,"%D",35,0)
service to the system, start with one template, run TBLKD^C0PWS1, and then
"^DIC",113059001,113059001,"%D",36,0)
add the VistA binding by hand. After the first one is completed, add the
"^DIC",113059001,113059001,"%D",37,0)
other templates and avoid having to enter the common XPath bindings again
"^DIC",113059001,113059001,"%D",38,0)
by hand.
"^DIC",113059001,"B","C0P XML TEMPLATE",113059001)

"^DIC",113059002,113059002,0)
C0P WS ACCT^113059002
"^DIC",113059002,113059002,0,"GL")
^C0PS(
"^DIC",113059002,113059002,"%",0)
^1.005^^0
"^DIC",113059002,113059002,"%D",0)
^^24^24^3120507^
"^DIC",113059002,113059002,"%D",1,0)
This file contains account information used to connect to the eRx 
"^DIC",113059002,113059002,"%D",2,0)
WebService, currently New Crop.
"^DIC",113059002,113059002,"%D",3,0)
 
"^DIC",113059002,113059002,"%D",4,0)
A priviliged user needs to fill this in when initially setting up the 
"^DIC",113059002,113059002,"%D",5,0)
system. When setting up eRx, you will point users to entries in this file.
"^DIC",113059002,113059002,"%D",6,0)
The code uses the currently logged in user to resolve what Web Service 
"^DIC",113059002,113059002,"%D",7,0)
entry to use. For more information, see the eRx Package Set-up Guide.
"^DIC",113059002,113059002,"%D",8,0)
 
"^DIC",113059002,113059002,"%D",9,0)
Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"^DIC",113059002,113059002,"%D",10,0)
General Public License See attached copy of the License.
"^DIC",113059002,113059002,"%D",11,0)
 
"^DIC",113059002,113059002,"%D",12,0)
This program is free software; you can redistribute it and/or modify
"^DIC",113059002,113059002,"%D",13,0)
it under the terms of the GNU General Public License as published by
"^DIC",113059002,113059002,"%D",14,0)
the Free Software Foundation; either version 2 of the License, or
"^DIC",113059002,113059002,"%D",15,0)
(at your option) any later version.
"^DIC",113059002,113059002,"%D",16,0)
 
"^DIC",113059002,113059002,"%D",17,0)
This program is distributed in the hope that it will be useful,
"^DIC",113059002,113059002,"%D",18,0)
but WITHOUT ANY WARRANTY; without even the implied warranty of
"^DIC",113059002,113059002,"%D",19,0)
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"^DIC",113059002,113059002,"%D",20,0)
GNU General Public License for more details.
"^DIC",113059002,113059002,"%D",21,0)
 
"^DIC",113059002,113059002,"%D",22,0)
You should have received a copy of the GNU General Public License along
"^DIC",113059002,113059002,"%D",23,0)
with this program; if not, write to the Free Software Foundation, Inc.,
"^DIC",113059002,113059002,"%D",24,0)
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
"^DIC",113059002,"B","C0P WS ACCT",113059002)

"^DIC",113059003,113059003,0)
C0P WEB SERVICE^113059003
"^DIC",113059003,113059003,0,"GL")
^C0PW(
"^DIC",113059003,113059003,"%",0)
^1.005^^0
"^DIC",113059003,113059003,"%D",0)
^^29^29^3120507^
"^DIC",113059003,113059003,"%D",1,0)
This file is used as a walkthrough from the Web Service Account in C0P WS
"^DIC",113059003,113059003,"%D",2,0)
ACCT to the Web Service XML/endpoint in C0P XML TEMPLATE.
"^DIC",113059003,113059003,"%D",3,0)
 
"^DIC",113059003,113059003,"%D",4,0)
Each entry in the C0P XML TEMPLATE file can belong to only one Web 
"^DIC",113059003,113059003,"%D",5,0)
Service.
"^DIC",113059003,113059003,"%D",6,0)
 
"^DIC",113059003,113059003,"%D",7,0)
The way a specific template/web service call is decided upon is to check 
"^DIC",113059003,113059003,"%D",8,0)
the DUZ's C0P SUBSCRIPTION entry in the new person file, which points to
"^DIC",113059003,113059003,"%D",9,0)
the account in the C0P WS ACCT file. The account will contain an entry to
"^DIC",113059003,113059003,"%D",10,0)
C0P WEB SERVICE (this file). The entry in this file will be used to
"^DIC",113059003,113059003,"%D",11,0)
resolve the entry correct template to use from C0P XML TEMPLATE for the
"^DIC",113059003,113059003,"%D",12,0)
specific web service.
"^DIC",113059003,113059003,"%D",13,0)
 
"^DIC",113059003,113059003,"%D",14,0)
Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"^DIC",113059003,113059003,"%D",15,0)
General Public License See attached copy of the License.
"^DIC",113059003,113059003,"%D",16,0)
 
"^DIC",113059003,113059003,"%D",17,0)
This program is free software; you can redistribute it and/or modify
"^DIC",113059003,113059003,"%D",18,0)
it under the terms of the GNU General Public License as published by
"^DIC",113059003,113059003,"%D",19,0)
the Free Software Foundation; either version 2 of the License, or
"^DIC",113059003,113059003,"%D",20,0)
(at your option) any later version.
"^DIC",113059003,113059003,"%D",21,0)
 
"^DIC",113059003,113059003,"%D",22,0)
This program is distributed in the hope that it will be useful,
"^DIC",113059003,113059003,"%D",23,0)
but WITHOUT ANY WARRANTY; without even the implied warranty of
"^DIC",113059003,113059003,"%D",24,0)
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"^DIC",113059003,113059003,"%D",25,0)
GNU General Public License for more details.
"^DIC",113059003,113059003,"%D",26,0)
 
"^DIC",113059003,113059003,"%D",27,0)
You should have received a copy of the GNU General Public License along
"^DIC",113059003,113059003,"%D",28,0)
with this program; if not, write to the Free Software Foundation, Inc.,
"^DIC",113059003,113059003,"%D",29,0)
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
"^DIC",113059003,"B","C0P WEB SERVICE",113059003)

"^DIC",1130590010,1130590010,0)
FIRST DATABANK DRUGS^1130590010
"^DIC",1130590010,1130590010,0,"GL")
^C0P("FDB",
"^DIC",1130590010,1130590010,"%",0)
^1.005^^0
"^DIC",1130590010,1130590010,"%D",0)
^^104^104^3120507^
"^DIC",1130590010,1130590010,"%D",1,0)
License:
"^DIC",1130590010,1130590010,"%D",2,0)
 
"^DIC",1130590010,1130590010,"%D",3,0)
All data structures and data in this file is licensed from First Databank 
"^DIC",1130590010,1130590010,"%D",4,0)
or it licensors (e.g. New Crop). You need a license agreement to be able 
"^DIC",1130590010,1130590010,"%D",5,0)
to use this file.
"^DIC",1130590010,1130590010,"%D",6,0)
 
"^DIC",1130590010,1130590010,"%D",7,0)
---
"^DIC",1130590010,1130590010,"%D",8,0)
 
"^DIC",1130590010,1130590010,"%D",9,0)
This file contains all the drugs prescribed in the US according to First 
"^DIC",1130590010,1130590010,"%D",10,0)
Databank. It has been created by SMH for Oroville Hospital in December 
"^DIC",1130590010,1130590010,"%D",11,0)
2009. At the time of its creation, it reflects First Databank Drugs as of 
"^DIC",1130590010,1130590010,"%D",12,0)
October 2009, which was the most recent release available.
"^DIC",1130590010,1130590010,"%D",13,0)
 
"^DIC",1130590010,1130590010,"%D",14,0)
Update: SMH has updated the file to April 2012 for release as part of 
"^DIC",1130590010,1130590010,"%D",15,0)
Worldvista 2.0.
"^DIC",1130590010,1130590010,"%D",16,0)
 
"^DIC",1130590010,1130590010,"%D",17,0)
It was imported from a table called 'tblCompositeDrugs' provided in an 
"^DIC",1130590010,1130590010,"%D",18,0)
access database from NewCrop accessed using parameter '1' for desiredData 
"^DIC",1130590010,1130590010,"%D",19,0)
from this webservice: 
"^DIC",1130590010,1130590010,"%D",20,0)
http://preproduction.newcropaccounts.com/V7/WebServices/Update1.asmx?op=Ge
"^DIC",1130590010,1130590010,"%D",21,0)
tMostRecentDownloadUrl
"^DIC",1130590010,1130590010,"%D",22,0)
 
"^DIC",1130590010,1130590010,"%D",23,0)
The webservice provides a URL to a zip file; when unzipped, it produces 
"^DIC",1130590010,1130590010,"%D",24,0)
an access database with tables for allergies, drugs, pharamcies, 
"^DIC",1130590010,1130590010,"%D",25,0)
healthplans, and diagnoses.
"^DIC",1130590010,1130590010,"%D",26,0)
 
"^DIC",1130590010,1130590010,"%D",27,0)
The following command (from mdb-tools) was used to extract this into an 
"^DIC",1130590010,1130590010,"%D",28,0)
RRF format (i.e. '|' delimited).
"^DIC",1130590010,1130590010,"%D",29,0)
 
"^DIC",1130590010,1130590010,"%D",30,0)
mdb-sql -HFp -d'|' -i selecttblCompositeDrug.sql  NCFull-200910.mdb > 
"^DIC",1130590010,1130590010,"%D",31,0)
Drug.rrf
"^DIC",1130590010,1130590010,"%D",32,0)
 
"^DIC",1130590010,1130590010,"%D",33,0)
The SQL was necessary to skip a word-processing field which I couldn't 
"^DIC",1130590010,1130590010,"%D",34,0)
import into fileman using the fileman import
"^DIC",1130590010,1130590010,"%D",35,0)
tool (this is simply a technical restriction; if I hand wrote my import I 
"^DIC",1130590010,1130590010,"%D",36,0)
could have used a word processing field and used WP^DIE to file it.)
"^DIC",1130590010,1130590010,"%D",37,0)
That's field's name is 'etc'.
"^DIC",1130590010,1130590010,"%D",38,0)
 
"^DIC",1130590010,1130590010,"%D",39,0)
The SQL statement is as follows:
"^DIC",1130590010,1130590010,"%D",40,0)
SELECT 
"^DIC",1130590010,1130590010,"%D",41,0)
MEDID,
"^DIC",1130590010,1130590010,"%D",42,0)
GCN_SEQNO,
"^DIC",1130590010,1130590010,"%D",43,0)
MED_NAME_ID,
"^DIC",1130590010,1130590010,"%D",44,0)
MED_NAME,
"^DIC",1130590010,1130590010,"%D",45,0)
MED_ROUTED_MED_ID_DESC,
"^DIC",1130590010,1130590010,"%D",46,0)
MED_ROUTED_DF_MED_ID_DESC,
"^DIC",1130590010,1130590010,"%D",47,0)
MED_MEDID_DESC,
"^DIC",1130590010,1130590010,"%D",48,0)
MED_STATUS_CD,
"^DIC",1130590010,1130590010,"%D",49,0)
MED_ROUTE_ID,
"^DIC",1130590010,1130590010,"%D",50,0)
ROUTED_MED_ID,
"^DIC",1130590010,1130590010,"%D",51,0)
ROUTED_DOSAGE_FORM_MED_ID,
"^DIC",1130590010,1130590010,"%D",52,0)
MED_STRENGTH,
"^DIC",1130590010,1130590010,"%D",53,0)
MED_STRENGTH_UOM,
"^DIC",1130590010,1130590010,"%D",54,0)
MED_ROUTE_ABBR,
"^DIC",1130590010,1130590010,"%D",55,0)
MED_ROUTE_DESC,
"^DIC",1130590010,1130590010,"%D",56,0)
MED_DOSAGE_FORM_ABBR,
"^DIC",1130590010,1130590010,"%D",57,0)
MED_DOSAGE_FORM_DESC,
"^DIC",1130590010,1130590010,"%D",58,0)
GenericDrugName,
"^DIC",1130590010,1130590010,"%D",59,0)
DosageFormOverride,
"^DIC",1130590010,1130590010,"%D",60,0)
MED_REF_DEA_CD,
"^DIC",1130590010,1130590010,"%D",61,0)
MED_REF_DEA_CD_DESC,
"^DIC",1130590010,1130590010,"%D",62,0)
MED_REF_MULTI_SOURCE_CD,
"^DIC",1130590010,1130590010,"%D",63,0)
MED_REF_MULTI_SOURCE_CD_DESC,
"^DIC",1130590010,1130590010,"%D",64,0)
MED_REF_GEN_DRUG_NAME_CD,
"^DIC",1130590010,1130590010,"%D",65,0)
MED_REF_GEN_DRUG_NAME_CD_DESC,
"^DIC",1130590010,1130590010,"%D",66,0)
MED_REF_FED_LEGEND_IND,
"^DIC",1130590010,1130590010,"%D",67,0)
MED_REF_FED_LEGEND_IND_DESC,
"^DIC",1130590010,1130590010,"%D",68,0)
GENERIC_MEDID,
"^DIC",1130590010,1130590010,"%D",69,0)
MED_NAME_TYPE_CD,
"^DIC",1130590010,1130590010,"%D",70,0)
GENERIC_MED_REF_GEN_DRUG_NAME_CD,
"^DIC",1130590010,1130590010,"%D",71,0)
MED_NAME_SOURCE_CD,
"^DIC",1130590010,1130590010,"%D",72,0)
DrugInfo,
"^DIC",1130590010,1130590010,"%D",73,0)
GenericDrugNameOverride,
"^DIC",1130590010,1130590010,"%D",74,0)
FormularyDrugID,
"^DIC",1130590010,1130590010,"%D",75,0)
Manufacturer,
"^DIC",1130590010,1130590010,"%D",76,0)
Status,
"^DIC",1130590010,1130590010,"%D",77,0)
TouchDate,
"^DIC",1130590010,1130590010,"%D",78,0)
DrugTypeID
"^DIC",1130590010,1130590010,"%D",79,0)
FROM
"^DIC",1130590010,1130590010,"%D",80,0)
tblCompositeDrug
"^DIC",1130590010,1130590010,"%D",81,0)
 
"^DIC",1130590010,1130590010,"%D",82,0)
The import template C0P FDB TBLCOMPOSITEDRUG is provided to import the 
"^DIC",1130590010,1130590010,"%D",83,0)
drug file. The routine C0PLOAD provides a semi-automated way of reading 
"^DIC",1130590010,1130590010,"%D",84,0)
the rrf file into the database.
"^DIC",1130590010,1130590010,"%D",85,0)
 
"^DIC",1130590010,1130590010,"%D",86,0)
The database schema is not documented. What follows is my understanding 
"^DIC",1130590010,1130590010,"%D",87,0)
of the most important fields:
"^DIC",1130590010,1130590010,"%D",88,0)
 
"^DIC",1130590010,1130590010,"%D",89,0)
  MEDID is the Unique ID of the drug/dosage form/dosage/route/brand 
"^DIC",1130590010,1130590010,"%D",90,0)
combination. Generics of the same drug get the same MEDID, but brands of 
"^DIC",1130590010,1130590010,"%D",91,0)
the same drugs get different MEDIDs.
"^DIC",1130590010,1130590010,"%D",92,0)
  GCN SEQNO is the Unique ID of the drug/dosage form/dosage/route
"^DIC",1130590010,1130590010,"%D",93,0)
As such, it's the most useful identifier in the database. This number
"^DIC",1130590010,1130590010,"%D",94,0)
corresponds to the CODE located in RxNorm for drugs from NDDF (RxNorm's
"^DIC",1130590010,1130590010,"%D",95,0)
abbreviation for First Databank).
"^DIC",1130590010,1130590010,"%D",96,0)
 
"^DIC",1130590010,1130590010,"%D",97,0)
The purpose of this file is to assist us in mapping Drug identifiers 
"^DIC",1130590010,1130590010,"%D",98,0)
received from the New Crop Web Service (which correspond to MEDID) to 
"^DIC",1130590010,1130590010,"%D",99,0)
Drugs in Vista. The Map is as follows: MEDID -> GCN SEQNO -> RXNORM CUI 
"^DIC",1130590010,1130590010,"%D",100,0)
-> VUID -> VA PRODUCT -> DRUG. This file supplies the first two pieces; 
"^DIC",1130590010,1130590010,"%D",101,0)
RxNorm supplies the second two (VUID is actually the CODE entry for the 
"^DIC",1130590010,1130590010,"%D",102,0)
drug when SAB [source abbreviation] is VANDF). We will then use the VUID 
"^DIC",1130590010,1130590010,"%D",103,0)
to look up the drug in the National Drug File VA PRODUCT, and then match 
"^DIC",1130590010,1130590010,"%D",104,0)
that IEN against the Drug File.
"^DIC",1130590010,"B","FIRST DATABANK DRUGS",1130590010)

"^DIC",1130590010.002,1130590010.002,0)
C0P RXNORM FDB VUID MAPPING^1130590010.002
"^DIC",1130590010.002,1130590010.002,0,"GL")
^C0PRXN(
"^DIC",1130590010.002,1130590010.002,"%",0)
^1.005^^0
"^DIC",1130590010.002,1130590010.002,"%D",0)
^^38^38^3120507^
"^DIC",1130590010.002,1130590010.002,"%D",1,0)
File structure License:
"^DIC",1130590010.002,1130590010.002,"%D",2,0)
Copyright 2009 George Lilly.  Licensed under the terms of the GNU
"^DIC",1130590010.002,1130590010.002,"%D",3,0)
General Public License See attached copy of the License.
"^DIC",1130590010.002,1130590010.002,"%D",4,0)
 
"^DIC",1130590010.002,1130590010.002,"%D",5,0)
This program is free software; you can redistribute it and/or modify
"^DIC",1130590010.002,1130590010.002,"%D",6,0)
it under the terms of the GNU General Public License as published by
"^DIC",1130590010.002,1130590010.002,"%D",7,0)
the Free Software Foundation; either version 2 of the License, or
"^DIC",1130590010.002,1130590010.002,"%D",8,0)
(at your option) any later version.
"^DIC",1130590010.002,1130590010.002,"%D",9,0)
 
"^DIC",1130590010.002,1130590010.002,"%D",10,0)
This program is distributed in the hope that it will be useful,
"^DIC",1130590010.002,1130590010.002,"%D",11,0)
but WITHOUT ANY WARRANTY; without even the implied warranty of
"^DIC",1130590010.002,1130590010.002,"%D",12,0)
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
"^DIC",1130590010.002,1130590010.002,"%D",13,0)
GNU General Public License for more details.
"^DIC",1130590010.002,1130590010.002,"%D",14,0)
 
"^DIC",1130590010.002,1130590010.002,"%D",15,0)
You should have received a copy of the GNU General Public License along
"^DIC",1130590010.002,1130590010.002,"%D",16,0)
with this program; if not, write to the Free Software Foundation, Inc.,
"^DIC",1130590010.002,1130590010.002,"%D",17,0)
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
"^DIC",1130590010.002,1130590010.002,"%D",18,0)
 
"^DIC",1130590010.002,1130590010.002,"%D",19,0)
File Data License:
"^DIC",1130590010.002,1130590010.002,"%D",20,0)
Data in this file is derived from copyrighted sources in RxNorm. The 
"^DIC",1130590010.002,1130590010.002,"%D",21,0)
following license applies to any users.
"^DIC",1130590010.002,1130590010.002,"%D",22,0)
 
"^DIC",1130590010.002,1130590010.002,"%D",23,0)
"Some material in the UMLS Metathesaurus is from copyrighted sources 
"^DIC",1130590010.002,1130590010.002,"%D",24,0)
of the respective copyright holders. Users of the UMLS Metathesaurus are 
"^DIC",1130590010.002,1130590010.002,"%D",25,0)
solely responsible for compliance with any copyright, patent or trademark 
"^DIC",1130590010.002,1130590010.002,"%D",26,0)
restrictions and are referred to the copyright, patent or trademark 
"^DIC",1130590010.002,1130590010.002,"%D",27,0)
notices appearing in the original sources, all of which are hereby 
"^DIC",1130590010.002,1130590010.002,"%D",28,0)
incorporated by reference."
"^DIC",1130590010.002,1130590010.002,"%D",29,0)
 
"^DIC",1130590010.002,1130590010.002,"%D",30,0)
--
"^DIC",1130590010.002,1130590010.002,"%D",31,0)
NOTE: This file is not used in C0P 1.0.
"^DIC",1130590010.002,1130590010.002,"%D",32,0)
 
"^DIC",1130590010.002,1130590010.002,"%D",33,0)
RxNorm to First Databank to VUID mapping file. Created by GPL 9/10 for
"^DIC",1130590010.002,1130590010.002,"%D",34,0)
the Oroville eRx project. RxNorm concepts are the .01 to allow for FDB 
"^DIC",1130590010.002,1130590010.002,"%D",35,0)
IDs that have no map to VUIDS and for VUIDS that have no map to FDB. 
"^DIC",1130590010.002,1130590010.002,"%D",36,0)
First version of this analysis is found in EN^C0PTRXN which uses a TMP 
"^DIC",1130590010.002,1130590010.002,"%D",37,0)
global but not fileman. This will be an improvement because we can let 
"^DIC",1130590010.002,1130590010.002,"%D",38,0)
Fileman do a lot of the work. gpl
"^DIC",1130590010.002,"B","C0P RXNORM FDB VUID MAPPING",1130590010.002)

"^DIC",1130590011.001,1130590011.001,0)
RXNORM CONCEPTS C0P^1130590011.001
"^DIC",1130590011.001,1130590011.001,0,"GL")
^C0P("RXN",
"^DIC",1130590011.001,1130590011.001,"%",0)
^1.005^^0
"^DIC",1130590011.001,1130590011.001,"%D",0)
^^90^90^3120508^
"^DIC",1130590011.001,1130590011.001,"%D",1,0)
Licensing:
"^DIC",1130590011.001,1130590011.001,"%D",2,0)
 
"^DIC",1130590011.001,1130590011.001,"%D",3,0)
RxNorm File Structure is Public Domain; however,
"^DIC",1130590011.001,1130590011.001,"%D",4,0)
 
"^DIC",1130590011.001,1130590011.001,"%D",5,0)
Per NLM RxNorm License Agreement, users of this file must comply with the 
"^DIC",1130590011.001,1130590011.001,"%D",6,0)
following.
"^DIC",1130590011.001,1130590011.001,"%D",7,0)
 
"^DIC",1130590011.001,1130590011.001,"%D",8,0)
    "Some material in the UMLS Metathesaurus is from copyrighted sources 
"^DIC",1130590011.001,1130590011.001,"%D",9,0)
of the respective copyright holders. Users of the UMLS Metathesaurus are 
"^DIC",1130590011.001,1130590011.001,"%D",10,0)
solely responsible for compliance with any copyright, patent or trademark 
"^DIC",1130590011.001,1130590011.001,"%D",11,0)
restrictions and are referred to the copyright, patent or trademark 
"^DIC",1130590011.001,1130590011.001,"%D",12,0)
notices appearing in the original sources, all of which are hereby 
"^DIC",1130590011.001,1130590011.001,"%D",13,0)
incorporated by reference."
"^DIC",1130590011.001,1130590011.001,"%D",14,0)
 
"^DIC",1130590011.001,1130590011.001,"%D",15,0)
You need a license from First Databank or its licensees (e.g. New Crop 
"^DIC",1130590011.001,1130590011.001,"%D",16,0)
e-Prescribing Service) to user this file.
"^DIC",1130590011.001,1130590011.001,"%D",17,0)
 
"^DIC",1130590011.001,1130590011.001,"%D",18,0)
---
"^DIC",1130590011.001,1130590011.001,"%D",19,0)
 
"^DIC",1130590011.001,1130590011.001,"%D",20,0)
This file is the result of the import of selected fields from the RxNorm 
"^DIC",1130590011.001,1130590011.001,"%D",21,0)
database Concepts file (RXNCONSO.RRF). The ones with "*" are included in 
"^DIC",1130590011.001,1130590011.001,"%D",22,0)
this file.
"^DIC",1130590011.001,1130590011.001,"%D",23,0)
 
"^DIC",1130590011.001,1130590011.001,"%D",24,0)
        Col.    Description
"^DIC",1130590011.001,1130590011.001,"%D",25,0)
       *RXCUI   RxNorm Unique identifier for concept (concept ID)
"^DIC",1130590011.001,1130590011.001,"%D",26,0)
        LAT     Language of Term
"^DIC",1130590011.001,1130590011.001,"%D",27,0)
        TS      Term status
"^DIC",1130590011.001,1130590011.001,"%D",28,0)
        LUI     Unique identifier for term (no value provided)
"^DIC",1130590011.001,1130590011.001,"%D",29,0)
        STT     String type
"^DIC",1130590011.001,1130590011.001,"%D",30,0)
        SUI     Unique identifier for string (no value provided)
"^DIC",1130590011.001,1130590011.001,"%D",31,0)
        ISPREF  Atom status - preferred (Y) or not (N) for this string 
"^DIC",1130590011.001,1130590011.001,"%D",32,0)
within this concept
"^DIC",1130590011.001,1130590011.001,"%D",33,0)
       *RXAUI   Unique identifier for atom (RxNorm Atom ID)
"^DIC",1130590011.001,1130590011.001,"%D",34,0)
        SAUI    Source asserted atom identifier [optional]
"^DIC",1130590011.001,1130590011.001,"%D",35,0)
        SCUI    Source asserted concept identifier [optional]
"^DIC",1130590011.001,1130590011.001,"%D",36,0)
        SDUI    Source asserted descriptor identifier [optional] (no 
"^DIC",1130590011.001,1130590011.001,"%D",37,0)
value provided)
"^DIC",1130590011.001,1130590011.001,"%D",38,0)
       *SAB     Source abbreviation
"^DIC",1130590011.001,1130590011.001,"%D",39,0)
       *TTY     Term type in source
"^DIC",1130590011.001,1130590011.001,"%D",40,0)
       *CODE    "Most useful" source asserted identifier (if the source 
"^DIC",1130590011.001,1130590011.001,"%D",41,0)
vocabulary has more than one identifier), or a Metathesaurus-generated 
"^DIC",1130590011.001,1130590011.001,"%D",42,0)
source entry identifier (if the source vocabulary has none.)
"^DIC",1130590011.001,1130590011.001,"%D",43,0)
       *STR     String
"^DIC",1130590011.001,1130590011.001,"%D",44,0)
        SRL     Source Restriction Level (no value provided)
"^DIC",1130590011.001,1130590011.001,"%D",45,0)
        SUPPRESS        Suppressible flag. Values = E, Y, N, or O. E - 
"^DIC",1130590011.001,1130590011.001,"%D",46,0)
Specific Individual names (atoms ) set as suppressible by Metathesaurus 
"^DIC",1130590011.001,1130590011.001,"%D",47,0)
editors. These names were determined to lack face validity and are likely 
"^DIC",1130590011.001,1130590011.001,"%D",48,0)
to be harmful in most applications. Y - Currently suppressible by Source 
"^DIC",1130590011.001,1130590011.001,"%D",49,0)
and Term Type(SAB/TTY), as set in MetamorphoSys at the Suppressibility 
"^DIC",1130590011.001,1130590011.001,"%D",50,0)
Tab. The default SAB/TTY selections have been identified as unlikely to 
"^DIC",1130590011.001,1130590011.001,"%D",51,0)
be useful in most applications. N - not suppressible Default 
"^DIC",1130590011.001,1130590011.001,"%D",52,0)
suppressibility as determined by NLM (i.e., no changes at the 
"^DIC",1130590011.001,1130590011.001,"%D",53,0)
Suppressibility tab in MetamorphoSys) should be used by most users, but 
"^DIC",1130590011.001,1130590011.001,"%D",54,0)
may not be suitable in some specialized applications. O - Specific 
"^DIC",1130590011.001,1130590011.001,"%D",55,0)
Individual names (atoms) set as Obsolete because the name is no longer 
"^DIC",1130590011.001,1130590011.001,"%D",56,0)
provided by the original source. See the MetamorphoSys documentation 
"^DIC",1130590011.001,1130590011.001,"%D",57,0)
(Section 6) for information on how to change the SAB/TTY suppressibility 
"^DIC",1130590011.001,1130590011.001,"%D",58,0)
to suit your requirements. NLM strongly recommends that users not alter 
"^DIC",1130590011.001,1130590011.001,"%D",59,0)
editor-assigned suppressibility, and MetamorphoSys cannot be used for 
"^DIC",1130590011.001,1130590011.001,"%D",60,0)
this purpose.
"^DIC",1130590011.001,1130590011.001,"%D",61,0)
        CVF     Content view flag
"^DIC",1130590011.001,1130590011.001,"%D",62,0)
 
"^DIC",1130590011.001,1130590011.001,"%D",63,0)
RxNorm can be found at http://www.nlm.nih.gov/research/umls/rxnorm/
"^DIC",1130590011.001,1130590011.001,"%D",64,0)
 
"^DIC",1130590011.001,1130590011.001,"%D",65,0)
RxNorm is updated weekly.
"^DIC",1130590011.001,1130590011.001,"%D",66,0)
 
"^DIC",1130590011.001,1130590011.001,"%D",67,0)
This file is part of the eRx project for Vista. It was imported by SMH in 
"^DIC",1130590011.001,1130590011.001,"%D",68,0)
December 2009.
"^DIC",1130590011.001,1130590011.001,"%D",69,0)
 
"^DIC",1130590011.001,1130590011.001,"%D",70,0)
The purpose of this file is to provide mapping support from First 
"^DIC",1130590011.001,1130590011.001,"%D",71,0)
Databank Drugs to Vista and to provide canonical entries for medications 
"^DIC",1130590011.001,1130590011.001,"%D",72,0)
to be e-Prescribed.
"^DIC",1130590011.001,1130590011.001,"%D",73,0)
 
"^DIC",1130590011.001,1130590011.001,"%D",74,0)
Instructions for importing the file from an NLM Release.
"^DIC",1130590011.001,1130590011.001,"%D",75,0)
1. Get the full RxNorm release from NLM. You need to register with them to
"^DIC",1130590011.001,1130590011.001,"%D",76,0)
do that. This is going to be a zip file.
"^DIC",1130590011.001,1130590011.001,"%D",77,0)
2. Unzip the file.
"^DIC",1130590011.001,1130590011.001,"%D",78,0)
3. Get the complete path to the location of the concepts file in the 
"^DIC",1130590011.001,1130590011.001,"%D",79,0)
rrf folder (one of the folders there). I typically naviagate there and
"^DIC",1130590011.001,1130590011.001,"%D",80,0)
then execute ls $PWD/RXNCONSO.RRF. 
"^DIC",1130590011.001,1130590011.001,"%D",81,0)
4. Execute the following: DO RXNIMP^C0PLOAD. You will be prompted for the 
"^DIC",1130590011.001,1130590011.001,"%D",82,0)
full path of the file; after which deletion and loading of new data 
"^DIC",1130590011.001,1130590011.001,"%D",83,0)
commences.
"^DIC",1130590011.001,1130590011.001,"%D",84,0)
 
"^DIC",1130590011.001,1130590011.001,"%D",85,0)
This program does the following:
"^DIC",1130590011.001,1130590011.001,"%D",86,0)
- Delete The current entries in the File 
"^DIC",1130590011.001,1130590011.001,"%D",87,0)
- Read the file the entries from the new rrf file.
"^DIC",1130590011.001,1130590011.001,"%D",88,0)
 
"^DIC",1130590011.001,1130590011.001,"%D",89,0)
**NOTE: It takes more than an hour to import the file.
"^DIC",1130590011.001,1130590011.001,"%D",90,0)
You will see the progress on your screen**
"^DIC",1130590011.001,"B","RXNORM CONCEPTS C0P",1130590011.001)

**END**
**END**