11223 lines
348 KiB
Genshi
11223 lines
348 KiB
Genshi
KIDS Distribution saved on Nov 19, 2008@15:53:51
|
||
Labs, alerts and non-VA meds
|
||
**KIDS**:CCR*1.0*7^
|
||
|
||
**INSTALL NAME**
|
||
CCR*1.0*7
|
||
"BLD",6955,0)
|
||
CCR*1.0*7^^0^3081119^n
|
||
"BLD",6955,1,0)
|
||
^^23^23^3080923^
|
||
"BLD",6955,1,1,0)
|
||
|
||
"BLD",6955,1,2,0)
|
||
CCR AND CCD EXPORT TOOLS
|
||
"BLD",6955,1,3,0)
|
||
|
||
"BLD",6955,1,4,0)
|
||
SINGLE XML EXPORT TO A HOST DIRECTORY AT
|
||
"BLD",6955,1,5,0)
|
||
|
||
"BLD",6955,1,6,0)
|
||
BE SURE TO SET ^TMP("GPLCCR","ODIR")="DIRECTORYNAME" TO AN EXISTING
|
||
"BLD",6955,1,7,0)
|
||
DIRECTORY
|
||
"BLD",6955,1,8,0)
|
||
|
||
"BLD",6955,1,9,0)
|
||
EXPORT^GPLCRR FOR THE CCR
|
||
"BLD",6955,1,10,0)
|
||
EXPORT^GPLCCD FOR THE CCD
|
||
"BLD",6955,1,11,0)
|
||
XPAT^GPLCCR(DFN,"","")
|
||
"BLD",6955,1,12,0)
|
||
|
||
"BLD",6955,1,13,0)
|
||
BATCH ANALYSIS AND BATCH EXPORT BY RIM CATEGORIES
|
||
"BLD",6955,1,14,0)
|
||
|
||
"BLD",6955,1,15,0)
|
||
ANALYZE^GPLRIMA("",5000) TO ANALYZE 5000 PATIENTS. REPEAT TO RESUME
|
||
"BLD",6955,1,16,0)
|
||
RESET^GPLRIMA TO RESET ANALYZE - DELETES ^TMP("GPLRIM","RESUME")
|
||
"BLD",6955,1,17,0)
|
||
ANALYZE^GPLRIMA(5098,1) TO ANALYZE PATIENT 5098 FOR ONE PATIENT
|
||
"BLD",6955,1,18,0)
|
||
|
||
"BLD",6955,1,19,0)
|
||
CLIST^GPLRIMA TO LIST CATEGORY TOTALS
|
||
"BLD",6955,1,20,0)
|
||
CPAT^GPLRIMA("RIMTBL_X") TO LIST PATIENTS IN A CATEGORY
|
||
"BLD",6955,1,21,0)
|
||
XCPAT^GPLRIMA("RIMTBL_X") TO EXPORT CCR FOR ALL PATIENTS IN CATEGORY
|
||
"BLD",6955,1,22,0)
|
||
|
||
"BLD",6955,1,23,0)
|
||
TEST^GPLCCR AND TEST^GPLXPATH RUN UNIT TESTS ON THE CODE
|
||
"BLD",6955,4,0)
|
||
^9.64PA^^
|
||
"BLD",6955,6.3)
|
||
15
|
||
"BLD",6955,"KRN",0)
|
||
^9.67PA^8989.52^19
|
||
"BLD",6955,"KRN",.4,0)
|
||
.4
|
||
"BLD",6955,"KRN",.401,0)
|
||
.401
|
||
"BLD",6955,"KRN",.402,0)
|
||
.402
|
||
"BLD",6955,"KRN",.403,0)
|
||
.403
|
||
"BLD",6955,"KRN",.5,0)
|
||
.5
|
||
"BLD",6955,"KRN",.84,0)
|
||
.84
|
||
"BLD",6955,"KRN",3.6,0)
|
||
3.6
|
||
"BLD",6955,"KRN",3.8,0)
|
||
3.8
|
||
"BLD",6955,"KRN",9.2,0)
|
||
9.2
|
||
"BLD",6955,"KRN",9.8,0)
|
||
9.8
|
||
"BLD",6955,"KRN",9.8,"NM",0)
|
||
^9.68A^24^24
|
||
"BLD",6955,"KRN",9.8,"NM",1,0)
|
||
CCRDPT^^0^B45805995
|
||
"BLD",6955,"KRN",9.8,"NM",2,0)
|
||
CCRDPTT^^0^B4791589
|
||
"BLD",6955,"KRN",9.8,"NM",3,0)
|
||
CCRMEDS^^0^B68553972
|
||
"BLD",6955,"KRN",9.8,"NM",4,0)
|
||
CCRSYS^^0^B5866233
|
||
"BLD",6955,"KRN",9.8,"NM",5,0)
|
||
CCRUNIT^^0^B8574
|
||
"BLD",6955,"KRN",9.8,"NM",6,0)
|
||
CCRUTIL^^0^B12964247
|
||
"BLD",6955,"KRN",9.8,"NM",7,0)
|
||
CCRVA200^^0^B35847405
|
||
"BLD",6955,"KRN",9.8,"NM",8,0)
|
||
GPLCCD^^0^B114413975
|
||
"BLD",6955,"KRN",9.8,"NM",9,0)
|
||
GPLXPATH^^0^B255658739
|
||
"BLD",6955,"KRN",9.8,"NM",10,0)
|
||
CCRMEDS1^^0^B80043311
|
||
"BLD",6955,"KRN",9.8,"NM",11,0)
|
||
CCRMEDS2^^0^B104632066
|
||
"BLD",6955,"KRN",9.8,"NM",12,0)
|
||
GPLUNIT^^0^B31452964
|
||
"BLD",6955,"KRN",9.8,"NM",13,0)
|
||
GPLCCR^^0^B81638593
|
||
"BLD",6955,"KRN",9.8,"NM",14,0)
|
||
GPLCCR0^^0^B555785104
|
||
"BLD",6955,"KRN",9.8,"NM",15,0)
|
||
GPLCCD1^^0^B100039732
|
||
"BLD",6955,"KRN",9.8,"NM",16,0)
|
||
GPLACTOR^^0^B57497934
|
||
"BLD",6955,"KRN",9.8,"NM",17,0)
|
||
GPLVITAL^^0^B82628966
|
||
"BLD",6955,"KRN",9.8,"NM",18,0)
|
||
GPLRIMA^^0^B244980714
|
||
"BLD",6955,"KRN",9.8,"NM",19,0)
|
||
GPLALERT^^0^B21981592
|
||
"BLD",6955,"KRN",9.8,"NM",20,0)
|
||
GPLPROBS^^0^B25875394
|
||
"BLD",6955,"KRN",9.8,"NM",21,0)
|
||
GPLXPAT0^^0^B51026779
|
||
"BLD",6955,"KRN",9.8,"NM",22,0)
|
||
GPLLABS^^0^B221616742
|
||
"BLD",6955,"KRN",9.8,"NM",23,0)
|
||
LA7QRY1^^0^B12511401
|
||
"BLD",6955,"KRN",9.8,"NM",24,0)
|
||
CCRMEDS3^^0^B68176928
|
||
"BLD",6955,"KRN",9.8,"NM","B","CCRDPT",1)
|
||
|
||
"BLD",6955,"KRN",9.8,"NM","B","CCRDPTT",2)
|
||
|
||
"BLD",6955,"KRN",9.8,"NM","B","CCRMEDS",3)
|
||
|
||
"BLD",6955,"KRN",9.8,"NM","B","CCRMEDS1",10)
|
||
|
||
"BLD",6955,"KRN",9.8,"NM","B","CCRMEDS2",11)
|
||
|
||
"BLD",6955,"KRN",9.8,"NM","B","CCRMEDS3",24)
|
||
|
||
"BLD",6955,"KRN",9.8,"NM","B","CCRSYS",4)
|
||
|
||
"BLD",6955,"KRN",9.8,"NM","B","CCRUNIT",5)
|
||
|
||
"BLD",6955,"KRN",9.8,"NM","B","CCRUTIL",6)
|
||
|
||
"BLD",6955,"KRN",9.8,"NM","B","CCRVA200",7)
|
||
|
||
"BLD",6955,"KRN",9.8,"NM","B","GPLACTOR",16)
|
||
|
||
"BLD",6955,"KRN",9.8,"NM","B","GPLALERT",19)
|
||
|
||
"BLD",6955,"KRN",9.8,"NM","B","GPLCCD",8)
|
||
|
||
"BLD",6955,"KRN",9.8,"NM","B","GPLCCD1",15)
|
||
|
||
"BLD",6955,"KRN",9.8,"NM","B","GPLCCR",13)
|
||
|
||
"BLD",6955,"KRN",9.8,"NM","B","GPLCCR0",14)
|
||
|
||
"BLD",6955,"KRN",9.8,"NM","B","GPLLABS",22)
|
||
|
||
"BLD",6955,"KRN",9.8,"NM","B","GPLPROBS",20)
|
||
|
||
"BLD",6955,"KRN",9.8,"NM","B","GPLRIMA",18)
|
||
|
||
"BLD",6955,"KRN",9.8,"NM","B","GPLUNIT",12)
|
||
|
||
"BLD",6955,"KRN",9.8,"NM","B","GPLVITAL",17)
|
||
|
||
"BLD",6955,"KRN",9.8,"NM","B","GPLXPAT0",21)
|
||
|
||
"BLD",6955,"KRN",9.8,"NM","B","GPLXPATH",9)
|
||
|
||
"BLD",6955,"KRN",9.8,"NM","B","LA7QRY1",23)
|
||
|
||
"BLD",6955,"KRN",19,0)
|
||
19
|
||
"BLD",6955,"KRN",19,"NM",0)
|
||
^9.68A^^
|
||
"BLD",6955,"KRN",19.1,0)
|
||
19.1
|
||
"BLD",6955,"KRN",101,0)
|
||
101
|
||
"BLD",6955,"KRN",409.61,0)
|
||
409.61
|
||
"BLD",6955,"KRN",771,0)
|
||
771
|
||
"BLD",6955,"KRN",870,0)
|
||
870
|
||
"BLD",6955,"KRN",8989.51,0)
|
||
8989.51
|
||
"BLD",6955,"KRN",8989.52,0)
|
||
8989.52
|
||
"BLD",6955,"KRN",8994,0)
|
||
8994
|
||
"BLD",6955,"KRN","B",.4,.4)
|
||
|
||
"BLD",6955,"KRN","B",.401,.401)
|
||
|
||
"BLD",6955,"KRN","B",.402,.402)
|
||
|
||
"BLD",6955,"KRN","B",.403,.403)
|
||
|
||
"BLD",6955,"KRN","B",.5,.5)
|
||
|
||
"BLD",6955,"KRN","B",.84,.84)
|
||
|
||
"BLD",6955,"KRN","B",3.6,3.6)
|
||
|
||
"BLD",6955,"KRN","B",3.8,3.8)
|
||
|
||
"BLD",6955,"KRN","B",9.2,9.2)
|
||
|
||
"BLD",6955,"KRN","B",9.8,9.8)
|
||
|
||
"BLD",6955,"KRN","B",19,19)
|
||
|
||
"BLD",6955,"KRN","B",19.1,19.1)
|
||
|
||
"BLD",6955,"KRN","B",101,101)
|
||
|
||
"BLD",6955,"KRN","B",409.61,409.61)
|
||
|
||
"BLD",6955,"KRN","B",771,771)
|
||
|
||
"BLD",6955,"KRN","B",870,870)
|
||
|
||
"BLD",6955,"KRN","B",8989.51,8989.51)
|
||
|
||
"BLD",6955,"KRN","B",8989.52,8989.52)
|
||
|
||
"BLD",6955,"KRN","B",8994,8994)
|
||
|
||
"BLD",6955,"QUES",0)
|
||
^9.62^^
|
||
"BLD",6955,"REQB",0)
|
||
^9.611^^
|
||
"MBREQ")
|
||
0
|
||
"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")
|
||
24
|
||
"RTN","CCRDPT")
|
||
0^1^B45805995
|
||
"RTN","CCRDPT",1,0)
|
||
CCRDPT ;WV/CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
|
||
"RTN","CCRDPT",2,0)
|
||
;;0.2;CCRCCD;;Jun 15, 2008;Build 15
|
||
"RTN","CCRDPT",3,0)
|
||
;
|
||
"RTN","CCRDPT",4,0)
|
||
; Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
||
"RTN","CCRDPT",5,0)
|
||
; General Public License.
|
||
"RTN","CCRDPT",6,0)
|
||
;
|
||
"RTN","CCRDPT",7,0)
|
||
; This program is distributed in the hope that it will be useful,
|
||
"RTN","CCRDPT",8,0)
|
||
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
"RTN","CCRDPT",9,0)
|
||
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
"RTN","CCRDPT",10,0)
|
||
; GNU General Public License for more details.
|
||
"RTN","CCRDPT",11,0)
|
||
;
|
||
"RTN","CCRDPT",12,0)
|
||
; You should have received a copy of the GNU General Public License along
|
||
"RTN","CCRDPT",13,0)
|
||
; with this program; if not, write to the Free Software Foundation, Inc.,
|
||
"RTN","CCRDPT",14,0)
|
||
; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
||
"RTN","CCRDPT",15,0)
|
||
;
|
||
"RTN","CCRDPT",16,0)
|
||
; CCRDPT CCRCCD/SMH - Routines to Extract Patient Data for
|
||
"RTN","CCRDPT",17,0)
|
||
; FAMILY Family Name
|
||
"RTN","CCRDPT",18,0)
|
||
; GIVEN Given Name
|
||
"RTN","CCRDPT",19,0)
|
||
; MIDDLE Middle Name
|
||
"RTN","CCRDPT",20,0)
|
||
; SUFFIX Suffix Name
|
||
"RTN","CCRDPT",21,0)
|
||
; DISPNAME Display Name
|
||
"RTN","CCRDPT",22,0)
|
||
; DOB Date of Birth
|
||
"RTN","CCRDPT",23,0)
|
||
; GENDER Get Gender
|
||
"RTN","CCRDPT",24,0)
|
||
; SSN Get SSN for ID
|
||
"RTN","CCRDPT",25,0)
|
||
; ADDRTYPE Get Home Address
|
||
"RTN","CCRDPT",26,0)
|
||
; ADDR1 Get Home Address line 1
|
||
"RTN","CCRDPT",27,0)
|
||
; ADDR2 Get Home Address line 2
|
||
"RTN","CCRDPT",28,0)
|
||
; CITY Get City for Home Address
|
||
"RTN","CCRDPT",29,0)
|
||
; STATE Get State for Home Address
|
||
"RTN","CCRDPT",30,0)
|
||
; ZIP Get Zip code for Home Address
|
||
"RTN","CCRDPT",31,0)
|
||
; COUNTY Get County for our Address
|
||
"RTN","CCRDPT",32,0)
|
||
; COUNTRY Get Country for our Address
|
||
"RTN","CCRDPT",33,0)
|
||
; RESTEL Residential Telephone
|
||
"RTN","CCRDPT",34,0)
|
||
; WORKTEL Work Telephone
|
||
"RTN","CCRDPT",35,0)
|
||
; EMAIL Email Adddress
|
||
"RTN","CCRDPT",36,0)
|
||
; CELLTEL Cell Phone
|
||
"RTN","CCRDPT",37,0)
|
||
; NOK1FAM Next of Kin 1 (NOK1) Family Name
|
||
"RTN","CCRDPT",38,0)
|
||
; NOK1GIV NOK1 Given Name
|
||
"RTN","CCRDPT",39,0)
|
||
; NOK1MID NOK1 Middle Name
|
||
"RTN","CCRDPT",40,0)
|
||
; NOK1SUF NOK1 Suffi Name
|
||
"RTN","CCRDPT",41,0)
|
||
; NOK1DISP NOK1 Display Name
|
||
"RTN","CCRDPT",42,0)
|
||
; NOK1REL NOK1 Relationship to the patient
|
||
"RTN","CCRDPT",43,0)
|
||
; NOK1ADD1 NOK1 Address 1
|
||
"RTN","CCRDPT",44,0)
|
||
; NOK1ADD2 NOK1 Address 2
|
||
"RTN","CCRDPT",45,0)
|
||
; NOK1CITY NOK1 City
|
||
"RTN","CCRDPT",46,0)
|
||
; NOK1STAT NOK1 State
|
||
"RTN","CCRDPT",47,0)
|
||
; NOK1ZIP NOK1 Zip Code
|
||
"RTN","CCRDPT",48,0)
|
||
; NOK1HTEL NOK1 Home Telephone
|
||
"RTN","CCRDPT",49,0)
|
||
; NOK1WTEL NOK1 Work Telephone
|
||
"RTN","CCRDPT",50,0)
|
||
; NOK1SAME Is NOK1's Address the same the patient?
|
||
"RTN","CCRDPT",51,0)
|
||
; NOK2FAM NOK2 Family Name
|
||
"RTN","CCRDPT",52,0)
|
||
; NOK2GIV NOK2 Given Name
|
||
"RTN","CCRDPT",53,0)
|
||
; NOK2MID NOK2 Middle Name
|
||
"RTN","CCRDPT",54,0)
|
||
; NOK2SUF NOK2 Suffi Name
|
||
"RTN","CCRDPT",55,0)
|
||
; NOK2DISP NOK2 Display Name
|
||
"RTN","CCRDPT",56,0)
|
||
; NOK2REL NOK2 Relationship to the patient
|
||
"RTN","CCRDPT",57,0)
|
||
; NOK2ADD1 NOK2 Address 1
|
||
"RTN","CCRDPT",58,0)
|
||
; NOK2ADD2 NOK2 Address 2
|
||
"RTN","CCRDPT",59,0)
|
||
; NOK2CITY NOK2 City
|
||
"RTN","CCRDPT",60,0)
|
||
; NOK2STAT NOK2 State
|
||
"RTN","CCRDPT",61,0)
|
||
; NOK2ZIP NOK2 Zip Code
|
||
"RTN","CCRDPT",62,0)
|
||
; NOK2HTEL NOK2 Home Telephone
|
||
"RTN","CCRDPT",63,0)
|
||
; NOK2WTEL NOK2 Work Telephone
|
||
"RTN","CCRDPT",64,0)
|
||
; NOK2SAME Is NOK2's Address the same the patient?
|
||
"RTN","CCRDPT",65,0)
|
||
; EMERFAM Emergency Contact (EMER) Family Name
|
||
"RTN","CCRDPT",66,0)
|
||
; EMERGIV EMER Given Name
|
||
"RTN","CCRDPT",67,0)
|
||
; EMERMID EMER Middle Name
|
||
"RTN","CCRDPT",68,0)
|
||
; EMERSUF EMER Suffi Name
|
||
"RTN","CCRDPT",69,0)
|
||
; EMERDISP EMER Display Name
|
||
"RTN","CCRDPT",70,0)
|
||
; EMERREL EMER Relationship to the patient
|
||
"RTN","CCRDPT",71,0)
|
||
; EMERADD1 EMER Address 1
|
||
"RTN","CCRDPT",72,0)
|
||
; EMERADD2 EMER Address 2
|
||
"RTN","CCRDPT",73,0)
|
||
; EMERCITY EMER City
|
||
"RTN","CCRDPT",74,0)
|
||
; EMERSTAT EMER State
|
||
"RTN","CCRDPT",75,0)
|
||
; EMERZIP EMER Zip Code
|
||
"RTN","CCRDPT",76,0)
|
||
; EMERHTEL EMER Home Telephone
|
||
"RTN","CCRDPT",77,0)
|
||
; EMERWTEL EMER Work Telephone
|
||
"RTN","CCRDPT",78,0)
|
||
; EMERSAME Is EMER's Address the same the NOK?
|
||
"RTN","CCRDPT",79,0)
|
||
;
|
||
"RTN","CCRDPT",80,0)
|
||
W "No Entry at top!" Q
|
||
"RTN","CCRDPT",81,0)
|
||
;
|
||
"RTN","CCRDPT",82,0)
|
||
;**Revision History**
|
||
"RTN","CCRDPT",83,0)
|
||
; - June 15, 08: v0.1 using merged global
|
||
"RTN","CCRDPT",84,0)
|
||
; - Oct 3, 08: v0.2 using fileman calls, many formatting changes.
|
||
"RTN","CCRDPT",85,0)
|
||
;
|
||
"RTN","CCRDPT",86,0)
|
||
; All methods are Public and Extrinsic
|
||
"RTN","CCRDPT",87,0)
|
||
; All calls use Fileman file 2 (Patient).
|
||
"RTN","CCRDPT",88,0)
|
||
; You can obtain field numbers using the data dictionary
|
||
"RTN","CCRDPT",89,0)
|
||
;
|
||
"RTN","CCRDPT",90,0)
|
||
FAMILY(DFN) ; Family Name
|
||
"RTN","CCRDPT",91,0)
|
||
N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
|
||
"RTN","CCRDPT",92,0)
|
||
D NAMECOMP^XLFNAME(.NAME)
|
||
"RTN","CCRDPT",93,0)
|
||
Q NAME("FAMILY")
|
||
"RTN","CCRDPT",94,0)
|
||
GIVEN(DFN) ; Given Name
|
||
"RTN","CCRDPT",95,0)
|
||
N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
|
||
"RTN","CCRDPT",96,0)
|
||
D NAMECOMP^XLFNAME(.NAME)
|
||
"RTN","CCRDPT",97,0)
|
||
Q NAME("GIVEN")
|
||
"RTN","CCRDPT",98,0)
|
||
MIDDLE(DFN) ; Middle Name
|
||
"RTN","CCRDPT",99,0)
|
||
N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
|
||
"RTN","CCRDPT",100,0)
|
||
D NAMECOMP^XLFNAME(.NAME)
|
||
"RTN","CCRDPT",101,0)
|
||
Q NAME("MIDDLE")
|
||
"RTN","CCRDPT",102,0)
|
||
SUFFIX(DFN) ; Suffi Name
|
||
"RTN","CCRDPT",103,0)
|
||
N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
|
||
"RTN","CCRDPT",104,0)
|
||
D NAMECOMP^XLFNAME(.NAME)
|
||
"RTN","CCRDPT",105,0)
|
||
Q NAME("SUFFIX")
|
||
"RTN","CCRDPT",106,0)
|
||
DISPNAME(DFN) ; Display Name
|
||
"RTN","CCRDPT",107,0)
|
||
N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
|
||
"RTN","CCRDPT",108,0)
|
||
; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
|
||
"RTN","CCRDPT",109,0)
|
||
Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
|
||
"RTN","CCRDPT",110,0)
|
||
DOB(DFN) ; Date of Birth
|
||
"RTN","CCRDPT",111,0)
|
||
N DOB S DOB=$$GET1^DIQ(2,DFN,.03,"I")
|
||
"RTN","CCRDPT",112,0)
|
||
; Date in FM Date Format. Convert to UTC/ISO 8601.
|
||
"RTN","CCRDPT",113,0)
|
||
Q $$FMDTOUTC^CCRUTIL(DOB,"D")
|
||
"RTN","CCRDPT",114,0)
|
||
GENDER(DFN) ; Gender/Sex
|
||
"RTN","CCRDPT",115,0)
|
||
Q $$GET1^DIQ(2,DFN,.02) ;
|
||
"RTN","CCRDPT",116,0)
|
||
SSN(DFN) ; SSN
|
||
"RTN","CCRDPT",117,0)
|
||
Q $$GET1^DIQ(2,DFN,.09)
|
||
"RTN","CCRDPT",118,0)
|
||
ADDRTYPE(DFN) ; Address Type
|
||
"RTN","CCRDPT",119,0)
|
||
; Vista only stores a home address for the patient.
|
||
"RTN","CCRDPT",120,0)
|
||
Q "Home"
|
||
"RTN","CCRDPT",121,0)
|
||
ADDR1(DFN) ; Get Home Address line 1
|
||
"RTN","CCRDPT",122,0)
|
||
Q $$GET1^DIQ(2,DFN,.111)
|
||
"RTN","CCRDPT",123,0)
|
||
ADDR2(DFN) ; Get Home Address line 2
|
||
"RTN","CCRDPT",124,0)
|
||
; Vista has Lines 2,3; CCR has only line 1,2; so compromise
|
||
"RTN","CCRDPT",125,0)
|
||
N ADDLN2,ADDLN3
|
||
"RTN","CCRDPT",126,0)
|
||
S ADDLN2=$$GET1^DIQ(2,DFN,.112),ADDLN3=$$GET1^DIQ(2,DFN,.113)
|
||
"RTN","CCRDPT",127,0)
|
||
Q:ADDLN3="" ADDLN2
|
||
"RTN","CCRDPT",128,0)
|
||
Q ADDLN2_", "_ADDLN3
|
||
"RTN","CCRDPT",129,0)
|
||
CITY(DFN) ; Get City for Home Address
|
||
"RTN","CCRDPT",130,0)
|
||
Q $$GET1^DIQ(2,DFN,.114)
|
||
"RTN","CCRDPT",131,0)
|
||
STATE(DFN) ; Get State for Home Address
|
||
"RTN","CCRDPT",132,0)
|
||
Q $$GET1^DIQ(2,DFN,.115)
|
||
"RTN","CCRDPT",133,0)
|
||
ZIP(DFN) ; Get Zip code for Home Address
|
||
"RTN","CCRDPT",134,0)
|
||
Q $$GET1^DIQ(2,DFN,.116)
|
||
"RTN","CCRDPT",135,0)
|
||
COUNTY(DFN) ; Get County for our Address
|
||
"RTN","CCRDPT",136,0)
|
||
Q $$GET1^DIQ(2,DFN,.117)
|
||
"RTN","CCRDPT",137,0)
|
||
COUNTRY(DFN) ; Get Country for our Address
|
||
"RTN","CCRDPT",138,0)
|
||
; Unfortunately, it's not stored anywhere in Vista, so the inevitable...
|
||
"RTN","CCRDPT",139,0)
|
||
Q "USA"
|
||
"RTN","CCRDPT",140,0)
|
||
RESTEL(DFN) ; Residential Telephone
|
||
"RTN","CCRDPT",141,0)
|
||
Q $$GET1^DIQ(2,DFN,.131)
|
||
"RTN","CCRDPT",142,0)
|
||
WORKTEL(DFN) ; Work Telephone
|
||
"RTN","CCRDPT",143,0)
|
||
Q $$GET1^DIQ(2,DFN,.132)
|
||
"RTN","CCRDPT",144,0)
|
||
EMAIL(DFN) ; Email Adddress
|
||
"RTN","CCRDPT",145,0)
|
||
Q $$GET1^DIQ(2,DFN,.133)
|
||
"RTN","CCRDPT",146,0)
|
||
CELLTEL(DFN) ; Cell Phone
|
||
"RTN","CCRDPT",147,0)
|
||
Q $$GET1^DIQ(2,DFN,.134)
|
||
"RTN","CCRDPT",148,0)
|
||
NOK1FAM(DFN) ; Next of Kin 1 (NOK1) Family Name
|
||
"RTN","CCRDPT",149,0)
|
||
N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
|
||
"RTN","CCRDPT",150,0)
|
||
D NAMECOMP^XLFNAME(.NAME)
|
||
"RTN","CCRDPT",151,0)
|
||
Q NAME("FAMILY")
|
||
"RTN","CCRDPT",152,0)
|
||
NOK1GIV(DFN) ; NOK1 Given Name
|
||
"RTN","CCRDPT",153,0)
|
||
N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
|
||
"RTN","CCRDPT",154,0)
|
||
D NAMECOMP^XLFNAME(.NAME)
|
||
"RTN","CCRDPT",155,0)
|
||
Q NAME("GIVEN")
|
||
"RTN","CCRDPT",156,0)
|
||
NOK1MID(DFN) ; NOK1 Middle Name
|
||
"RTN","CCRDPT",157,0)
|
||
N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
|
||
"RTN","CCRDPT",158,0)
|
||
D NAMECOMP^XLFNAME(.NAME)
|
||
"RTN","CCRDPT",159,0)
|
||
Q NAME("MIDDLE")
|
||
"RTN","CCRDPT",160,0)
|
||
NOK1SUF(DFN) ; NOK1 Suffi Name
|
||
"RTN","CCRDPT",161,0)
|
||
N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
|
||
"RTN","CCRDPT",162,0)
|
||
D NAMECOMP^XLFNAME(.NAME)
|
||
"RTN","CCRDPT",163,0)
|
||
Q NAME("SUFFIX")
|
||
"RTN","CCRDPT",164,0)
|
||
NOK1DISP(DFN) ; NOK1 Display Name
|
||
"RTN","CCRDPT",165,0)
|
||
N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
|
||
"RTN","CCRDPT",166,0)
|
||
; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
|
||
"RTN","CCRDPT",167,0)
|
||
Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
|
||
"RTN","CCRDPT",168,0)
|
||
NOK1REL(DFN) ; NOK1 Relationship to the patient
|
||
"RTN","CCRDPT",169,0)
|
||
Q $$GET1^DIQ(2,DFN,.212)
|
||
"RTN","CCRDPT",170,0)
|
||
NOK1ADD1(DFN) ; NOK1 Address 1
|
||
"RTN","CCRDPT",171,0)
|
||
Q $$GET1^DIQ(2,DFN,.213)
|
||
"RTN","CCRDPT",172,0)
|
||
NOK1ADD2(DFN) ; NOK1 Address 2
|
||
"RTN","CCRDPT",173,0)
|
||
N ADDLN2,ADDLN3
|
||
"RTN","CCRDPT",174,0)
|
||
S ADDLN2=$$GET1^DIQ(2,DFN,.214),ADDLN3=$$GET1^DIQ(2,DFN,.215)
|
||
"RTN","CCRDPT",175,0)
|
||
Q:ADDLN3="" ADDLN2
|
||
"RTN","CCRDPT",176,0)
|
||
Q ADDLN2_", "_ADDLN3
|
||
"RTN","CCRDPT",177,0)
|
||
NOK1CITY(DFN) ; NOK1 City
|
||
"RTN","CCRDPT",178,0)
|
||
Q $$GET1^DIQ(2,DFN,.216)
|
||
"RTN","CCRDPT",179,0)
|
||
NOK1STAT(DFN) ; NOK1 State
|
||
"RTN","CCRDPT",180,0)
|
||
Q $$GET1^DIQ(2,DFN,.217)
|
||
"RTN","CCRDPT",181,0)
|
||
NOK1ZIP(DFN) ; NOK1 Zip Code
|
||
"RTN","CCRDPT",182,0)
|
||
Q $$GET1^DIQ(2,DFN,.218)
|
||
"RTN","CCRDPT",183,0)
|
||
NOK1HTEL(DFN) ; NOK1 Home Telephone
|
||
"RTN","CCRDPT",184,0)
|
||
Q $$GET1^DIQ(2,DFN,.219)
|
||
"RTN","CCRDPT",185,0)
|
||
NOK1WTEL(DFN) ; NOK1 Work Telephone
|
||
"RTN","CCRDPT",186,0)
|
||
Q $$GET1^DIQ(2,DFN,.21011)
|
||
"RTN","CCRDPT",187,0)
|
||
NOK1SAME(DFN) ; Is NOK1's Address the same the patient?
|
||
"RTN","CCRDPT",188,0)
|
||
Q $$GET1^DIQ(2,DFN,.2125)
|
||
"RTN","CCRDPT",189,0)
|
||
NOK2FAM(DFN) ; NOK2 Family Name
|
||
"RTN","CCRDPT",190,0)
|
||
N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
|
||
"RTN","CCRDPT",191,0)
|
||
D NAMECOMP^XLFNAME(.NAME)
|
||
"RTN","CCRDPT",192,0)
|
||
Q NAME("FAMILY")
|
||
"RTN","CCRDPT",193,0)
|
||
NOK2GIV(DFN) ; NOK2 Given Name
|
||
"RTN","CCRDPT",194,0)
|
||
N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
|
||
"RTN","CCRDPT",195,0)
|
||
D NAMECOMP^XLFNAME(.NAME)
|
||
"RTN","CCRDPT",196,0)
|
||
Q NAME("GIVEN")
|
||
"RTN","CCRDPT",197,0)
|
||
NOK2MID(DFN) ; NOK2 Middle Name
|
||
"RTN","CCRDPT",198,0)
|
||
N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
|
||
"RTN","CCRDPT",199,0)
|
||
D NAMECOMP^XLFNAME(.NAME)
|
||
"RTN","CCRDPT",200,0)
|
||
Q NAME("MIDDLE")
|
||
"RTN","CCRDPT",201,0)
|
||
NOK2SUF(DFN) ; NOK2 Suffi Name
|
||
"RTN","CCRDPT",202,0)
|
||
N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
|
||
"RTN","CCRDPT",203,0)
|
||
D NAMECOMP^XLFNAME(.NAME)
|
||
"RTN","CCRDPT",204,0)
|
||
Q NAME("SUFFIX")
|
||
"RTN","CCRDPT",205,0)
|
||
NOK2DISP(DFN) ; NOK2 Display Name
|
||
"RTN","CCRDPT",206,0)
|
||
N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
|
||
"RTN","CCRDPT",207,0)
|
||
; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
|
||
"RTN","CCRDPT",208,0)
|
||
Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
|
||
"RTN","CCRDPT",209,0)
|
||
NOK2REL(DFN) ; NOK2 Relationship to the patient
|
||
"RTN","CCRDPT",210,0)
|
||
Q $$GET1^DIQ(2,DFN,.2192)
|
||
"RTN","CCRDPT",211,0)
|
||
NOK2ADD1(DFN) ; NOK2 Address 1
|
||
"RTN","CCRDPT",212,0)
|
||
Q $$GET1^DIQ(2,DFN,.2193)
|
||
"RTN","CCRDPT",213,0)
|
||
NOK2ADD2(DFN) ; NOK2 Address 2
|
||
"RTN","CCRDPT",214,0)
|
||
N ADDLN2,ADDLN3
|
||
"RTN","CCRDPT",215,0)
|
||
S ADDLN2=$$GET1^DIQ(2,DFN,.2194),ADDLN3=$$GET1^DIQ(2,DFN,.2195)
|
||
"RTN","CCRDPT",216,0)
|
||
Q:ADDLN3="" ADDLN2
|
||
"RTN","CCRDPT",217,0)
|
||
Q ADDLN2_", "_ADDLN3
|
||
"RTN","CCRDPT",218,0)
|
||
NOK2CITY(DFN) ; NOK2 City
|
||
"RTN","CCRDPT",219,0)
|
||
Q $$GET1^DIQ(2,DFN,.2196)
|
||
"RTN","CCRDPT",220,0)
|
||
NOK2STAT(DFN) ; NOK2 State
|
||
"RTN","CCRDPT",221,0)
|
||
Q $$GET1^DIQ(2,DFN,.2197)
|
||
"RTN","CCRDPT",222,0)
|
||
NOK2ZIP(DFN) ; NOK2 Zip Code
|
||
"RTN","CCRDPT",223,0)
|
||
Q $$GET1^DIQ(2,DFN,.2198)
|
||
"RTN","CCRDPT",224,0)
|
||
NOK2HTEL(DFN) ; NOK2 Home Telephone
|
||
"RTN","CCRDPT",225,0)
|
||
Q $$GET1^DIQ(2,DFN,.2199)
|
||
"RTN","CCRDPT",226,0)
|
||
NOK2WTEL(DFN) ; NOK2 Work Telephone
|
||
"RTN","CCRDPT",227,0)
|
||
Q $$GET1^DIQ(2,DFN,.211011)
|
||
"RTN","CCRDPT",228,0)
|
||
NOK2SAME(DFN) ; Is NOK2's Address the same the patient?
|
||
"RTN","CCRDPT",229,0)
|
||
Q $$GET1^DIQ(2,DFN,.21925)
|
||
"RTN","CCRDPT",230,0)
|
||
EMERFAM(DFN) ; Emergency Contact (EMER) Family Name
|
||
"RTN","CCRDPT",231,0)
|
||
N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
|
||
"RTN","CCRDPT",232,0)
|
||
D NAMECOMP^XLFNAME(.NAME)
|
||
"RTN","CCRDPT",233,0)
|
||
Q NAME("FAMILY")
|
||
"RTN","CCRDPT",234,0)
|
||
EMERGIV(DFN) ; EMER Given Name
|
||
"RTN","CCRDPT",235,0)
|
||
N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
|
||
"RTN","CCRDPT",236,0)
|
||
D NAMECOMP^XLFNAME(.NAME)
|
||
"RTN","CCRDPT",237,0)
|
||
Q NAME("GIVEN")
|
||
"RTN","CCRDPT",238,0)
|
||
EMERMID(DFN) ; EMER Middle Name
|
||
"RTN","CCRDPT",239,0)
|
||
N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
|
||
"RTN","CCRDPT",240,0)
|
||
D NAMECOMP^XLFNAME(.NAME)
|
||
"RTN","CCRDPT",241,0)
|
||
Q NAME("MIDDLE")
|
||
"RTN","CCRDPT",242,0)
|
||
EMERSUF(DFN) ; EMER Suffi Name
|
||
"RTN","CCRDPT",243,0)
|
||
N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
|
||
"RTN","CCRDPT",244,0)
|
||
D NAMECOMP^XLFNAME(.NAME)
|
||
"RTN","CCRDPT",245,0)
|
||
Q NAME("SUFFIX")
|
||
"RTN","CCRDPT",246,0)
|
||
EMERDISP(DFN) ; EMER Display Name
|
||
"RTN","CCRDPT",247,0)
|
||
N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
|
||
"RTN","CCRDPT",248,0)
|
||
; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
|
||
"RTN","CCRDPT",249,0)
|
||
Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
|
||
"RTN","CCRDPT",250,0)
|
||
EMERREL(DFN) ; EMER Relationship to the patient
|
||
"RTN","CCRDPT",251,0)
|
||
Q $$GET1^DIQ(2,DFN,.331)
|
||
"RTN","CCRDPT",252,0)
|
||
EMERADD1(DFN) ; EMER Address 1
|
||
"RTN","CCRDPT",253,0)
|
||
Q $$GET1^DIQ(2,DFN,.333)
|
||
"RTN","CCRDPT",254,0)
|
||
EMERADD2(DFN) ; EMER Address 2
|
||
"RTN","CCRDPT",255,0)
|
||
N ADDLN2,ADDLN3
|
||
"RTN","CCRDPT",256,0)
|
||
S ADDLN2=$$GET1^DIQ(2,DFN,.334),ADDLN3=$$GET1^DIQ(2,DFN,.335)
|
||
"RTN","CCRDPT",257,0)
|
||
Q:ADDLN3="" ADDLN2
|
||
"RTN","CCRDPT",258,0)
|
||
Q ADDLN2_", "_ADDLN3
|
||
"RTN","CCRDPT",259,0)
|
||
EMERCITY(DFN) ; EMER City
|
||
"RTN","CCRDPT",260,0)
|
||
Q $$GET1^DIQ(2,DFN,.336)
|
||
"RTN","CCRDPT",261,0)
|
||
EMERSTAT(DFN) ; EMER State
|
||
"RTN","CCRDPT",262,0)
|
||
Q $$GET1^DIQ(2,DFN,.337)
|
||
"RTN","CCRDPT",263,0)
|
||
EMERZIP(DFN) ; EMER Zip Code
|
||
"RTN","CCRDPT",264,0)
|
||
Q $$GET1^DIQ(2,DFN,.338)
|
||
"RTN","CCRDPT",265,0)
|
||
EMERHTEL(DFN) ; EMER Home Telephone
|
||
"RTN","CCRDPT",266,0)
|
||
Q $$GET1^DIQ(2,DFN,.339)
|
||
"RTN","CCRDPT",267,0)
|
||
EMERWTEL(DFN) ; EMER Work Telephone
|
||
"RTN","CCRDPT",268,0)
|
||
Q $$GET1^DIQ(2,DFN,.33011)
|
||
"RTN","CCRDPT",269,0)
|
||
EMERSAME(DFN) ; Is EMER's Address the same the NOK?
|
||
"RTN","CCRDPT",270,0)
|
||
Q $$GET1^DIQ(2,DFN,.3305)
|
||
"RTN","CCRDPTT")
|
||
0^2^B4791589
|
||
"RTN","CCRDPTT",1,0)
|
||
CCRDPTT ; Unit Tester...
|
||
"RTN","CCRDPTT",2,0)
|
||
;;0.1;CCRCCD;;Jun 15, 2008;Build 15
|
||
"RTN","CCRDPTT",3,0)
|
||
;
|
||
"RTN","CCRDPTT",4,0)
|
||
;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
||
"RTN","CCRDPTT",5,0)
|
||
;General Public License See attached copy of the License.
|
||
"RTN","CCRDPTT",6,0)
|
||
;
|
||
"RTN","CCRDPTT",7,0)
|
||
;This program is free software; you can redistribute it and/or modify
|
||
"RTN","CCRDPTT",8,0)
|
||
;it under the terms of the GNU General Public License as published by
|
||
"RTN","CCRDPTT",9,0)
|
||
;the Free Software Foundation; either version 2 of the License, or
|
||
"RTN","CCRDPTT",10,0)
|
||
;(at your option) any later version.
|
||
"RTN","CCRDPTT",11,0)
|
||
;
|
||
"RTN","CCRDPTT",12,0)
|
||
;This program is distributed in the hope that it will be useful,
|
||
"RTN","CCRDPTT",13,0)
|
||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
"RTN","CCRDPTT",14,0)
|
||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
"RTN","CCRDPTT",15,0)
|
||
;GNU General Public License for more details.
|
||
"RTN","CCRDPTT",16,0)
|
||
;
|
||
"RTN","CCRDPTT",17,0)
|
||
;You should have received a copy of the GNU General Public License along
|
||
"RTN","CCRDPTT",18,0)
|
||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
||
"RTN","CCRDPTT",19,0)
|
||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
||
"RTN","CCRDPTT",20,0)
|
||
; Get the functions in the routine using Rick's routine
|
||
"RTN","CCRDPTT",21,0)
|
||
; STATS(0)="CCRDPT^3080626.190908^396^14094^6414499860"
|
||
"RTN","CCRDPTT",22,0)
|
||
; STATS(1,0)="CCRDPT ;CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08"
|
||
"RTN","CCRDPTT",23,0)
|
||
; STATS(2,0)=" ;;0.1;CCRCCD;;Jun 15, 2008;"
|
||
"RTN","CCRDPTT",24,0)
|
||
; STATS(84,0)="INIT(DFN) ; Copy DFN global to a local variable; PUBLIC"
|
||
"RTN","CCRDPTT",25,0)
|
||
; STATS(93,0)="DESTROY ; Kill local variable; PUBLIC"
|
||
"RTN","CCRDPTT",26,0)
|
||
; STATS(99,0)="FAMILY() ; Family Name; PUBLIC; Extrinsic"
|
||
"RTN","CCRDPTT",27,0)
|
||
; STATS(105,0)="GIVEN() ; Given Name; PUBLIC; Extrinsic"
|
||
"RTN","CCRDPTT",28,0)
|
||
; STATS(111,0)="MIDDLE() ; Middle Name; PUBLIC; Extrinsic "
|
||
"RTN","CCRDPTT",29,0)
|
||
; etc.
|
||
"RTN","CCRDPTT",30,0)
|
||
;
|
||
"RTN","CCRDPTT",31,0)
|
||
; Load Routine Entry points; We get a sweeeeeet array
|
||
"RTN","CCRDPTT",32,0)
|
||
D ANALYZE^ARJTXRD("CCRDPT",.OUT) ; Analyze a routine in the directory
|
||
"RTN","CCRDPTT",33,0)
|
||
N X,Y
|
||
"RTN","CCRDPTT",34,0)
|
||
; Select Patient
|
||
"RTN","CCRDPTT",35,0)
|
||
S DIC=2,DIC(0)="AEMQ" D ^DIC
|
||
"RTN","CCRDPTT",36,0)
|
||
;
|
||
"RTN","CCRDPTT",37,0)
|
||
W "You have selected patient "_Y,!!
|
||
"RTN","CCRDPTT",38,0)
|
||
N I S I=89 F S I=$O(OUT(I)) Q:I="ALINE" D
|
||
"RTN","CCRDPTT",39,0)
|
||
. W "OUT("_I_",0)"_" is "_$P(OUT(I,0)," ")_" "
|
||
"RTN","CCRDPTT",40,0)
|
||
. W "valued at "
|
||
"RTN","CCRDPTT",41,0)
|
||
. W @("$$"_$P(OUT(I,0),"(DFN)")_"^"_"CCRDPT"_"("_$P(Y,"^")_")")
|
||
"RTN","CCRDPTT",42,0)
|
||
. W !
|
||
"RTN","CCRDPTT",43,0)
|
||
Q
|
||
"RTN","CCRMEDS")
|
||
0^3^B68553972
|
||
"RTN","CCRMEDS",1,0)
|
||
CCRMEDS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR MEDICATIONS ;07/23/08 14:33
|
||
"RTN","CCRMEDS",2,0)
|
||
;;0.1;CCDCCR;;JUL 16,2008;Build 15
|
||
"RTN","CCRMEDS",3,0)
|
||
;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
||
"RTN","CCRMEDS",4,0)
|
||
;General Public License See attached copy of the License.
|
||
"RTN","CCRMEDS",5,0)
|
||
;
|
||
"RTN","CCRMEDS",6,0)
|
||
;This program is free software; you can redistribute it and/or modify
|
||
"RTN","CCRMEDS",7,0)
|
||
;it under the terms of the GNU General Public License as published by
|
||
"RTN","CCRMEDS",8,0)
|
||
;the Free Software Foundation; either version 2 of the License, or
|
||
"RTN","CCRMEDS",9,0)
|
||
;(at your option) any later version.
|
||
"RTN","CCRMEDS",10,0)
|
||
;
|
||
"RTN","CCRMEDS",11,0)
|
||
;This program is distributed in the hope that it will be useful,
|
||
"RTN","CCRMEDS",12,0)
|
||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
"RTN","CCRMEDS",13,0)
|
||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
"RTN","CCRMEDS",14,0)
|
||
;GNU General Public License for more details.
|
||
"RTN","CCRMEDS",15,0)
|
||
;
|
||
"RTN","CCRMEDS",16,0)
|
||
;You should have received a copy of the GNU General Public License along
|
||
"RTN","CCRMEDS",17,0)
|
||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
||
"RTN","CCRMEDS",18,0)
|
||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
||
"RTN","CCRMEDS",19,0)
|
||
;
|
||
"RTN","CCRMEDS",20,0)
|
||
W "NO ENTRY FROM TOP",!
|
||
"RTN","CCRMEDS",21,0)
|
||
Q
|
||
"RTN","CCRMEDS",22,0)
|
||
;
|
||
"RTN","CCRMEDS",23,0)
|
||
EXTRACT(MEDXML,DFN,MEDOUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
|
||
"RTN","CCRMEDS",24,0)
|
||
;
|
||
"RTN","CCRMEDS",25,0)
|
||
; MEDXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
|
||
"RTN","CCRMEDS",26,0)
|
||
; IMEDXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
|
||
"RTN","CCRMEDS",27,0)
|
||
;
|
||
"RTN","CCRMEDS",28,0)
|
||
N HASOP S HASOP=0 ; FLAG FOR HAS OUTPATIENT MEDS
|
||
"RTN","CCRMEDS",29,0)
|
||
N MEDCNT S MEDCNT=0 ; COUNT FOR MEDS ALREADY PROCESSED
|
||
"RTN","CCRMEDS",30,0)
|
||
; OUTPATIENT ACTIVE MEDS ARE PROCESSED IN EXTRACT^CCRMEDS1
|
||
"RTN","CCRMEDS",31,0)
|
||
; OUTPATIENT PENDING MEDS IN EXTRACT^CCRMEDS2
|
||
"RTN","CCRMEDS",32,0)
|
||
; NON-VA MEDS IN EXTRACT^CCRMEDS3
|
||
"RTN","CCRMEDS",33,0)
|
||
; INPATIENT MEDS IN EXTRACT^CCRMEDS4
|
||
"RTN","CCRMEDS",34,0)
|
||
; ALL OTHERS HERE
|
||
"RTN","CCRMEDS",35,0)
|
||
S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP"))
|
||
"RTN","CCRMEDS",36,0)
|
||
K @MEDTVMAP ; CLEAR VARIABLE ARRAY
|
||
"RTN","CCRMEDS",37,0)
|
||
S @MEDTVMAP@(0)=0 ; INITIALIZE NUMBER OF MEDS PROCESSED
|
||
"RTN","CCRMEDS",38,0)
|
||
S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP"))
|
||
"RTN","CCRMEDS",39,0)
|
||
K @MEDTARYTMP ; KILL XML ARRAY
|
||
"RTN","CCRMEDS",40,0)
|
||
D EXTRACT^CCRMEDS1(MEDXML,DFN,MEDOUTXML) ; FIRST EXTRACT OUTPATIENT MEDS
|
||
"RTN","CCRMEDS",41,0)
|
||
I @MEDOUTXML@(0)>0 D ; CCRMEDS FOUND ACTIVE OP MEDS
|
||
"RTN","CCRMEDS",42,0)
|
||
. S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML
|
||
"RTN","CCRMEDS",43,0)
|
||
. S MEDCNT=MEDCNT+@MEDTVMAP@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP
|
||
"RTN","CCRMEDS",44,0)
|
||
. W MEDCNT,!
|
||
"RTN","CCRMEDS",45,0)
|
||
. W "HAS ACTIVE OP MEDS",!
|
||
"RTN","CCRMEDS",46,0)
|
||
N PENDINGXML,MEDPENDING
|
||
"RTN","CCRMEDS",47,0)
|
||
S PENDINGXML="MEDPENDING" ;NAME FOR ARRAY
|
||
"RTN","CCRMEDS",48,0)
|
||
D EXTRACT^CCRMEDS2(MEDXML,DFN,PENDINGXML) ; FIRST EXTRACT OUTPATIENT MEDS
|
||
"RTN","CCRMEDS",49,0)
|
||
I @PENDINGXML@(0)>0 D ; CCRMEDS FOUND PENDING OP MEDS
|
||
"RTN","CCRMEDS",50,0)
|
||
. S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML
|
||
"RTN","CCRMEDS",51,0)
|
||
. I @MEDOUTXML@(0)>0 D ; IF WE NEED TO COMBINE MEDS
|
||
"RTN","CCRMEDS",52,0)
|
||
. . D INSINNER^GPLXPATH(MEDOUTXML,PENDINGXML) ;ADD PENDING TO ACTIVE
|
||
"RTN","CCRMEDS",53,0)
|
||
. E D CP^GPLXPATH(PENDINGXML,MEDOUTXML) ; NO ACTIVE MEDS, JUST COPY
|
||
"RTN","CCRMEDS",54,0)
|
||
. S MEDCNT=MEDCNT+@MEDTVMAP@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP
|
||
"RTN","CCRMEDS",55,0)
|
||
. ; W MEDCNT,!
|
||
"RTN","CCRMEDS",56,0)
|
||
. W "HAS OP PENDING MEDS",!
|
||
"RTN","CCRMEDS",57,0)
|
||
N PENDINGXML,MEDPENDING
|
||
"RTN","CCRMEDS",58,0)
|
||
S PENDINGXML="MEDPENDING" ;NAME FOR ARRAY
|
||
"RTN","CCRMEDS",59,0)
|
||
D EXTRACT^CCRMEDS3(MEDXML,DFN,PENDINGXML) ; FIRST EXTRACT OUTPATIENT MEDS
|
||
"RTN","CCRMEDS",60,0)
|
||
I @PENDINGXML@(0)>0 D ; CCRMEDS FOUND PENDING OP MEDS
|
||
"RTN","CCRMEDS",61,0)
|
||
. ; S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML
|
||
"RTN","CCRMEDS",62,0)
|
||
. I @MEDOUTXML@(0)>0 D ; IF WE NEED TO COMBINE MEDS
|
||
"RTN","CCRMEDS",63,0)
|
||
. . D INSINNER^GPLXPATH(MEDOUTXML,PENDINGXML) ;ADD NON-VA TO MEDS
|
||
"RTN","CCRMEDS",64,0)
|
||
. E D CP^GPLXPATH(PENDINGXML,MEDOUTXML) ; NO PREVIOUS MEDS, JUST COPY
|
||
"RTN","CCRMEDS",65,0)
|
||
. S MEDCNT=MEDCNT+@MEDTVMAP@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP
|
||
"RTN","CCRMEDS",66,0)
|
||
. ; W MEDCNT,!
|
||
"RTN","CCRMEDS",67,0)
|
||
. W "HAS NON-VA MEDS",!
|
||
"RTN","CCRMEDS",68,0)
|
||
THEND ;
|
||
"RTN","CCRMEDS",69,0)
|
||
Q ; SKIPPING ALL THE REST OF THIS LOGIC.. IT IS NOT GOING TO BE NEEDED
|
||
"RTN","CCRMEDS",70,0)
|
||
; ONCE NON-VA AND IP MEDS WORK (CCRMEDS3 AND CCRMEDS4)
|
||
"RTN","CCRMEDS",71,0)
|
||
N MEDRSLT,I,J,K,MEDPTMP,X,MEDVMAP,TBUF
|
||
"RTN","CCRMEDS",72,0)
|
||
D ACTIVE^ORWPS(.MEDRSLT,DFN)
|
||
"RTN","CCRMEDS",73,0)
|
||
I '$D(MEDRSLT(1)) D ; NO MEDS FOR THIS PATIENT, EXIT
|
||
"RTN","CCRMEDS",74,0)
|
||
. I DEBUG W "MEDICATIONS RPC RETURNED NULL",!
|
||
"RTN","CCRMEDS",75,0)
|
||
. S @MEDOUTXML@(0)=0
|
||
"RTN","CCRMEDS",76,0)
|
||
. Q
|
||
"RTN","CCRMEDS",77,0)
|
||
; I DEBUG ZWR MEDRSLT
|
||
"RTN","CCRMEDS",78,0)
|
||
M GPLMEDS=MEDRSLT
|
||
"RTN","CCRMEDS",79,0)
|
||
S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP"))
|
||
"RTN","CCRMEDS",80,0)
|
||
S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP"))
|
||
"RTN","CCRMEDS",81,0)
|
||
; I 'HASOP K @MEDTVMAP,@MEDTARYTMP KILL MOVED TO TOP OF ROUTINE
|
||
"RTN","CCRMEDS",82,0)
|
||
; FIRST GO THROUGH MEDRSLT ARRAY AND COUNT MEDS AND LINES IN MEDS
|
||
"RTN","CCRMEDS",83,0)
|
||
; ZA(0) IS TOTAL NUMBER OF MEDS ZA(ZI) IS LINES IN MED ZI
|
||
"RTN","CCRMEDS",84,0)
|
||
N ZA,ZI,ZJ,ZK,ZN S (ZI,ZJ,ZK,ZN)=0 ; ZI IS MED NUMBER, ZJ IS LINE IN MED
|
||
"RTN","CCRMEDS",85,0)
|
||
; ZK IS THE NUMBER OF LINES IN A MED AND ZN IS COUNTER THROUGH LINES
|
||
"RTN","CCRMEDS",86,0)
|
||
S ZA(0)=0 ; ZA IS ARRAY OF MED LINE COUNTS
|
||
"RTN","CCRMEDS",87,0)
|
||
F ZJ=1:1 Q:'$D(MEDRSLT(ZJ)) D ; COUNT THE MEDS AND LINES
|
||
"RTN","CCRMEDS",88,0)
|
||
. I MEDRSLT(ZJ)?1"~".E D ; FOUND NEW MED
|
||
"RTN","CCRMEDS",89,0)
|
||
. . S ZI=ZI+1 ; INCREMENT MED COUNT
|
||
"RTN","CCRMEDS",90,0)
|
||
. . S ZA(0)=ZI ; NEW TOTAL FOR MEDS
|
||
"RTN","CCRMEDS",91,0)
|
||
. . S ZA(ZI)=ZJ_U_1 ; EACH ZA(X) IS Y^Z WHERE Y IS START LINE AND Z IS COUNT
|
||
"RTN","CCRMEDS",92,0)
|
||
. E D ; FOR EVERY LINE NOT A FIRST LINE IN MED
|
||
"RTN","CCRMEDS",93,0)
|
||
. . S ZK=$P(ZA(ZI),U,2)+1 ; INCREMENT LINE COUNT FOR CURRENT MED
|
||
"RTN","CCRMEDS",94,0)
|
||
. . S $P(ZA(ZI),U,2)=ZK ; AND STORE IT IN ARRAY
|
||
"RTN","CCRMEDS",95,0)
|
||
;ZWR ZA
|
||
"RTN","CCRMEDS",96,0)
|
||
; S @MEDTVMAP@(0)=ZA(0) ; SAVE NUMBER OF MEDS
|
||
"RTN","CCRMEDS",97,0)
|
||
F ZI=1:1:ZA(0) D ; FOR EACH MED
|
||
"RTN","CCRMEDS",98,0)
|
||
. I DEBUG W "ZI IS ",ZI,!
|
||
"RTN","CCRMEDS",99,0)
|
||
. ; W ZI," ",MEDCNT,!
|
||
"RTN","CCRMEDS",100,0)
|
||
. S ZJ=$P(ZA(ZI),U,1) ; INDEX OF FIRST LINE OF MED IN MEDRSLT
|
||
"RTN","CCRMEDS",101,0)
|
||
. S MEDPTMP=MEDRSLT(ZJ) ; PULL OUT FIRST LINE OF MED
|
||
"RTN","CCRMEDS",102,0)
|
||
. I $P(MEDPTMP,U,1)?1"~OP" Q ; SKIP OP ACTIVE AND PENDING
|
||
"RTN","CCRMEDS",103,0)
|
||
. S MEDCNT=MEDCNT+1 ; WE ARE GOING TO ADD A MED
|
||
"RTN","CCRMEDS",104,0)
|
||
. S MEDVMAP=$NA(@MEDTVMAP@(MEDCNT)) ; START PAST OP ACTIVE MEDS
|
||
"RTN","CCRMEDS",105,0)
|
||
. S @MEDTVMAP@(0)=@MEDTVMAP@(0)+1 ; ADDING A MED HERE
|
||
"RTN","CCRMEDS",106,0)
|
||
. S @MEDVMAP@("MEDOBJECTID")="MED"_(MEDCNT) ; UNIQUE OBJID FOR MEDS
|
||
"RTN","CCRMEDS",107,0)
|
||
. I $P(MEDPTMP,"^",11)="" S @MEDVMAP@("MEDISSUEDATETXT")=""
|
||
"RTN","CCRMEDS",108,0)
|
||
. E S @MEDVMAP@("MEDISSUEDATETXT")=$$FMDTOUTC^CCRUTIL($P(MEDPTMP,"^",11),"DT") ; GETS LAST FILL DATE
|
||
"RTN","CCRMEDS",109,0)
|
||
. S @MEDVMAP@("MEDISSUEDATE")=""
|
||
"RTN","CCRMEDS",110,0)
|
||
. S @MEDVMAP@("MEDLASTFILLDATETXT")=""
|
||
"RTN","CCRMEDS",111,0)
|
||
. S @MEDVMAP@("MEDLASTFILLDATE")=""
|
||
"RTN","CCRMEDS",112,0)
|
||
. S @MEDVMAP@("MEDRXNOTXT")=""
|
||
"RTN","CCRMEDS",113,0)
|
||
. S @MEDVMAP@("MEDRXNO")=""
|
||
"RTN","CCRMEDS",114,0)
|
||
. S @MEDVMAP@("MEDDETAILUNADORNED")=""
|
||
"RTN","CCRMEDS",115,0)
|
||
. S @MEDVMAP@("MEDCONCVALUE")=""
|
||
"RTN","CCRMEDS",116,0)
|
||
. S @MEDVMAP@("MEDCONCUNIT")=""
|
||
"RTN","CCRMEDS",117,0)
|
||
. S @MEDVMAP@("MEDSIZETEXT")=""
|
||
"RTN","CCRMEDS",118,0)
|
||
. S @MEDVMAP@("MEDDOSEINDICATOR")=""
|
||
"RTN","CCRMEDS",119,0)
|
||
. S @MEDVMAP@("MEDDELIVERYMETHOD")=""
|
||
"RTN","CCRMEDS",120,0)
|
||
. S @MEDVMAP@("MEDRATEVALUE")=""
|
||
"RTN","CCRMEDS",121,0)
|
||
. S @MEDVMAP@("MEDRATEUNIT")=""
|
||
"RTN","CCRMEDS",122,0)
|
||
. S @MEDVMAP@("MEDVEHICLETEXT")=""
|
||
"RTN","CCRMEDS",123,0)
|
||
. S @MEDVMAP@("MEDFREQUENCYUNIT")=""
|
||
"RTN","CCRMEDS",124,0)
|
||
. S @MEDVMAP@("MEDINTERVALVALUE")=""
|
||
"RTN","CCRMEDS",125,0)
|
||
. S @MEDVMAP@("MEDINTERVALUNIT")=""
|
||
"RTN","CCRMEDS",126,0)
|
||
. S @MEDVMAP@("MEDPRNFLAG")=""
|
||
"RTN","CCRMEDS",127,0)
|
||
. S @MEDVMAP@("MEDPROBLEMOBJECTID")=""
|
||
"RTN","CCRMEDS",128,0)
|
||
. S @MEDVMAP@("MEDPROBLEMTYPETXT")=""
|
||
"RTN","CCRMEDS",129,0)
|
||
. S @MEDVMAP@("MEDPROBLEMDESCRIPTION")=""
|
||
"RTN","CCRMEDS",130,0)
|
||
. S @MEDVMAP@("MEDPROBLEMCODEVALUE")=""
|
||
"RTN","CCRMEDS",131,0)
|
||
. S @MEDVMAP@("MEDPROBLEMCODINGSYSTEM")=""
|
||
"RTN","CCRMEDS",132,0)
|
||
. S @MEDVMAP@("MEDPROBLEMCODINGVERSION")=""
|
||
"RTN","CCRMEDS",133,0)
|
||
. S @MEDVMAP@("MEDPROBLEMSOURCEACTORID")=""
|
||
"RTN","CCRMEDS",134,0)
|
||
. S @MEDVMAP@("MEDSTOPINDICATOR")=""
|
||
"RTN","CCRMEDS",135,0)
|
||
. S @MEDVMAP@("MEDDIRSEQ")=""
|
||
"RTN","CCRMEDS",136,0)
|
||
. S @MEDVMAP@("MEDMULDIRMOD")=""
|
||
"RTN","CCRMEDS",137,0)
|
||
. S @MEDVMAP@("MEDPTINSTRUCTIONS")=""
|
||
"RTN","CCRMEDS",138,0)
|
||
. S @MEDVMAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
|
||
"RTN","CCRMEDS",139,0)
|
||
. S @MEDVMAP@("MEDDATETIMEAGE")=""
|
||
"RTN","CCRMEDS",140,0)
|
||
. S @MEDVMAP@("MEDDATETIMEAGEUNITS")=""
|
||
"RTN","CCRMEDS",141,0)
|
||
. S @MEDVMAP@("MEDTYPETEXT")="Medication"
|
||
"RTN","CCRMEDS",142,0)
|
||
. S @MEDVMAP@("MEDSTATUSTEXT")=$P(MEDPTMP,"^",10) ; STATUS FROM RPC
|
||
"RTN","CCRMEDS",143,0)
|
||
. S @MEDVMAP@("MEDSOURCEACTORID")="ACTORSYSTEM_1"
|
||
"RTN","CCRMEDS",144,0)
|
||
. S @MEDVMAP@("MEDPRODUCTNAMETEXT")=$P(MEDPTMP,"^",3)
|
||
"RTN","CCRMEDS",145,0)
|
||
. S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")="" ; DEFAULT VALUE
|
||
"RTN","CCRMEDS",146,0)
|
||
. S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
|
||
"RTN","CCRMEDS",147,0)
|
||
. S @MEDVMAP@("MEDPRODUCTNAMECODEVERSION")=""
|
||
"RTN","CCRMEDS",148,0)
|
||
. I $P(MEDPTMP,U,1)?1"~OP" D ; IS OUTPATIENT, MIGHT HAVE CODE
|
||
"RTN","CCRMEDS",149,0)
|
||
. . I $P(MEDPTMP,"^",10)="ACTIVE" D ; ONLY ACTIVE MEDS HAVE CODES
|
||
"RTN","CCRMEDS",150,0)
|
||
. . . N RXIEN ; IEN TO RX, EXAMPLE "~OP^13R;O^IBUPROFEN 400MG^" 13 IS IT
|
||
"RTN","CCRMEDS",151,0)
|
||
. . . S RXIEN=$$DIGITS($P($P(MEDPTMP,U,2),";",1)) ; GET JUST LEADING DIGITS
|
||
"RTN","CCRMEDS",152,0)
|
||
. . . I DEBUG W "RXIEN=",RXIEN,! ;
|
||
"RTN","CCRMEDS",153,0)
|
||
. . . D RX^PSO52API(DFN,"MEDCODE",RXIEN) ; EXTRACT THE RX RECORD TO ^TMP
|
||
"RTN","CCRMEDS",154,0)
|
||
. . . I $D(^TMP($J,"MEDCODE",DFN,RXIEN,27)) D ; IF SUCCESS
|
||
"RTN","CCRMEDS",155,0)
|
||
. . . . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")=^TMP($J,"MEDCODE",DFN,RXIEN,27)
|
||
"RTN","CCRMEDS",156,0)
|
||
. . . . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
|
||
"RTN","CCRMEDS",157,0)
|
||
. S @MEDVMAP@("MEDBRANDNAMETEXT")=""
|
||
"RTN","CCRMEDS",158,0)
|
||
. S @MEDVMAP@("MEDBRANDNAMECODEVALUE")=""
|
||
"RTN","CCRMEDS",159,0)
|
||
. S @MEDVMAP@("MEDBRANDNAMECODINGSYSTEM")=""
|
||
"RTN","CCRMEDS",160,0)
|
||
. S @MEDVMAP@("MEDBRANDNAMECODEVERSION")=""
|
||
"RTN","CCRMEDS",161,0)
|
||
. S @MEDVMAP@("MEDSTRENGTHVALUE")=""
|
||
"RTN","CCRMEDS",162,0)
|
||
. S @MEDVMAP@("MEDSTRENGTHUNIT")=""
|
||
"RTN","CCRMEDS",163,0)
|
||
. S @MEDVMAP@("MEDFORMTEXT")=""
|
||
"RTN","CCRMEDS",164,0)
|
||
. S @MEDVMAP@("MEDQUANTITYVALUE")=""
|
||
"RTN","CCRMEDS",165,0)
|
||
. S @MEDVMAP@("MEDQUANTITYUNIT")=""
|
||
"RTN","CCRMEDS",166,0)
|
||
. S @MEDVMAP@("MEDRFNO")=""
|
||
"RTN","CCRMEDS",167,0)
|
||
. S ZK=$P(ZA(ZI),U,2) ; NUMBER OF LINES IN MED
|
||
"RTN","CCRMEDS",168,0)
|
||
. I ZK>1 D ; MORE THAN ONE LINE IN MED
|
||
"RTN","CCRMEDS",169,0)
|
||
. . S @MEDVMAP@("MEDDESCRIPTIONTEXT")=$P(MEDRSLT(ZJ+1)," *",2)
|
||
"RTN","CCRMEDS",170,0)
|
||
. I ZK>2 D ; THIRD THROUGH 2+N LINES OF MED ARE INSTRUCTIONS
|
||
"RTN","CCRMEDS",171,0)
|
||
. . N TMPTXT S TMPTXT="" ; BUILD UP INSTRUCTION LINE
|
||
"RTN","CCRMEDS",172,0)
|
||
. . F ZN=2:1:ZK-1 D ; REMAINING LINES IN EACH MED
|
||
"RTN","CCRMEDS",173,0)
|
||
. . . I MEDRSLT(ZJ+ZN)]"\ Sig: " D ; REMOVE THIS MARKUP
|
||
"RTN","CCRMEDS",174,0)
|
||
. . . . S TMPTXT=TMPTXT_$P(MEDRSLT(ZJ+ZN),"\ Sig: ",2)_" " ; APPEND 2 TMPTXT
|
||
"RTN","CCRMEDS",175,0)
|
||
. . . E S TMPTXT=TMPTXT_MEDRSLT(ZJ+ZN)_" " ; SEPARATE LINES WITH SPACE
|
||
"RTN","CCRMEDS",176,0)
|
||
. . S @MEDVMAP@("MEDDIRECTIONDESCRIPTIONTEXT")=TMPTXT ; CP TO MAP VAR
|
||
"RTN","CCRMEDS",177,0)
|
||
. S @MEDVMAP@("MEDDOSEVALUE")=""
|
||
"RTN","CCRMEDS",178,0)
|
||
. S @MEDVMAP@("MEDDOSEUNIT")=""
|
||
"RTN","CCRMEDS",179,0)
|
||
. S @MEDVMAP@("MEDFREQUENCYVALUE")=""
|
||
"RTN","CCRMEDS",180,0)
|
||
. S @MEDVMAP@("MEDDURATIONVALUE")=""
|
||
"RTN","CCRMEDS",181,0)
|
||
. S @MEDVMAP@("MEDDURATIONUNIT")=""
|
||
"RTN","CCRMEDS",182,0)
|
||
. S @MEDVMAP@("MEDDIRECTIONROUTETEXT")=""
|
||
"RTN","CCRMEDS",183,0)
|
||
. S @MEDVMAP@("MEDDIRECTIONFREQUENCYVALUE")=""
|
||
"RTN","CCRMEDS",184,0)
|
||
. S MEDARYTMP=$NA(@MEDTARYTMP@(ZI))
|
||
"RTN","CCRMEDS",185,0)
|
||
. K @MEDARYTMP
|
||
"RTN","CCRMEDS",186,0)
|
||
. D MAP^GPLXPATH(MEDXML,MEDVMAP,MEDARYTMP)
|
||
"RTN","CCRMEDS",187,0)
|
||
. I ZI=1&('HASOP) D ; FIRST ONE IS JUST A COPY MAKE SURE OP IS NOT THERE
|
||
"RTN","CCRMEDS",188,0)
|
||
. . ; W "FIRST ONE",!
|
||
"RTN","CCRMEDS",189,0)
|
||
. . D CP^GPLXPATH(MEDARYTMP,MEDOUTXML)
|
||
"RTN","CCRMEDS",190,0)
|
||
. E D ; AFTER THE FIRST OR IF THERE ARE OP, INSERT INNER XML
|
||
"RTN","CCRMEDS",191,0)
|
||
. . D INSINNER^GPLXPATH(MEDOUTXML,MEDARYTMP)
|
||
"RTN","CCRMEDS",192,0)
|
||
N MEDTMP,MEDI
|
||
"RTN","CCRMEDS",193,0)
|
||
D MISSING^GPLXPATH(MEDOUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
|
||
"RTN","CCRMEDS",194,0)
|
||
I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
|
||
"RTN","CCRMEDS",195,0)
|
||
. W "MEDICATION MISSING ",!
|
||
"RTN","CCRMEDS",196,0)
|
||
. F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
|
||
"RTN","CCRMEDS",197,0)
|
||
Q
|
||
"RTN","CCRMEDS",198,0)
|
||
;
|
||
"RTN","CCRMEDS",199,0)
|
||
DIGITS(INSTR) ; RETURN JUST THE LEADING DIGITS OF THE STRING
|
||
"RTN","CCRMEDS",200,0)
|
||
; EXAMPLE: $$DIGITS("13R") RETURNS 13
|
||
"RTN","CCRMEDS",201,0)
|
||
N ALPHA ; CONTANT TO HOLD ALL ALPHA CHARACTERS
|
||
"RTN","CCRMEDS",202,0)
|
||
S ALPHA="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" ; ALPHAS
|
||
"RTN","CCRMEDS",203,0)
|
||
Q $TR(INSTR,ALPHA) ; LEAVE ONLY THE DIGITS
|
||
"RTN","CCRMEDS",204,0)
|
||
;
|
||
"RTN","CCRMEDS1")
|
||
0^10^B80043311
|
||
"RTN","CCRMEDS1",1,0)
|
||
CCRMEDS ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS ;08/24/08
|
||
"RTN","CCRMEDS1",2,0)
|
||
;;0.1;CCDCCR;;JUL 16,2008;Build 15
|
||
"RTN","CCRMEDS1",3,0)
|
||
; Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
||
"RTN","CCRMEDS1",4,0)
|
||
; General Public License See attached copy of the License.
|
||
"RTN","CCRMEDS1",5,0)
|
||
;
|
||
"RTN","CCRMEDS1",6,0)
|
||
; This program is free software; you can redistribute it and/or modify
|
||
"RTN","CCRMEDS1",7,0)
|
||
; it under the terms of the GNU General Public License as published by
|
||
"RTN","CCRMEDS1",8,0)
|
||
; the Free Software Foundation; either version 2 of the License, or
|
||
"RTN","CCRMEDS1",9,0)
|
||
; (at your option) any later version.
|
||
"RTN","CCRMEDS1",10,0)
|
||
;
|
||
"RTN","CCRMEDS1",11,0)
|
||
; This program is distributed in the hope that it will be useful,
|
||
"RTN","CCRMEDS1",12,0)
|
||
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
"RTN","CCRMEDS1",13,0)
|
||
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
"RTN","CCRMEDS1",14,0)
|
||
; GNU General Public License for more details.
|
||
"RTN","CCRMEDS1",15,0)
|
||
;
|
||
"RTN","CCRMEDS1",16,0)
|
||
; You should have received a copy of the GNU General Public License along
|
||
"RTN","CCRMEDS1",17,0)
|
||
; with this program; if not, write to the Free Software Foundation, Inc.,
|
||
"RTN","CCRMEDS1",18,0)
|
||
; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
||
"RTN","CCRMEDS1",19,0)
|
||
;
|
||
"RTN","CCRMEDS1",20,0)
|
||
W "NO ENTRY FROM TOP",!
|
||
"RTN","CCRMEDS1",21,0)
|
||
Q
|
||
"RTN","CCRMEDS1",22,0)
|
||
;
|
||
"RTN","CCRMEDS1",23,0)
|
||
EXTRACT(MINXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
|
||
"RTN","CCRMEDS1",24,0)
|
||
;
|
||
"RTN","CCRMEDS1",25,0)
|
||
; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
|
||
"RTN","CCRMEDS1",26,0)
|
||
; INXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
|
||
"RTN","CCRMEDS1",27,0)
|
||
;
|
||
"RTN","CCRMEDS1",28,0)
|
||
; MEDS is return array from RPC.
|
||
"RTN","CCRMEDS1",29,0)
|
||
; MAP is a mapping variable map (store result) for each med
|
||
"RTN","CCRMEDS1",30,0)
|
||
; MED is holds each array element from MEDS(J), one medicine
|
||
"RTN","CCRMEDS1",31,0)
|
||
; J is a counter.
|
||
"RTN","CCRMEDS1",32,0)
|
||
;
|
||
"RTN","CCRMEDS1",33,0)
|
||
; RX^PSO52API is a Pharmacy Re-Enginnering (PRE) API to get all
|
||
"RTN","CCRMEDS1",34,0)
|
||
; med data available.
|
||
"RTN","CCRMEDS1",35,0)
|
||
; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf
|
||
"RTN","CCRMEDS1",36,0)
|
||
; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).
|
||
"RTN","CCRMEDS1",37,0)
|
||
; D PARY^GPLXPATH(MINXML)
|
||
"RTN","CCRMEDS1",38,0)
|
||
N MEDS,MAP
|
||
"RTN","CCRMEDS1",39,0)
|
||
K ^TMP($J)
|
||
"RTN","CCRMEDS1",40,0)
|
||
D RX^PSO52API(DFN,"CCDCCR")
|
||
"RTN","CCRMEDS1",41,0)
|
||
M MEDS=^TMP($J,"CCDCCR",DFN)
|
||
"RTN","CCRMEDS1",42,0)
|
||
; @(0) contains the number of meds or -1^NO DATA FOUND
|
||
"RTN","CCRMEDS1",43,0)
|
||
; If it is -1, we quit.
|
||
"RTN","CCRMEDS1",44,0)
|
||
I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT
|
||
"RTN","CCRMEDS1",45,0)
|
||
I DEBUG ZWR MEDS
|
||
"RTN","CCRMEDS1",46,0)
|
||
N RXIEN S RXIEN=0
|
||
"RTN","CCRMEDS1",47,0)
|
||
N MEDCOUNT S MEDCOUNT=0
|
||
"RTN","CCRMEDS1",48,0)
|
||
S MEDMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP")) ; THIS IS THE VARIABLE MAP
|
||
"RTN","CCRMEDS1",49,0)
|
||
S MEDCOUNT=@MEDMAP@(0) ; ACCOUNT FOR MEDS ALREADY IN ARRAY
|
||
"RTN","CCRMEDS1",50,0)
|
||
F S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="" D ; FOR EACH MEDICATION IN THE LIST
|
||
"RTN","CCRMEDS1",51,0)
|
||
. S MEDCOUNT=MEDCOUNT+1
|
||
"RTN","CCRMEDS1",52,0)
|
||
. I DEBUG W "RXIEN IS ",RXIEN,!
|
||
"RTN","CCRMEDS1",53,0)
|
||
. S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",MEDCOUNT))
|
||
"RTN","CCRMEDS1",54,0)
|
||
. ; K @MAP DO NOT KILL HERE, WAS CLEARED IN CCRMEDS
|
||
"RTN","CCRMEDS1",55,0)
|
||
. S @MEDMAP@(0)=@MEDMAP@(0)+1 ; INCREMENT TOTAL MEDS IN VAR ARRAY
|
||
"RTN","CCRMEDS1",56,0)
|
||
. I DEBUG W "MAP= ",MAP,!
|
||
"RTN","CCRMEDS1",57,0)
|
||
. N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
|
||
"RTN","CCRMEDS1",58,0)
|
||
. S @MAP@("MEDOBJECTID")="MED"_MEDCOUNT ; MEDCOUNT FOR ID
|
||
"RTN","CCRMEDS1",59,0)
|
||
. ; S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number
|
||
"RTN","CCRMEDS1",60,0)
|
||
. S @MAP@("MEDISSUEDATETXT")="Issue Date"
|
||
"RTN","CCRMEDS1",61,0)
|
||
. S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($P(MED(1),U))
|
||
"RTN","CCRMEDS1",62,0)
|
||
. S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date"
|
||
"RTN","CCRMEDS1",63,0)
|
||
. S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^CCRUTIL($P(MED(101),U))
|
||
"RTN","CCRMEDS1",64,0)
|
||
. S @MAP@("MEDRXNOTXT")="Prescription Number"
|
||
"RTN","CCRMEDS1",65,0)
|
||
. S @MAP@("MEDRXNO")=MED(.01)
|
||
"RTN","CCRMEDS1",66,0)
|
||
. S @MAP@("MEDTYPETEXT")="Medication"
|
||
"RTN","CCRMEDS1",67,0)
|
||
. S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses
|
||
"RTN","CCRMEDS1",68,0)
|
||
. S @MAP@("MEDSTATUSTEXT")=$P(MED(100),U,2)
|
||
"RTN","CCRMEDS1",69,0)
|
||
. S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(4),U)
|
||
"RTN","CCRMEDS1",70,0)
|
||
. S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(6),U,2)
|
||
"RTN","CCRMEDS1",71,0)
|
||
. S @MAP@("MEDPRODUCTNAMECODEVALUE")=MED(27)
|
||
"RTN","CCRMEDS1",72,0)
|
||
. S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
|
||
"RTN","CCRMEDS1",73,0)
|
||
. S @MAP@("MEDPRODUCTNAMECODEVERSION")="none"
|
||
"RTN","CCRMEDS1",74,0)
|
||
. S @MAP@("MEDBRANDNAMETEXT")=MED(6.5)
|
||
"RTN","CCRMEDS1",75,0)
|
||
. N MEDIEN S MEDIEN=$P(MED(6),U)
|
||
"RTN","CCRMEDS1",76,0)
|
||
. D DOSE^PSS50(MEDIEN,,,,,"DOSE")
|
||
"RTN","CCRMEDS1",77,0)
|
||
. N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
|
||
"RTN","CCRMEDS1",78,0)
|
||
. S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
|
||
"RTN","CCRMEDS1",79,0)
|
||
. S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
|
||
"RTN","CCRMEDS1",80,0)
|
||
. ; Units, concentration, etc, come from another call
|
||
"RTN","CCRMEDS1",81,0)
|
||
. ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
|
||
"RTN","CCRMEDS1",82,0)
|
||
. ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
|
||
"RTN","CCRMEDS1",83,0)
|
||
. ; NDF Entry IEN, and VA Product Name
|
||
"RTN","CCRMEDS1",84,0)
|
||
. ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
|
||
"RTN","CCRMEDS1",85,0)
|
||
. ; Documented in the same manual.
|
||
"RTN","CCRMEDS1",86,0)
|
||
. D NDF^PSS50(MEDIEN,,,,,"CONC")
|
||
"RTN","CCRMEDS1",87,0)
|
||
. N NDFDATA M NDFDATA=^TMP($J,"CONC",MEDIEN)
|
||
"RTN","CCRMEDS1",88,0)
|
||
. N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
|
||
"RTN","CCRMEDS1",89,0)
|
||
. N VAPROD S VAPROD=$P(NDFDATA(22),U)
|
||
"RTN","CCRMEDS1",90,0)
|
||
. N CONCDATA
|
||
"RTN","CCRMEDS1",91,0)
|
||
. ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
|
||
"RTN","CCRMEDS1",92,0)
|
||
. ; and this will crash the call. So...
|
||
"RTN","CCRMEDS1",93,0)
|
||
. I NDFIEN="" S CONCDATA=""
|
||
"RTN","CCRMEDS1",94,0)
|
||
. E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
|
||
"RTN","CCRMEDS1",95,0)
|
||
. S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
|
||
"RTN","CCRMEDS1",96,0)
|
||
. S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
|
||
"RTN","CCRMEDS1",97,0)
|
||
. S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
|
||
"RTN","CCRMEDS1",98,0)
|
||
. S @MAP@("MEDSIZETEXT")=$P(NDFDATA(23),U,2)_" "_$P(NDFDATA(24),U,2)
|
||
"RTN","CCRMEDS1",99,0)
|
||
. S @MAP@("MEDQUANTITYVALUE")=MED(7)
|
||
"RTN","CCRMEDS1",100,0)
|
||
. ; Oddly, there is no easy place to find the dispense unit.
|
||
"RTN","CCRMEDS1",101,0)
|
||
. ; It's not included in the original call, so we have to go to the drug file.
|
||
"RTN","CCRMEDS1",102,0)
|
||
. ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
|
||
"RTN","CCRMEDS1",103,0)
|
||
. ; Node 14.5 is the Dispense Unit
|
||
"RTN","CCRMEDS1",104,0)
|
||
. D DATA^PSS50(MEDIEN,,,,,"QTY")
|
||
"RTN","CCRMEDS1",105,0)
|
||
. N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
|
||
"RTN","CCRMEDS1",106,0)
|
||
. S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
|
||
"RTN","CCRMEDS1",107,0)
|
||
. ;
|
||
"RTN","CCRMEDS1",108,0)
|
||
. ; --- START OF DIRECTIONS ---
|
||
"RTN","CCRMEDS1",109,0)
|
||
. ; Sig data not in any API :-( Oh yes, you can get the whole thing, but...
|
||
"RTN","CCRMEDS1",110,0)
|
||
. ; we want the compoenents.
|
||
"RTN","CCRMEDS1",111,0)
|
||
. ; It's in node 6 of ^PSRX(IEN)
|
||
"RTN","CCRMEDS1",112,0)
|
||
. ; So, here we go again
|
||
"RTN","CCRMEDS1",113,0)
|
||
. ; ^PSRX(D0,6,D1,0)= (#.01) DOSAGE ORDERED [1F] ^ (#1) DISPENSE UNITS PER DOSE
|
||
"RTN","CCRMEDS1",114,0)
|
||
. ; ==>[2N] ^ (#2) UNITS [3P:50.607] ^ (#3) NOUN [4F] ^ (#4)
|
||
"RTN","CCRMEDS1",115,0)
|
||
. ; ==>DURATION [5F] ^ (#5) CONJUNCTION [6S] ^ (#6) ROUTE
|
||
"RTN","CCRMEDS1",116,0)
|
||
. ; ==>[7P:51.2] ^ (#7) SCHEDULE [8F] ^ (#8) VERB [9F] ^
|
||
"RTN","CCRMEDS1",117,0)
|
||
. ;
|
||
"RTN","CCRMEDS1",118,0)
|
||
. N DIRNUM S DIRNUM=0 ; Sigline number
|
||
"RTN","CCRMEDS1",119,0)
|
||
. S DIRCNT=0 ; COUNT OF MULTIPLE DIRECTIONS
|
||
"RTN","CCRMEDS1",120,0)
|
||
. F S DIRNUM=$O(^PSRX(RXIEN,6,DIRNUM)) Q:DIRNUM="" D
|
||
"RTN","CCRMEDS1",121,0)
|
||
. . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT
|
||
"RTN","CCRMEDS1",122,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")="" ; This is reserved for systems not able to generate the sig in components.
|
||
"RTN","CCRMEDS1",123,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1" ; means that we are specifying it. See E2369-05.
|
||
"RTN","CCRMEDS1",124,0)
|
||
. . N SIGDATA S SIGDATA=^PSRX(RXIEN,6,DIRNUM,0)
|
||
"RTN","CCRMEDS1",125,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=$P(SIGDATA,U,9)
|
||
"RTN","CCRMEDS1",126,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=$P(SIGDATA,U,1)
|
||
"RTN","CCRMEDS1",127,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
|
||
"RTN","CCRMEDS1",128,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")="" ; For inpatient
|
||
"RTN","CCRMEDS1",129,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")="" ; For inpatient
|
||
"RTN","CCRMEDS1",130,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")="" ; For inpatient
|
||
"RTN","CCRMEDS1",131,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=$$GET1^DIQ(51.2,$P(SIGDATA,U,7),.01)
|
||
"RTN","CCRMEDS1",132,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=$P(SIGDATA,U,8)
|
||
"RTN","CCRMEDS1",133,0)
|
||
. . ; Invervals... again another call.
|
||
"RTN","CCRMEDS1",134,0)
|
||
. . ; In the wisdom of the original programmers, the schedule is a free text field
|
||
"RTN","CCRMEDS1",135,0)
|
||
. . ; However, it gets translated by a call to the administration schedule file
|
||
"RTN","CCRMEDS1",136,0)
|
||
. . ; to see if that schedule exists.
|
||
"RTN","CCRMEDS1",137,0)
|
||
. . ; That's the same thing I am going to do.
|
||
"RTN","CCRMEDS1",138,0)
|
||
. . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
|
||
"RTN","CCRMEDS1",139,0)
|
||
. . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
|
||
"RTN","CCRMEDS1",140,0)
|
||
. . ; I looked), PSSFT is the name, and list is the ^TMP name to store the data in.
|
||
"RTN","CCRMEDS1",141,0)
|
||
. . ; So...
|
||
"RTN","CCRMEDS1",142,0)
|
||
. . D AP^PSS51P1("PSJ",$P(SIGDATA,U,8),,,"SCHEDULE")
|
||
"RTN","CCRMEDS1",143,0)
|
||
. . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
|
||
"RTN","CCRMEDS1",144,0)
|
||
. . N INTERVAL
|
||
"RTN","CCRMEDS1",145,0)
|
||
. . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
|
||
"RTN","CCRMEDS1",146,0)
|
||
. . E D
|
||
"RTN","CCRMEDS1",147,0)
|
||
. . . N SUB S SUB=$O(SCHEDATA(0))
|
||
"RTN","CCRMEDS1",148,0)
|
||
. . . S INTERVAL=SCHEDATA(SUB,2)
|
||
"RTN","CCRMEDS1",149,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
|
||
"RTN","CCRMEDS1",150,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
|
||
"RTN","CCRMEDS1",151,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$P(SIGDATA,U,5)
|
||
"RTN","CCRMEDS1",152,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=""
|
||
"RTN","CCRMEDS1",153,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=$P(SIGDATA,U,8)["PRN"
|
||
"RTN","CCRMEDS1",154,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")=""
|
||
"RTN","CCRMEDS1",155,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
|
||
"RTN","CCRMEDS1",156,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
|
||
"RTN","CCRMEDS1",157,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
|
||
"RTN","CCRMEDS1",158,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
|
||
"RTN","CCRMEDS1",159,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
|
||
"RTN","CCRMEDS1",160,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
|
||
"RTN","CCRMEDS1",161,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")=""
|
||
"RTN","CCRMEDS1",162,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM
|
||
"RTN","CCRMEDS1",163,0)
|
||
. . N DIRMOD S DIRMOD=$P(SIGDATA,U,6)
|
||
"RTN","CCRMEDS1",164,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=$S(DIRMOD="T":"THEN",DIRMOD="A":"AND",DIRMOD="X":"EXCEPT",1:"")
|
||
"RTN","CCRMEDS1",165,0)
|
||
. ;
|
||
"RTN","CCRMEDS1",166,0)
|
||
. ; --- END OF DIRECTIONS ---
|
||
"RTN","CCRMEDS1",167,0)
|
||
. ;
|
||
"RTN","CCRMEDS1",168,0)
|
||
. ; ^PSRX(22,"INS1",1,0)="FOR BLOOD PRESSURE"
|
||
"RTN","CCRMEDS1",169,0)
|
||
. S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"INS1",1,0))
|
||
"RTN","CCRMEDS1",170,0)
|
||
. ; ^PSRX(22,"PRC",1,0)="Pharmacist: you must obey my command"
|
||
"RTN","CCRMEDS1",171,0)
|
||
. S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PRC",1,0))
|
||
"RTN","CCRMEDS1",172,0)
|
||
. S @MAP@("MEDRFNO")=MED(9)
|
||
"RTN","CCRMEDS1",173,0)
|
||
. N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"MAPPED"))
|
||
"RTN","CCRMEDS1",174,0)
|
||
. K @RESULT
|
||
"RTN","CCRMEDS1",175,0)
|
||
. D MAP^GPLXPATH(MINXML,MAP,RESULT)
|
||
"RTN","CCRMEDS1",176,0)
|
||
. ; D PARY^GPLXPATH(RESULT)
|
||
"RTN","CCRMEDS1",177,0)
|
||
. ; MAPPING DIRECTIONS
|
||
"RTN","CCRMEDS1",178,0)
|
||
. N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
|
||
"RTN","CCRMEDS1",179,0)
|
||
. N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
|
||
"RTN","CCRMEDS1",180,0)
|
||
. D QUERY^GPLXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
|
||
"RTN","CCRMEDS1",181,0)
|
||
. D REPLACE^GPLXPATH(RESULT,"","//Medications/Medication/Directions")
|
||
"RTN","CCRMEDS1",182,0)
|
||
. ; N MDZ1,MDZNA
|
||
"RTN","CCRMEDS1",183,0)
|
||
. I DIRCNT>0 D ; IF THERE ARE DIRCTIONS
|
||
"RTN","CCRMEDS1",184,0)
|
||
. . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION
|
||
"RTN","CCRMEDS1",185,0)
|
||
. . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
|
||
"RTN","CCRMEDS1",186,0)
|
||
. . . D MAP^GPLXPATH(DIRXML1,MDZNA,DIRXML2)
|
||
"RTN","CCRMEDS1",187,0)
|
||
. . . D INSERT^GPLXPATH(RESULT,DIRXML2,"//Medications/Medication")
|
||
"RTN","CCRMEDS1",188,0)
|
||
. D:MEDCOUNT=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy
|
||
"RTN","CCRMEDS1",189,0)
|
||
. D:MEDCOUNT>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
|
||
"RTN","CCRMEDS1",190,0)
|
||
N MEDTMP,MEDI
|
||
"RTN","CCRMEDS1",191,0)
|
||
D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
|
||
"RTN","CCRMEDS1",192,0)
|
||
I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
|
||
"RTN","CCRMEDS1",193,0)
|
||
. W "MEDICATION MISSING ",!
|
||
"RTN","CCRMEDS1",194,0)
|
||
. F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
|
||
"RTN","CCRMEDS1",195,0)
|
||
Q
|
||
"RTN","CCRMEDS1",196,0)
|
||
;
|
||
"RTN","CCRMEDS2")
|
||
0^11^B104632066
|
||
"RTN","CCRMEDS2",1,0)
|
||
CCRMEDS2 ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS - Pending Meds;08/24/08
|
||
"RTN","CCRMEDS2",2,0)
|
||
;;0.1;CCDCCR;;JUL 16,2008;Build 15
|
||
"RTN","CCRMEDS2",3,0)
|
||
; Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
||
"RTN","CCRMEDS2",4,0)
|
||
; General Public License See attached copy of the License.
|
||
"RTN","CCRMEDS2",5,0)
|
||
;
|
||
"RTN","CCRMEDS2",6,0)
|
||
; This program is free software; you can redistribute it and/or modify
|
||
"RTN","CCRMEDS2",7,0)
|
||
; it under the terms of the GNU General Public License as published by
|
||
"RTN","CCRMEDS2",8,0)
|
||
; the Free Software Foundation; either version 2 of the License, or
|
||
"RTN","CCRMEDS2",9,0)
|
||
; (at your option) any later version.
|
||
"RTN","CCRMEDS2",10,0)
|
||
;
|
||
"RTN","CCRMEDS2",11,0)
|
||
; This program is distributed in the hope that it will be useful,
|
||
"RTN","CCRMEDS2",12,0)
|
||
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
"RTN","CCRMEDS2",13,0)
|
||
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
"RTN","CCRMEDS2",14,0)
|
||
; GNU General Public License for more details.
|
||
"RTN","CCRMEDS2",15,0)
|
||
;
|
||
"RTN","CCRMEDS2",16,0)
|
||
; You should have received a copy of the GNU General Public License along
|
||
"RTN","CCRMEDS2",17,0)
|
||
; with this program; if not, write to the Free Software Foundation, Inc.,
|
||
"RTN","CCRMEDS2",18,0)
|
||
; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
||
"RTN","CCRMEDS2",19,0)
|
||
;
|
||
"RTN","CCRMEDS2",20,0)
|
||
W "NO ENTRY FROM TOP",!
|
||
"RTN","CCRMEDS2",21,0)
|
||
Q
|
||
"RTN","CCRMEDS2",22,0)
|
||
;
|
||
"RTN","CCRMEDS2",23,0)
|
||
EXTRACT(MINXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
|
||
"RTN","CCRMEDS2",24,0)
|
||
;
|
||
"RTN","CCRMEDS2",25,0)
|
||
; MINXML is the Input XML Template, passed by name
|
||
"RTN","CCRMEDS2",26,0)
|
||
; DFN is Patient IEN
|
||
"RTN","CCRMEDS2",27,0)
|
||
; OUTXML is the resultant XML.
|
||
"RTN","CCRMEDS2",28,0)
|
||
;
|
||
"RTN","CCRMEDS2",29,0)
|
||
; MEDS is return array from RPC.
|
||
"RTN","CCRMEDS2",30,0)
|
||
; MAP is a mapping variable map (store result) for each med
|
||
"RTN","CCRMEDS2",31,0)
|
||
; MED is holds each array element from MEDS, one medicine
|
||
"RTN","CCRMEDS2",32,0)
|
||
;
|
||
"RTN","CCRMEDS2",33,0)
|
||
; PEN^PSO5241 is a Pharmacy Re-Enginnering (PRE) API to get Pending
|
||
"RTN","CCRMEDS2",34,0)
|
||
; meds data available.
|
||
"RTN","CCRMEDS2",35,0)
|
||
; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf
|
||
"RTN","CCRMEDS2",36,0)
|
||
; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).
|
||
"RTN","CCRMEDS2",37,0)
|
||
; File for pending meds is 52.41
|
||
"RTN","CCRMEDS2",38,0)
|
||
; Unfortuantely, API does not supply us with any useful info beyond
|
||
"RTN","CCRMEDS2",39,0)
|
||
; the IEN in 52.41, and the Med Name, and route.
|
||
"RTN","CCRMEDS2",40,0)
|
||
; So, most of the info is going to get pulled from 52.41.
|
||
"RTN","CCRMEDS2",41,0)
|
||
N MEDS,MAP
|
||
"RTN","CCRMEDS2",42,0)
|
||
K ^TMP($J)
|
||
"RTN","CCRMEDS2",43,0)
|
||
D PEN^PSO5241(DFN,"CCDCCR")
|
||
"RTN","CCRMEDS2",44,0)
|
||
M MEDS=^TMP($J,"CCDCCR",DFN)
|
||
"RTN","CCRMEDS2",45,0)
|
||
; @(0) contains the number of meds or -1^NO DATA FOUND
|
||
"RTN","CCRMEDS2",46,0)
|
||
; If it is -1, we quit.
|
||
"RTN","CCRMEDS2",47,0)
|
||
I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT
|
||
"RTN","CCRMEDS2",48,0)
|
||
I DEBUG ZWR MEDS
|
||
"RTN","CCRMEDS2",49,0)
|
||
N RXIEN S RXIEN=0
|
||
"RTN","CCRMEDS2",50,0)
|
||
N MEDCOUNT S MEDCOUNT=0
|
||
"RTN","CCRMEDS2",51,0)
|
||
N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED IN THIS SECTION FOR MERGING
|
||
"RTN","CCRMEDS2",52,0)
|
||
S MEDMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP")) ; THIS IS THE VARIABLE MAP
|
||
"RTN","CCRMEDS2",53,0)
|
||
S MEDCOUNT=@MEDMAP@(0) ; ACCOUNT FOR MEDS ALREADY IN ARRAY
|
||
"RTN","CCRMEDS2",54,0)
|
||
F S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="B" D ; FOR EACH MEDICATION IN THE LIST
|
||
"RTN","CCRMEDS2",55,0)
|
||
. I $$GET1^DIQ(52.41,RXIEN,2,"I")="RF" QUIT ; Dont' want refill request as a "pending" order
|
||
"RTN","CCRMEDS2",56,0)
|
||
. S MEDCOUNT=MEDCOUNT+1
|
||
"RTN","CCRMEDS2",57,0)
|
||
. I DEBUG W "RXIEN IS ",RXIEN,!
|
||
"RTN","CCRMEDS2",58,0)
|
||
. S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",MEDCOUNT))
|
||
"RTN","CCRMEDS2",59,0)
|
||
. ; K @MAP DON'T KILL MAP HERE, IT IS DONE IN CCRMEDS
|
||
"RTN","CCRMEDS2",60,0)
|
||
. S @MEDMAP@(0)=@MEDMAP@(0)+1 ; INCREMENT TOTAL MEDS IN VAR ARRAY
|
||
"RTN","CCRMEDS2",61,0)
|
||
. I DEBUG W "MAP= ",MAP,!
|
||
"RTN","CCRMEDS2",62,0)
|
||
. N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
|
||
"RTN","CCRMEDS2",63,0)
|
||
. S @MAP@("MEDOBJECTID")="MED_PENDING"_MEDCOUNT ; MEDCOUNT FOR ID
|
||
"RTN","CCRMEDS2",64,0)
|
||
. ; S @MAP@("MEDOBJECTID")="MED_PENDING"_MED(.01) ;Pending IEN
|
||
"RTN","CCRMEDS2",65,0)
|
||
. S @MAP@("MEDISSUEDATETXT")="Issue Date"
|
||
"RTN","CCRMEDS2",66,0)
|
||
. ; Field 6 is "Effective date", and we pull it in timson format w/ I
|
||
"RTN","CCRMEDS2",67,0)
|
||
. S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($$GET1^DIQ(52.41,RXIEN,6,"I"),"DT")
|
||
"RTN","CCRMEDS2",68,0)
|
||
. ; Med never filled; next 4 fields are not applicable.
|
||
"RTN","CCRMEDS2",69,0)
|
||
. S @MAP@("MEDLASTFILLDATETXT")=""
|
||
"RTN","CCRMEDS2",70,0)
|
||
. S @MAP@("MEDLASTFILLDATE")=""
|
||
"RTN","CCRMEDS2",71,0)
|
||
. S @MAP@("MEDRXNOTXT")=""
|
||
"RTN","CCRMEDS2",72,0)
|
||
. S @MAP@("MEDRXNO")=""
|
||
"RTN","CCRMEDS2",73,0)
|
||
. S @MAP@("MEDTYPETEXT")="Medication"
|
||
"RTN","CCRMEDS2",74,0)
|
||
. S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses
|
||
"RTN","CCRMEDS2",75,0)
|
||
. S @MAP@("MEDSTATUSTEXT")="On Hold" ; nearest status for pending meds
|
||
"RTN","CCRMEDS2",76,0)
|
||
. S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52.41,RXIEN,5,"I")
|
||
"RTN","CCRMEDS2",77,0)
|
||
. S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(11),U,2)
|
||
"RTN","CCRMEDS2",78,0)
|
||
. ; NDC not supplied in API, but is rather trivial to obtain
|
||
"RTN","CCRMEDS2",79,0)
|
||
. ; MED(11) piece 1 has the IEN of the drug (file 50)
|
||
"RTN","CCRMEDS2",80,0)
|
||
. ; IEN is field 31 in the drug file.
|
||
"RTN","CCRMEDS2",81,0)
|
||
. N MEDIEN S MEDIEN=$P(MED(11),U)
|
||
"RTN","CCRMEDS2",82,0)
|
||
. S @MAP@("MEDPRODUCTNAMECODEVALUE")=$$GET1^DIQ(50,MEDIEN,31,"E")
|
||
"RTN","CCRMEDS2",83,0)
|
||
. S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
|
||
"RTN","CCRMEDS2",84,0)
|
||
. S @MAP@("MEDPRODUCTNAMECODEVERSION")="none"
|
||
"RTN","CCRMEDS2",85,0)
|
||
. S @MAP@("MEDBRANDNAMETEXT")=""
|
||
"RTN","CCRMEDS2",86,0)
|
||
. D DOSE^PSS50(MEDIEN,,,,,"DOSE")
|
||
"RTN","CCRMEDS2",87,0)
|
||
. I $D(^TMP($J,"DOSE",MEDIEN)) D ; GPL ; CALL SUCCESSFUL
|
||
"RTN","CCRMEDS2",88,0)
|
||
. . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
|
||
"RTN","CCRMEDS2",89,0)
|
||
. . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
|
||
"RTN","CCRMEDS2",90,0)
|
||
. . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
|
||
"RTN","CCRMEDS2",91,0)
|
||
. E D ; GPL CALL UNSUCCESSUFL
|
||
"RTN","CCRMEDS2",92,0)
|
||
. . S @MAP@("MEDSTRENGTHVALUE")="" ; NO DOSE INFORMATION AVAILABLE
|
||
"RTN","CCRMEDS2",93,0)
|
||
. . S @MAP@("MEDSTRENGTHUNIT")="" ;
|
||
"RTN","CCRMEDS2",94,0)
|
||
. ; Units, concentration, etc, come from another call
|
||
"RTN","CCRMEDS2",95,0)
|
||
. ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
|
||
"RTN","CCRMEDS2",96,0)
|
||
. ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
|
||
"RTN","CCRMEDS2",97,0)
|
||
. ; NDF Entry IEN, and VA Product Name
|
||
"RTN","CCRMEDS2",98,0)
|
||
. ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
|
||
"RTN","CCRMEDS2",99,0)
|
||
. ; Documented in the same manual.
|
||
"RTN","CCRMEDS2",100,0)
|
||
. D NDF^PSS50(MEDIEN,,,,,"CONC")
|
||
"RTN","CCRMEDS2",101,0)
|
||
. N NDFDATA M NDFDATA=^TMP($J,"CONC",MEDIEN)
|
||
"RTN","CCRMEDS2",102,0)
|
||
. N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
|
||
"RTN","CCRMEDS2",103,0)
|
||
. N VAPROD S VAPROD=$P(NDFDATA(22),U)
|
||
"RTN","CCRMEDS2",104,0)
|
||
. N CONCDATA
|
||
"RTN","CCRMEDS2",105,0)
|
||
. ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
|
||
"RTN","CCRMEDS2",106,0)
|
||
. ; and this will crash the call. So...
|
||
"RTN","CCRMEDS2",107,0)
|
||
. I NDFIEN="" S CONCDATA=""
|
||
"RTN","CCRMEDS2",108,0)
|
||
. E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
|
||
"RTN","CCRMEDS2",109,0)
|
||
. S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
|
||
"RTN","CCRMEDS2",110,0)
|
||
. S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
|
||
"RTN","CCRMEDS2",111,0)
|
||
. S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
|
||
"RTN","CCRMEDS2",112,0)
|
||
. S @MAP@("MEDSIZETEXT")=$P(NDFDATA(23),U,2)_" "_$P(NDFDATA(24),U,2)
|
||
"RTN","CCRMEDS2",113,0)
|
||
. S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52.41,RXIEN,12)
|
||
"RTN","CCRMEDS2",114,0)
|
||
. ; Oddly, there is no easy place to find the dispense unit.
|
||
"RTN","CCRMEDS2",115,0)
|
||
. ; It's not included in the original call, so we have to go to the drug file.
|
||
"RTN","CCRMEDS2",116,0)
|
||
. ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
|
||
"RTN","CCRMEDS2",117,0)
|
||
. ; Node 14.5 is the Dispense Unit
|
||
"RTN","CCRMEDS2",118,0)
|
||
. D DATA^PSS50(MEDIEN,,,,,"QTY")
|
||
"RTN","CCRMEDS2",119,0)
|
||
. N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
|
||
"RTN","CCRMEDS2",120,0)
|
||
. S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
|
||
"RTN","CCRMEDS2",121,0)
|
||
. ;
|
||
"RTN","CCRMEDS2",122,0)
|
||
. ; --- START OF DIRECTIONS ---
|
||
"RTN","CCRMEDS2",123,0)
|
||
. ; Sig data is not in any API. We obtain it using the IEN from
|
||
"RTN","CCRMEDS2",124,0)
|
||
. ; the PEN API to file 52.41. It's in field 3, which is a multiple.
|
||
"RTN","CCRMEDS2",125,0)
|
||
. ; I will be using FM call GETS^DIQ(FILE,IENS,FIELD,FLAGS,TARGET_ROOT)
|
||
"RTN","CCRMEDS2",126,0)
|
||
. K FMSIG ; it's passed via the symbol table, so remove any leftovers from last call
|
||
"RTN","CCRMEDS2",127,0)
|
||
. D GETS^DIQ(52.41,RXIEN,"3*",,"FMSIG")
|
||
"RTN","CCRMEDS2",128,0)
|
||
. N FMSIGNUM S FMSIGNUM=0 ; Sigline number in fileman.
|
||
"RTN","CCRMEDS2",129,0)
|
||
. ; FMSIGNUM gets outputted as "IEN,RXIEN,".
|
||
"RTN","CCRMEDS2",130,0)
|
||
. ; DIRNUM will be first piece for IEN.
|
||
"RTN","CCRMEDS2",131,0)
|
||
. ; DIRNUM is the proper Sigline numer.
|
||
"RTN","CCRMEDS2",132,0)
|
||
. ; SIGDATA is the simplfied array. Subscripts are really field numbers
|
||
"RTN","CCRMEDS2",133,0)
|
||
. ; in subfile 52.413.
|
||
"RTN","CCRMEDS2",134,0)
|
||
. N DIRCNT S DIRCNT=0 ; COUNT OF DIRECTIONS
|
||
"RTN","CCRMEDS2",135,0)
|
||
. F S FMSIGNUM=$O(FMSIG(52.413,FMSIGNUM)) Q:FMSIGNUM="" D
|
||
"RTN","CCRMEDS2",136,0)
|
||
. . N DIRNUM S DIRNUM=$P(FMSIGNUM,",")
|
||
"RTN","CCRMEDS2",137,0)
|
||
. . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT
|
||
"RTN","CCRMEDS2",138,0)
|
||
. . N SIGDATA M SIGDATA=FMSIG(52.413,FMSIGNUM)
|
||
"RTN","CCRMEDS2",139,0)
|
||
. . ; If this is an order for a refill; it's not really a new order; move on to next
|
||
"RTN","CCRMEDS2",140,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")="" ; This is reserved for systems not able to generate the sig in components.
|
||
"RTN","CCRMEDS2",141,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1" ; means that we are specifying it. See E2369-05.
|
||
"RTN","CCRMEDS2",142,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=SIGDATA(13)
|
||
"RTN","CCRMEDS2",143,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=SIGDATA(8)
|
||
"RTN","CCRMEDS2",144,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
|
||
"RTN","CCRMEDS2",145,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")="" ; For inpatient
|
||
"RTN","CCRMEDS2",146,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")="" ; For inpatient
|
||
"RTN","CCRMEDS2",147,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")="" ; For inpatient
|
||
"RTN","CCRMEDS2",148,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=SIGDATA(10)
|
||
"RTN","CCRMEDS2",149,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=SIGDATA(1)
|
||
"RTN","CCRMEDS2",150,0)
|
||
. . ; Invervals... again another call.
|
||
"RTN","CCRMEDS2",151,0)
|
||
. . ; The schedule is a free text field
|
||
"RTN","CCRMEDS2",152,0)
|
||
. . ; However, it gets translated by a call to the administration
|
||
"RTN","CCRMEDS2",153,0)
|
||
. . ; schedule file to see if that schedule exists.
|
||
"RTN","CCRMEDS2",154,0)
|
||
. . ; That's the same thing I am going to do.
|
||
"RTN","CCRMEDS2",155,0)
|
||
. . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
|
||
"RTN","CCRMEDS2",156,0)
|
||
. . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
|
||
"RTN","CCRMEDS2",157,0)
|
||
. . ; I looked), PSSFT is the name,
|
||
"RTN","CCRMEDS2",158,0)
|
||
. . ; and list is the ^TMP name to store the data in.
|
||
"RTN","CCRMEDS2",159,0)
|
||
. . ; Also, freqency may have "PRN" in it, so strip that out
|
||
"RTN","CCRMEDS2",160,0)
|
||
. . N FREQ S FREQ=SIGDATA(1)
|
||
"RTN","CCRMEDS2",161,0)
|
||
. . I FREQ["PRN" S FREQ=$E(FREQ,1,$F(FREQ,"PRN")-5) ; 5 for $L("PRN") + 1 + sp
|
||
"RTN","CCRMEDS2",162,0)
|
||
. . D AP^PSS51P1("PSJ",FREQ,,,"SCHEDULE")
|
||
"RTN","CCRMEDS2",163,0)
|
||
. . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
|
||
"RTN","CCRMEDS2",164,0)
|
||
. . N INTERVAL
|
||
"RTN","CCRMEDS2",165,0)
|
||
. . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
|
||
"RTN","CCRMEDS2",166,0)
|
||
. . E D
|
||
"RTN","CCRMEDS2",167,0)
|
||
. . . N SUB S SUB=$O(SCHEDATA(0))
|
||
"RTN","CCRMEDS2",168,0)
|
||
. . . S INTERVAL=SCHEDATA(SUB,2)
|
||
"RTN","CCRMEDS2",169,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
|
||
"RTN","CCRMEDS2",170,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
|
||
"RTN","CCRMEDS2",171,0)
|
||
. . ; Duration comes as M2,H2,D2,W2,L2 for 2 minutes,hours,days,weeks,months
|
||
"RTN","CCRMEDS2",172,0)
|
||
. . N DUR S DUR=SIGDATA(2)
|
||
"RTN","CCRMEDS2",173,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$E(DUR,2,$L(DUR))
|
||
"RTN","CCRMEDS2",174,0)
|
||
. . N DURUNIT S DURUNIT=$E(DUR)
|
||
"RTN","CCRMEDS2",175,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"")
|
||
"RTN","CCRMEDS2",176,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=SIGDATA(1)["PRN"
|
||
"RTN","CCRMEDS2",177,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")=""
|
||
"RTN","CCRMEDS2",178,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
|
||
"RTN","CCRMEDS2",179,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
|
||
"RTN","CCRMEDS2",180,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
|
||
"RTN","CCRMEDS2",181,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
|
||
"RTN","CCRMEDS2",182,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
|
||
"RTN","CCRMEDS2",183,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
|
||
"RTN","CCRMEDS2",184,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" ; Vista doesn't have that field
|
||
"RTN","CCRMEDS2",185,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM
|
||
"RTN","CCRMEDS2",186,0)
|
||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=SIGDATA(6)
|
||
"RTN","CCRMEDS2",187,0)
|
||
. ;
|
||
"RTN","CCRMEDS2",188,0)
|
||
. ; --- END OF DIRECTIONS ---
|
||
"RTN","CCRMEDS2",189,0)
|
||
. ;
|
||
"RTN","CCRMEDS2",190,0)
|
||
. ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
|
||
"RTN","CCRMEDS2",191,0)
|
||
. S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PI",1,0)) ;GPL
|
||
"RTN","CCRMEDS2",192,0)
|
||
. ; W @MAP@("MEDPTINSTRUCTIONS"),!
|
||
"RTN","CCRMEDS2",193,0)
|
||
. ; S @MAP@("MEDFULLFILLMENTINSTRUCTIONS","F")="52.41^9"
|
||
"RTN","CCRMEDS2",194,0)
|
||
. S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"SIG1",1,0)) ;GPL
|
||
"RTN","CCRMEDS2",195,0)
|
||
. ; W @MAP@("MEDFULLFILLMENTINSTRUCTIONS"),!
|
||
"RTN","CCRMEDS2",196,0)
|
||
. S @MAP@("MEDRFNO")=$$GET1^DIQ(52.41,RXIEN,13)
|
||
"RTN","CCRMEDS2",197,0)
|
||
. N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"MAPPED"))
|
||
"RTN","CCRMEDS2",198,0)
|
||
. K @RESULT
|
||
"RTN","CCRMEDS2",199,0)
|
||
. D MAP^GPLXPATH(MINXML,MAP,RESULT)
|
||
"RTN","CCRMEDS2",200,0)
|
||
. ; D PARY^GPLXPATH(RESULT)
|
||
"RTN","CCRMEDS2",201,0)
|
||
. ; MAPPING DIRECTIONS
|
||
"RTN","CCRMEDS2",202,0)
|
||
. N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
|
||
"RTN","CCRMEDS2",203,0)
|
||
. N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
|
||
"RTN","CCRMEDS2",204,0)
|
||
. D QUERY^GPLXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
|
||
"RTN","CCRMEDS2",205,0)
|
||
. D REPLACE^GPLXPATH(RESULT,"","//Medications/Medication/Directions")
|
||
"RTN","CCRMEDS2",206,0)
|
||
. ; N MDZ1,MDZNA
|
||
"RTN","CCRMEDS2",207,0)
|
||
. I DIRCNT>0 D ; IF THERE ARE DIRCTIONS
|
||
"RTN","CCRMEDS2",208,0)
|
||
. . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION
|
||
"RTN","CCRMEDS2",209,0)
|
||
. . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
|
||
"RTN","CCRMEDS2",210,0)
|
||
. . . D MAP^GPLXPATH(DIRXML1,MDZNA,DIRXML2)
|
||
"RTN","CCRMEDS2",211,0)
|
||
. . . D INSERT^GPLXPATH(RESULT,DIRXML2,"//Medications/Medication")
|
||
"RTN","CCRMEDS2",212,0)
|
||
. I MEDFIRST D ;
|
||
"RTN","CCRMEDS2",213,0)
|
||
. . S MEDFIRST=0 ; RESET FIRST FLAG
|
||
"RTN","CCRMEDS2",214,0)
|
||
. . D CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy
|
||
"RTN","CCRMEDS2",215,0)
|
||
. D:'MEDFIRST INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML
|
||
"RTN","CCRMEDS2",216,0)
|
||
N MEDTMP,MEDI
|
||
"RTN","CCRMEDS2",217,0)
|
||
D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
|
||
"RTN","CCRMEDS2",218,0)
|
||
I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
|
||
"RTN","CCRMEDS2",219,0)
|
||
. W "MEDICATION MISSING ",!
|
||
"RTN","CCRMEDS2",220,0)
|
||
. F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
|
||
"RTN","CCRMEDS2",221,0)
|
||
Q
|
||
"RTN","CCRMEDS2",222,0)
|
||
;
|
||
"RTN","CCRMEDS3")
|
||
0^24^B68176928
|
||
"RTN","CCRMEDS3",1,0)
|
||
CCRMEDS3 ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS - Outside_non-VA Meds;10/13/08
|
||
"RTN","CCRMEDS3",2,0)
|
||
;;0.1;CCDCCR;;;Build 15
|
||
"RTN","CCRMEDS3",3,0)
|
||
; Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
||
"RTN","CCRMEDS3",4,0)
|
||
; General Public License See attached copy of the License.
|
||
"RTN","CCRMEDS3",5,0)
|
||
;
|
||
"RTN","CCRMEDS3",6,0)
|
||
; This program is free software; you can redistribute it and/or modify
|
||
"RTN","CCRMEDS3",7,0)
|
||
; it under the terms of the GNU General Public License as published by
|
||
"RTN","CCRMEDS3",8,0)
|
||
; the Free Software Foundation; either version 2 of the License, or
|
||
"RTN","CCRMEDS3",9,0)
|
||
; (at your option) any later version.
|
||
"RTN","CCRMEDS3",10,0)
|
||
;
|
||
"RTN","CCRMEDS3",11,0)
|
||
; This program is distributed in the hope that it will be useful,
|
||
"RTN","CCRMEDS3",12,0)
|
||
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
"RTN","CCRMEDS3",13,0)
|
||
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
"RTN","CCRMEDS3",14,0)
|
||
; GNU General Public License for more details.
|
||
"RTN","CCRMEDS3",15,0)
|
||
;
|
||
"RTN","CCRMEDS3",16,0)
|
||
; You should have received a copy of the GNU General Public License along
|
||
"RTN","CCRMEDS3",17,0)
|
||
; with this program; if not, write to the Free Software Foundation, Inc.,
|
||
"RTN","CCRMEDS3",18,0)
|
||
; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
||
"RTN","CCRMEDS3",19,0)
|
||
;
|
||
"RTN","CCRMEDS3",20,0)
|
||
W "NO ENTRY FROM TOP",!
|
||
"RTN","CCRMEDS3",21,0)
|
||
Q
|
||
"RTN","CCRMEDS3",22,0)
|
||
;
|
||
"RTN","CCRMEDS3",23,0)
|
||
EXTRACT(MINXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
|
||
"RTN","CCRMEDS3",24,0)
|
||
;
|
||
"RTN","CCRMEDS3",25,0)
|
||
; MINXML is the Input XML Template, passed by name
|
||
"RTN","CCRMEDS3",26,0)
|
||
; DFN is Patient IEN
|
||
"RTN","CCRMEDS3",27,0)
|
||
; OUTXML is the resultant XML.
|
||
"RTN","CCRMEDS3",28,0)
|
||
;
|
||
"RTN","CCRMEDS3",29,0)
|
||
; MEDS is return array from RPC.
|
||
"RTN","CCRMEDS3",30,0)
|
||
; MAP is a mapping variable map (store result) for each med
|
||
"RTN","CCRMEDS3",31,0)
|
||
; MED is holds each array element from MEDS, one medicine
|
||
"RTN","CCRMEDS3",32,0)
|
||
;
|
||
"RTN","CCRMEDS3",33,0)
|
||
; Non-VA meds don't have an API. They are stored in file 55, subfile 52.2
|
||
"RTN","CCRMEDS3",34,0)
|
||
; Discontinued meds are indicated by the presence of a value in fields
|
||
"RTN","CCRMEDS3",35,0)
|
||
; 5 or 6 (STATUS 1 or 2, and DISCONTINUED DATE)
|
||
"RTN","CCRMEDS3",36,0)
|
||
; Will use Fileman API GETS^DIQ
|
||
"RTN","CCRMEDS3",37,0)
|
||
;
|
||
"RTN","CCRMEDS3",38,0)
|
||
N MEDS,MAP
|
||
"RTN","CCRMEDS3",39,0)
|
||
K ^TMP($J),NVA
|
||
"RTN","CCRMEDS3",40,0)
|
||
D GETS^DIQ(55,DFN,"52.2*","IE","NVA") ; Output in NVA in FDA array format.
|
||
"RTN","CCRMEDS3",41,0)
|
||
; If NVA does not exist, then patient has no non-VA meds
|
||
"RTN","CCRMEDS3",42,0)
|
||
I $D(NVA)=0 S @OUTXML@(0)=0 QUIT
|
||
"RTN","CCRMEDS3",43,0)
|
||
; Otherwise, we go on...
|
||
"RTN","CCRMEDS3",44,0)
|
||
M MEDS=NVA(55.05)
|
||
"RTN","CCRMEDS3",45,0)
|
||
; We are done with NVA
|
||
"RTN","CCRMEDS3",46,0)
|
||
K NVA
|
||
"RTN","CCRMEDS3",47,0)
|
||
;
|
||
"RTN","CCRMEDS3",48,0)
|
||
I DEBUG ZWR MEDS
|
||
"RTN","CCRMEDS3",49,0)
|
||
N FDAIEN S FDAIEN=0 ; For use in $Order in the MEDS array.
|
||
"RTN","CCRMEDS3",50,0)
|
||
S MEDMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP"))
|
||
"RTN","CCRMEDS3",51,0)
|
||
N MEDCOUNT S MEDCOUNT=@MEDMAP@(0) ; We already have meds in the array
|
||
"RTN","CCRMEDS3",52,0)
|
||
N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED PROCESSED HERE
|
||
"RTN","CCRMEDS3",53,0)
|
||
F S FDAIEN=$O(MEDS(FDAIEN)) Q:FDAIEN="" D ; FOR EACH MEDICATION IN THE LIST
|
||
"RTN","CCRMEDS3",54,0)
|
||
. N MED M MED=MEDS(FDAIEN)
|
||
"RTN","CCRMEDS3",55,0)
|
||
. I MED(5,"I")!MED(6,"I") QUIT ; If disconinued, we don't want to pull it.
|
||
"RTN","CCRMEDS3",56,0)
|
||
. S MEDCOUNT=MEDCOUNT+1
|
||
"RTN","CCRMEDS3",57,0)
|
||
. S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",MEDCOUNT))
|
||
"RTN","CCRMEDS3",58,0)
|
||
. S @MEDMAP@(0)=@MEDMAP@(0)+1 ; INCREMENT TOTAL MEDS IN VAR ARRAY
|
||
"RTN","CCRMEDS3",59,0)
|
||
. N RXIEN S RXIEN=$P(FDAIEN,",") ; First piece of FDAIEN is the number of the med for this patient
|
||
"RTN","CCRMEDS3",60,0)
|
||
. I DEBUG W "RXIEN IS ",RXIEN,!
|
||
"RTN","CCRMEDS3",61,0)
|
||
. I DEBUG W "MAP= ",MAP,!
|
||
"RTN","CCRMEDS3",62,0)
|
||
. S @MAP@("MEDOBJECTID")="MED_OUTSIDE"_MEDCOUNT ; MEDCOUNT FOR ID
|
||
"RTN","CCRMEDS3",63,0)
|
||
. S @MAP@("MEDISSUEDATETXT")="Documented Date"
|
||
"RTN","CCRMEDS3",64,0)
|
||
. ; Field 6 is "Effective date", and we pull it in timson format w/ I
|
||
"RTN","CCRMEDS3",65,0)
|
||
. S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL(MED(11,"I"),"DT")
|
||
"RTN","CCRMEDS3",66,0)
|
||
. ; Med never filled; next 4 fields are not applicable.
|
||
"RTN","CCRMEDS3",67,0)
|
||
. S @MAP@("MEDLASTFILLDATETXT")=""
|
||
"RTN","CCRMEDS3",68,0)
|
||
. S @MAP@("MEDLASTFILLDATE")=""
|
||
"RTN","CCRMEDS3",69,0)
|
||
. S @MAP@("MEDRXNOTXT")=""
|
||
"RTN","CCRMEDS3",70,0)
|
||
. S @MAP@("MEDRXNO")=""
|
||
"RTN","CCRMEDS3",71,0)
|
||
. S @MAP@("MEDTYPETEXT")="Medication"
|
||
"RTN","CCRMEDS3",72,0)
|
||
. S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses
|
||
"RTN","CCRMEDS3",73,0)
|
||
. S @MAP@("MEDSTATUSTEXT")="ACTIVE" ; nearest status for pending meds
|
||
"RTN","CCRMEDS3",74,0)
|
||
. S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_MED(12,"I")
|
||
"RTN","CCRMEDS3",75,0)
|
||
. S @MAP@("MEDPRODUCTNAMETEXT")=MED(.01,"E")
|
||
"RTN","CCRMEDS3",76,0)
|
||
. ; NDC is field 31 in the drug file.
|
||
"RTN","CCRMEDS3",77,0)
|
||
. ; The actual drug entry in the drug file is not necessarily supplied.
|
||
"RTN","CCRMEDS3",78,0)
|
||
. ; It' node 1, internal form.
|
||
"RTN","CCRMEDS3",79,0)
|
||
. N MEDIEN S MEDIEN=MED(1,"I")
|
||
"RTN","CCRMEDS3",80,0)
|
||
. S @MAP@("MEDPRODUCTNAMECODEVALUE")=$S($L(MEDIEN):$$GET1^DIQ(50,MEDIEN,31,"E"),1:"")
|
||
"RTN","CCRMEDS3",81,0)
|
||
. S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=$S($L(MEDIEN):"NDC",1:"")
|
||
"RTN","CCRMEDS3",82,0)
|
||
. S @MAP@("MEDPRODUCTNAMECODEVERSION")=$S($L(MEDIEN):"none",1:"")
|
||
"RTN","CCRMEDS3",83,0)
|
||
. S @MAP@("MEDBRANDNAMETEXT")=""
|
||
"RTN","CCRMEDS3",84,0)
|
||
. I $L(MEDIEN) D DOSE^PSS50(MEDIEN,,,,,"DOSE")
|
||
"RTN","CCRMEDS3",85,0)
|
||
. I $L(MEDIEN) N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
|
||
"RTN","CCRMEDS3",86,0)
|
||
. S @MAP@("MEDSTRENGTHVALUE")=$S($L(MEDIEN):DOSEDATA(901),1:"")
|
||
"RTN","CCRMEDS3",87,0)
|
||
. S @MAP@("MEDSTRENGTHUNIT")=$S($L(DOSEDATA(902))>0:$P(DOSEDATA(902),U,2),1:"") ; SAM PLEASE CHECK
|
||
"RTN","CCRMEDS3",88,0)
|
||
. ; Units, concentration, etc, come from another call
|
||
"RTN","CCRMEDS3",89,0)
|
||
. ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
|
||
"RTN","CCRMEDS3",90,0)
|
||
. ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
|
||
"RTN","CCRMEDS3",91,0)
|
||
. ; NDF Entry IEN, and VA Product Name
|
||
"RTN","CCRMEDS3",92,0)
|
||
. ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
|
||
"RTN","CCRMEDS3",93,0)
|
||
. ; Documented in the same manual.
|
||
"RTN","CCRMEDS3",94,0)
|
||
. N NDFDATA,CONCDATA
|
||
"RTN","CCRMEDS3",95,0)
|
||
. I $L(MEDIEN) D
|
||
"RTN","CCRMEDS3",96,0)
|
||
. . D NDF^PSS50(MEDIEN,,,,,"CONC")
|
||
"RTN","CCRMEDS3",97,0)
|
||
. . M NDFDATA=^TMP($J,"CONC",MEDIEN)
|
||
"RTN","CCRMEDS3",98,0)
|
||
. . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
|
||
"RTN","CCRMEDS3",99,0)
|
||
. . N VAPROD S VAPROD=$P(NDFDATA(22),U)
|
||
"RTN","CCRMEDS3",100,0)
|
||
. . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
|
||
"RTN","CCRMEDS3",101,0)
|
||
. . ; and this will crash the call. So...
|
||
"RTN","CCRMEDS3",102,0)
|
||
. . I NDFIEN="" S CONCDATA=""
|
||
"RTN","CCRMEDS3",103,0)
|
||
. . E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
|
||
"RTN","CCRMEDS3",104,0)
|
||
. E S (NDFDATA,CONCDATA)="" ; This line is defensive programming to prevent undef errors.
|
||
"RTN","CCRMEDS3",105,0)
|
||
. S @MAP@("MEDFORMTEXT")=$S($L(MEDIEN):$P(CONCDATA,U,1),1:"")
|
||
"RTN","CCRMEDS3",106,0)
|
||
. S @MAP@("MEDCONCVALUE")=$S($L(MEDIEN):$P(CONCDATA,U,3),1:"")
|
||
"RTN","CCRMEDS3",107,0)
|
||
. S @MAP@("MEDCONCUNIT")=$S($L(MEDIEN):$P(CONCDATA,U,4),1:"")
|
||
"RTN","CCRMEDS3",108,0)
|
||
. S @MAP@("MEDSIZETEXT")=$S($L(MEDIEN):$P(NDFDATA(23),U,2)_" "_$P(NDFDATA(24),U,2),1:"")
|
||
"RTN","CCRMEDS3",109,0)
|
||
. S @MAP@("MEDQUANTITYVALUE")="" ; not provided for in Non-VA meds.
|
||
"RTN","CCRMEDS3",110,0)
|
||
. ; Oddly, there is no easy place to find the dispense unit.
|
||
"RTN","CCRMEDS3",111,0)
|
||
. ; It's not included in the original call, so we have to go to the drug file.
|
||
"RTN","CCRMEDS3",112,0)
|
||
. ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
|
||
"RTN","CCRMEDS3",113,0)
|
||
. ; Node 14.5 is the Dispense Unit
|
||
"RTN","CCRMEDS3",114,0)
|
||
. I $L(MEDIEN) D
|
||
"RTN","CCRMEDS3",115,0)
|
||
. . D DATA^PSS50(MEDIEN,,,,,"QTY")
|
||
"RTN","CCRMEDS3",116,0)
|
||
. . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
|
||
"RTN","CCRMEDS3",117,0)
|
||
. . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
|
||
"RTN","CCRMEDS3",118,0)
|
||
. E S @MAP@("MEDQUANTITYUNIT")=""
|
||
"RTN","CCRMEDS3",119,0)
|
||
. ;
|
||
"RTN","CCRMEDS3",120,0)
|
||
. ; --- START OF DIRECTIONS ---
|
||
"RTN","CCRMEDS3",121,0)
|
||
. ; Dosage is field 2, route is 3, schedule is 4
|
||
"RTN","CCRMEDS3",122,0)
|
||
. ; These are all free text fields, and don't point to any files
|
||
"RTN","CCRMEDS3",123,0)
|
||
. ; For that reason, I will use the field I never used before:
|
||
"RTN","CCRMEDS3",124,0)
|
||
. ; MEDDIRECTIONDESCRIPTIONTEXT
|
||
"RTN","CCRMEDS3",125,0)
|
||
. S DIRCNT=1 ; THERE IS ONLY ONE DIRECTION FOR OUTSIDE MEDS
|
||
"RTN","CCRMEDS3",126,0)
|
||
. S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")
|
||
"RTN","CCRMEDS3",127,0)
|
||
. S @MAP@("M","DIRECTIONS",1,"MEDDOSEINDICATOR")="4" ; means look in description text. See E2369-05.
|
||
"RTN","CCRMEDS3",128,0)
|
||
. S @MAP@("M","DIRECTIONS",1,"MEDDELIVERYMETHOD")=""
|
||
"RTN","CCRMEDS3",129,0)
|
||
. S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")=""
|
||
"RTN","CCRMEDS3",130,0)
|
||
. S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")=""
|
||
"RTN","CCRMEDS3",131,0)
|
||
. S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")=""
|
||
"RTN","CCRMEDS3",132,0)
|
||
. S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")=""
|
||
"RTN","CCRMEDS3",133,0)
|
||
. S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")=""
|
||
"RTN","CCRMEDS3",134,0)
|
||
. S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")=""
|
||
"RTN","CCRMEDS3",135,0)
|
||
. S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")=""
|
||
"RTN","CCRMEDS3",136,0)
|
||
. S @MAP@("M","DIRECTIONS",1,"MEDINTERVALVALUE")=""
|
||
"RTN","CCRMEDS3",137,0)
|
||
. S @MAP@("M","DIRECTIONS",1,"MEDINTERVALUNIT")=""
|
||
"RTN","CCRMEDS3",138,0)
|
||
. S @MAP@("M","DIRECTIONS",1,"MEDDURATIONVALUE")=""
|
||
"RTN","CCRMEDS3",139,0)
|
||
. S @MAP@("M","DIRECTIONS",1,"MEDDURATIONUNIT")=""
|
||
"RTN","CCRMEDS3",140,0)
|
||
. S @MAP@("M","DIRECTIONS",1,"MEDPRNFLAG")=""
|
||
"RTN","CCRMEDS3",141,0)
|
||
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMOBJECTID")=""
|
||
"RTN","CCRMEDS3",142,0)
|
||
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMTYPETXT")=""
|
||
"RTN","CCRMEDS3",143,0)
|
||
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMDESCRIPTION")=""
|
||
"RTN","CCRMEDS3",144,0)
|
||
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODEVALUE")=""
|
||
"RTN","CCRMEDS3",145,0)
|
||
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGSYSTEM")=""
|
||
"RTN","CCRMEDS3",146,0)
|
||
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")=""
|
||
"RTN","CCRMEDS3",147,0)
|
||
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")=""
|
||
"RTN","CCRMEDS3",148,0)
|
||
. S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")=""
|
||
"RTN","CCRMEDS3",149,0)
|
||
. S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")=""
|
||
"RTN","CCRMEDS3",150,0)
|
||
. S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")=""
|
||
"RTN","CCRMEDS3",151,0)
|
||
. ;
|
||
"RTN","CCRMEDS3",152,0)
|
||
. ; --- END OF DIRECTIONS ---
|
||
"RTN","CCRMEDS3",153,0)
|
||
. ;
|
||
"RTN","CCRMEDS3",154,0)
|
||
. ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
|
||
"RTN","CCRMEDS3",155,0)
|
||
. I $D(MED(10,1)) D ;
|
||
"RTN","CCRMEDS3",156,0)
|
||
. . S @MAP@("MEDPTINSTRUCTIONS")=MED(10,1) ; WP Field
|
||
"RTN","CCRMEDS3",157,0)
|
||
. E S @MAP@("MEDPTINSTRUCTIONS")=""
|
||
"RTN","CCRMEDS3",158,0)
|
||
. I $D(MED(14,1)) D ;
|
||
"RTN","CCRMEDS3",159,0)
|
||
. . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MED(14,1) ; WP Field
|
||
"RTN","CCRMEDS3",160,0)
|
||
. E S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
|
||
"RTN","CCRMEDS3",161,0)
|
||
. S @MAP@("MEDRFNO")=""
|
||
"RTN","CCRMEDS3",162,0)
|
||
. N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"MAPPED"))
|
||
"RTN","CCRMEDS3",163,0)
|
||
. K @RESULT
|
||
"RTN","CCRMEDS3",164,0)
|
||
. D MAP^GPLXPATH(MINXML,MAP,RESULT)
|
||
"RTN","CCRMEDS3",165,0)
|
||
. ; D PARY^GPLXPATH(RESULT)
|
||
"RTN","CCRMEDS3",166,0)
|
||
. ; MAPPING DIRECTIONS
|
||
"RTN","CCRMEDS3",167,0)
|
||
. N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
|
||
"RTN","CCRMEDS3",168,0)
|
||
. N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
|
||
"RTN","CCRMEDS3",169,0)
|
||
. D QUERY^GPLXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
|
||
"RTN","CCRMEDS3",170,0)
|
||
. D REPLACE^GPLXPATH(RESULT,"","//Medications/Medication/Directions")
|
||
"RTN","CCRMEDS3",171,0)
|
||
. ; N MDZ1,MDZNA
|
||
"RTN","CCRMEDS3",172,0)
|
||
. I DIRCNT>0 D ; IF THERE ARE DIRCTIONS
|
||
"RTN","CCRMEDS3",173,0)
|
||
. . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION
|
||
"RTN","CCRMEDS3",174,0)
|
||
. . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
|
||
"RTN","CCRMEDS3",175,0)
|
||
. . . D MAP^GPLXPATH(DIRXML1,MDZNA,DIRXML2)
|
||
"RTN","CCRMEDS3",176,0)
|
||
. . . D INSERT^GPLXPATH(RESULT,DIRXML2,"//Medications/Medication")
|
||
"RTN","CCRMEDS3",177,0)
|
||
. I MEDFIRST D ;
|
||
"RTN","CCRMEDS3",178,0)
|
||
. . S MEDFIRST=0 ; RESET FIRST FLAG
|
||
"RTN","CCRMEDS3",179,0)
|
||
. . D CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy
|
||
"RTN","CCRMEDS3",180,0)
|
||
. D:'MEDFIRST INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML
|
||
"RTN","CCRMEDS3",181,0)
|
||
N MEDTMP,MEDI
|
||
"RTN","CCRMEDS3",182,0)
|
||
D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
|
||
"RTN","CCRMEDS3",183,0)
|
||
I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
|
||
"RTN","CCRMEDS3",184,0)
|
||
. W "MEDICATION MISSING ",!
|
||
"RTN","CCRMEDS3",185,0)
|
||
. F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
|
||
"RTN","CCRMEDS3",186,0)
|
||
Q
|
||
"RTN","CCRMEDS3",187,0)
|
||
;
|
||
"RTN","CCRSYS")
|
||
0^4^B5866233
|
||
"RTN","CCRSYS",1,0)
|
||
CCRSYS ;CCDCCR/SMH - Routine to Get EHR System Information;6JUL2008
|
||
"RTN","CCRSYS",2,0)
|
||
;;0.1;CCDCCR;;;Build 15
|
||
"RTN","CCRSYS",3,0)
|
||
;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
||
"RTN","CCRSYS",4,0)
|
||
;General Public License See attached copy of the License.
|
||
"RTN","CCRSYS",5,0)
|
||
;
|
||
"RTN","CCRSYS",6,0)
|
||
;This program is free software; you can redistribute it and/or modify
|
||
"RTN","CCRSYS",7,0)
|
||
;it under the terms of the GNU General Public License as published by
|
||
"RTN","CCRSYS",8,0)
|
||
;the Free Software Foundation; either version 2 of the License, or
|
||
"RTN","CCRSYS",9,0)
|
||
;(at your option) any later version.
|
||
"RTN","CCRSYS",10,0)
|
||
;
|
||
"RTN","CCRSYS",11,0)
|
||
;This program is distributed in the hope that it will be useful,
|
||
"RTN","CCRSYS",12,0)
|
||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
"RTN","CCRSYS",13,0)
|
||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
"RTN","CCRSYS",14,0)
|
||
;GNU General Public License for more details.
|
||
"RTN","CCRSYS",15,0)
|
||
;
|
||
"RTN","CCRSYS",16,0)
|
||
;You should have received a copy of the GNU General Public License along
|
||
"RTN","CCRSYS",17,0)
|
||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
||
"RTN","CCRSYS",18,0)
|
||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
||
"RTN","CCRSYS",19,0)
|
||
;
|
||
"RTN","CCRSYS",20,0)
|
||
W "Enter at appropriate points." Q
|
||
"RTN","CCRSYS",21,0)
|
||
;
|
||
"RTN","CCRSYS",22,0)
|
||
; Originally, I was going to use VEPERVER, but VEPERVER
|
||
"RTN","CCRSYS",23,0)
|
||
; actually kills ^TMP($J), outputs it to the screen in a user-friendly
|
||
"RTN","CCRSYS",24,0)
|
||
; manner (press any key to continue),
|
||
"RTN","CCRSYS",25,0)
|
||
; and is really a very half finished routine
|
||
"RTN","CCRSYS",26,0)
|
||
;
|
||
"RTN","CCRSYS",27,0)
|
||
; So for now, I am hard-coding the values.
|
||
"RTN","CCRSYS",28,0)
|
||
;
|
||
"RTN","CCRSYS",29,0)
|
||
SYSNAME() ;Get EHR System Name; PUBLIC; Extrinsic
|
||
"RTN","CCRSYS",30,0)
|
||
Q "WorldVistA EHR/VOE"
|
||
"RTN","CCRSYS",31,0)
|
||
;
|
||
"RTN","CCRSYS",32,0)
|
||
SYSVER() ;Get EHR System Version; PUBLIC; Extrinsic
|
||
"RTN","CCRSYS",33,0)
|
||
Q "1.0"
|
||
"RTN","CCRSYS",34,0)
|
||
;
|
||
"RTN","CCRSYS",35,0)
|
||
PTST(DFN) ;TEST TO SEE IF PATIENT MERGED OR A TEST PATIENT
|
||
"RTN","CCRSYS",36,0)
|
||
; DFN = IEN of the Patient to be tested
|
||
"RTN","CCRSYS",37,0)
|
||
; 1 = Merged or Test Patient
|
||
"RTN","CCRSYS",38,0)
|
||
; 0 = Non-test Patient
|
||
"RTN","CCRSYS",39,0)
|
||
;
|
||
"RTN","CCRSYS",40,0)
|
||
I DFN="" Q 0 ; BAD DFN PASSED
|
||
"RTN","CCRSYS",41,0)
|
||
I $D(^DPT(DFN,-9)) Q 1 ;This patient has been merged
|
||
"RTN","CCRSYS",42,0)
|
||
I $G(^DPT(DFN,0))="" Q 1 ;Missing zeroth node <---add
|
||
"RTN","CCRSYS",43,0)
|
||
;
|
||
"RTN","CCRSYS",44,0)
|
||
I '$D(CCRTEST) S CCRTEST=1 ; DEFAULT IS THAT WE ARE TESTING
|
||
"RTN","CCRSYS",45,0)
|
||
I CCRTEST Q 0 ; IF WE ARE TESTING, DON'T REJECT TEST PATIENTS
|
||
"RTN","CCRSYS",46,0)
|
||
N DIERR,DATA
|
||
"RTN","CCRSYS",47,0)
|
||
I $$TESTPAT^VADPT(DFN) Q 1 ; QUIT IF IT'S A VA TEST PATIENT
|
||
"RTN","CCRSYS",48,0)
|
||
S DATA=+$$GET1^DIQ(2,DFN_",",.6,"I") ;Test Patient Indicator
|
||
"RTN","CCRSYS",49,0)
|
||
; 1 = Test Patient
|
||
"RTN","CCRSYS",50,0)
|
||
; 0 = Non-test Patient
|
||
"RTN","CCRSYS",51,0)
|
||
I DATA Q DATA
|
||
"RTN","CCRSYS",52,0)
|
||
S DATA=$$GET1^DIQ(2,DFN_",",.09,"I") ;SSN test
|
||
"RTN","CCRSYS",53,0)
|
||
D CLEAN^DILF
|
||
"RTN","CCRSYS",54,0)
|
||
I "Pp"[$E(DATA,$L(DATA),$L(DATA)) Q 0 ;Allow Pseudo SSN
|
||
"RTN","CCRSYS",55,0)
|
||
I $E(DATA,1,3)="000" Q 1
|
||
"RTN","CCRSYS",56,0)
|
||
I $E(DATA,1,3)="666" Q 1
|
||
"RTN","CCRSYS",57,0)
|
||
Q 0
|
||
"RTN","CCRSYS",58,0)
|
||
;
|
||
"RTN","CCRUNIT")
|
||
0^5^B8574
|
||
"RTN","CCRUNIT",1,0)
|
||
CCRUNIT ; A routine that tests some crap
|
||
"RTN","CCRUNIT",2,0)
|
||
;;0.1;CCDCCR;;JUL 13, 2007;Build 15
|
||
"RTN","CCRUNIT",3,0)
|
||
Q
|
||
"RTN","CCRUNIT",4,0)
|
||
;
|
||
"RTN","CCRUNIT",5,0)
|
||
MEDS
|
||
"RTN","CCRUNIT",6,0)
|
||
N DEBUG S DEBUG=0
|
||
"RTN","CCRUNIT",7,0)
|
||
N DFN S DFN=1
|
||
"RTN","CCRUNIT",8,0)
|
||
K ^TMP($J)
|
||
"RTN","CCRUNIT",9,0)
|
||
W "Loading CCR Template into T using LOAD^GPLCCR0($NA(^TMP($J,""CCR"")))",!!
|
||
"RTN","CCRUNIT",10,0)
|
||
N T S T=$NA(^TMP($J,"CCR")) D LOAD^GPLCCR0(T)
|
||
"RTN","CCRUNIT",11,0)
|
||
N XPATH S XPATH="//ContinuityOfCareRecord/Body/Medications"
|
||
"RTN","CCRUNIT",12,0)
|
||
W "XPATH is: "_XPATH,!
|
||
"RTN","CCRUNIT",13,0)
|
||
W "Getting Med Template into MINXML using",!
|
||
"RTN","CCRUNIT",14,0)
|
||
W "QUERY^GPLXPATH(T,XPATH,""MINXML"")",!!
|
||
"RTN","CCRUNIT",15,0)
|
||
D QUERY^GPLXPATH(T,XPATH,"MINXML")
|
||
"RTN","CCRUNIT",16,0)
|
||
W "Executing EXTRACT^CCRMEDS(MINXML,DFN,OUTXML)",!
|
||
"RTN","CCRUNIT",17,0)
|
||
W "OUTXML will be ^TMP($J,""OUT"")",!
|
||
"RTN","CCRUNIT",18,0)
|
||
N OUTXML S OUTXML=$NA(^TMP($J,"OUT"))
|
||
"RTN","CCRUNIT",19,0)
|
||
D EXTRACT^CCRMEDS($NA(MINXML),DFN,OUTXML)
|
||
"RTN","CCRUNIT",20,0)
|
||
Q
|
||
"RTN","CCRUTIL")
|
||
0^6^B12964247
|
||
"RTN","CCRUTIL",1,0)
|
||
CCRUTIL ;CCRCCD/SMH - Various Utilites for generating the CCR/CCD;06/15/08
|
||
"RTN","CCRUTIL",2,0)
|
||
;;0.1;CCRCCD;;Jun 15, 2008;Build 15
|
||
"RTN","CCRUTIL",3,0)
|
||
;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
||
"RTN","CCRUTIL",4,0)
|
||
;General Public License See attached copy of the License.
|
||
"RTN","CCRUTIL",5,0)
|
||
;
|
||
"RTN","CCRUTIL",6,0)
|
||
;This program is free software; you can redistribute it and/or modify
|
||
"RTN","CCRUTIL",7,0)
|
||
;it under the terms of the GNU General Public License as published by
|
||
"RTN","CCRUTIL",8,0)
|
||
;the Free Software Foundation; either version 2 of the License, or
|
||
"RTN","CCRUTIL",9,0)
|
||
;(at your option) any later version.
|
||
"RTN","CCRUTIL",10,0)
|
||
;
|
||
"RTN","CCRUTIL",11,0)
|
||
;This program is distributed in the hope that it will be useful,
|
||
"RTN","CCRUTIL",12,0)
|
||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
"RTN","CCRUTIL",13,0)
|
||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
"RTN","CCRUTIL",14,0)
|
||
;GNU General Public License for more details.
|
||
"RTN","CCRUTIL",15,0)
|
||
;
|
||
"RTN","CCRUTIL",16,0)
|
||
;You should have received a copy of the GNU General Public License along
|
||
"RTN","CCRUTIL",17,0)
|
||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
||
"RTN","CCRUTIL",18,0)
|
||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
||
"RTN","CCRUTIL",19,0)
|
||
;
|
||
"RTN","CCRUTIL",20,0)
|
||
W "No Entry at Top!"
|
||
"RTN","CCRUTIL",21,0)
|
||
Q
|
||
"RTN","CCRUTIL",22,0)
|
||
;
|
||
"RTN","CCRUTIL",23,0)
|
||
FMDTOUTC(DATE,FORMAT) ; Convert Fileman Date to UTC Date Format; PUBLIC; Extrinsic
|
||
"RTN","CCRUTIL",24,0)
|
||
; FORMAT is Format of Date. Can be either D (Day) or DT (Date and Time)
|
||
"RTN","CCRUTIL",25,0)
|
||
; If not passed, or passed incorrectly, it's assumed that it is D.
|
||
"RTN","CCRUTIL",26,0)
|
||
; FM Date format is "YYYMMDD.HHMMSS" HHMMSS may not be supplied.
|
||
"RTN","CCRUTIL",27,0)
|
||
; UTC date is formatted as follows: YYYY-MM-DDThh:mm:ss_offsetfromUTC
|
||
"RTN","CCRUTIL",28,0)
|
||
; UTC, Year, Month, Day, Hours, Minutes, Seconds, Time offset (obtained from Mailman Site Parameters)
|
||
"RTN","CCRUTIL",29,0)
|
||
N UTC,Y,M,D,H,MM,S,OFF
|
||
"RTN","CCRUTIL",30,0)
|
||
S Y=1700+$E(DATE,1,3)
|
||
"RTN","CCRUTIL",31,0)
|
||
S M=$E(DATE,4,5)
|
||
"RTN","CCRUTIL",32,0)
|
||
S D=$E(DATE,6,7)
|
||
"RTN","CCRUTIL",33,0)
|
||
S H=$E(DATE,9,10)
|
||
"RTN","CCRUTIL",34,0)
|
||
I $L(H)=1 S H="0"_H
|
||
"RTN","CCRUTIL",35,0)
|
||
S MM=$E(DATE,11,12)
|
||
"RTN","CCRUTIL",36,0)
|
||
I $L(MM)=1 S MM="0"_MM
|
||
"RTN","CCRUTIL",37,0)
|
||
S S=$E(DATE,13,14)
|
||
"RTN","CCRUTIL",38,0)
|
||
I $L(S)=1 S S="0"_S
|
||
"RTN","CCRUTIL",39,0)
|
||
S OFF=$$TZ^XLFDT ; See Kernel Manual for documentation.
|
||
"RTN","CCRUTIL",40,0)
|
||
S OFFS=$E(OFF,1,1)
|
||
"RTN","CCRUTIL",41,0)
|
||
S OFF0=$TR(OFF,"+-")
|
||
"RTN","CCRUTIL",42,0)
|
||
S OFF1=$E(OFF0+10000,2,3)
|
||
"RTN","CCRUTIL",43,0)
|
||
S OFF2=$E(OFF0+10000,4,5)
|
||
"RTN","CCRUTIL",44,0)
|
||
S OFF=OFFS_OFF1_":"_OFF2
|
||
"RTN","CCRUTIL",45,0)
|
||
;S OFF2=$E(OFF,1,2) ;
|
||
"RTN","CCRUTIL",46,0)
|
||
;S OFF2=$E(100+OFF2,2,3) ; GPL 11/08 CHANGED TO -05:00 FORMAT
|
||
"RTN","CCRUTIL",47,0)
|
||
;S OFF3=$E(OFF,3,4) ;MINUTES
|
||
"RTN","CCRUTIL",48,0)
|
||
;S OFF=$S(OFF2="":"00",0:"00",1:OFF2)_"."_$S(OFF3="":"00",1:OFF3)
|
||
"RTN","CCRUTIL",49,0)
|
||
; If H, MM and S are empty, it means that the FM date didn't supply the time.
|
||
"RTN","CCRUTIL",50,0)
|
||
; In this case, set H, MM and S to "00"
|
||
"RTN","CCRUTIL",51,0)
|
||
; S:('$L(H)&'$L(MM)&'$L(S)) (H,MM,S)="00" ; IF ONLY SOME ARE MISSING?
|
||
"RTN","CCRUTIL",52,0)
|
||
S:'$L(H) H="00"
|
||
"RTN","CCRUTIL",53,0)
|
||
S:'$L(MM) MM="00"
|
||
"RTN","CCRUTIL",54,0)
|
||
S:'$L(S) S="00"
|
||
"RTN","CCRUTIL",55,0)
|
||
S UTC=Y_"-"_M_"-"_D_"T"_H_":"_MM_$S(S="":":00",1:":"_S)_OFF ; Skip's code to fix hanging colon if no seconds
|
||
"RTN","CCRUTIL",56,0)
|
||
I $L($G(FORMAT)),FORMAT="DT" Q UTC ; Date with time.
|
||
"RTN","CCRUTIL",57,0)
|
||
E Q $P(UTC,"T")
|
||
"RTN","CCRUTIL",58,0)
|
||
;
|
||
"RTN","CCRUTIL",59,0)
|
||
SORTDT(V1,V2,ORDR) ; DATE SORT ARRAY AND RETURN INDEX IN V1 AND COUNT
|
||
"RTN","CCRUTIL",60,0)
|
||
; AS EXTRINSIC ORDR IS 1 OR -1 FOR FORWARD OR REVERSE
|
||
"RTN","CCRUTIL",61,0)
|
||
; DATE AND TIME ORDER. DEFAULT IS FORWARD
|
||
"RTN","CCRUTIL",62,0)
|
||
; V2 IS AN ARRAY OF DATES IN FILEMAN FORMAT
|
||
"RTN","CCRUTIL",63,0)
|
||
; V1 IS RETURNS INDIRECT INDEXES OF V2 IN REVERSE DATE ORDER
|
||
"RTN","CCRUTIL",64,0)
|
||
; SO V2(V1(X)) WILL RETURN THE DATES IN DATE/TIME ORDER
|
||
"RTN","CCRUTIL",65,0)
|
||
; THE COUNT OF THE DATES IS RETURNED AS AN EXTRINSIC
|
||
"RTN","CCRUTIL",66,0)
|
||
; BOTH V1 AND V2 ARE PASSED BY REFERENCE
|
||
"RTN","CCRUTIL",67,0)
|
||
N VSRT ; TEMP FOR HASHING DATES
|
||
"RTN","CCRUTIL",68,0)
|
||
N ZI,ZJ,ZTMP,ZCNT,ZP1,ZP2
|
||
"RTN","CCRUTIL",69,0)
|
||
S ZCNT=V2(0) ; COUNTING NUMBER OF DATES
|
||
"RTN","CCRUTIL",70,0)
|
||
F ZI=1:1:ZCNT D ; FOR EACH DATE IN THE ARRAY
|
||
"RTN","CCRUTIL",71,0)
|
||
. I $D(V2(ZI)) D ; IF THE DATE EXISTS
|
||
"RTN","CCRUTIL",72,0)
|
||
. . S ZP1=$P(V2(ZI),".",1) ; THE DATE PIECE
|
||
"RTN","CCRUTIL",73,0)
|
||
. . S ZP2=$P(V2(ZI),".",2) ; THE TIME PIECE
|
||
"RTN","CCRUTIL",74,0)
|
||
. . ; W "DATE: ",ZP1," TIME: ",ZP2,!
|
||
"RTN","CCRUTIL",75,0)
|
||
. . S VSRT(ZP1,ZP2,ZI)=ZI ; INDEX OF DATE, TIME AND COUNT
|
||
"RTN","CCRUTIL",76,0)
|
||
N ZG
|
||
"RTN","CCRUTIL",77,0)
|
||
S ZG=$Q(VSRT(""))
|
||
"RTN","CCRUTIL",78,0)
|
||
F D Q:ZG="" ;
|
||
"RTN","CCRUTIL",79,0)
|
||
. ; W ZG,!
|
||
"RTN","CCRUTIL",80,0)
|
||
. D PUSH^GPLXPATH("V1",@ZG)
|
||
"RTN","CCRUTIL",81,0)
|
||
. S ZG=$Q(@ZG)
|
||
"RTN","CCRUTIL",82,0)
|
||
I ORDR=-1 D ; HAVE TO REVERSE ORDER
|
||
"RTN","CCRUTIL",83,0)
|
||
. N ZG2
|
||
"RTN","CCRUTIL",84,0)
|
||
. F ZI=1:1:V1(0) D ; FOR EACH ELELMENT
|
||
"RTN","CCRUTIL",85,0)
|
||
. . S ZG2(V1(0)-ZI+1)=V1(ZI) ; SET IN REVERSE ORDER
|
||
"RTN","CCRUTIL",86,0)
|
||
. S ZG2(0)=V1(0)
|
||
"RTN","CCRUTIL",87,0)
|
||
. D CP^GPLXPATH("ZG2","V1") ; COPY OVER THE NEW ARRAY
|
||
"RTN","CCRUTIL",88,0)
|
||
Q ZCNT
|
||
"RTN","CCRUTIL",89,0)
|
||
;
|
||
"RTN","CCRUTIL",90,0)
|
||
DA2SNO(RTN,DNAME) ; LOOK UP DRUG ALLERGY CODE IN ^LEX
|
||
"RTN","CCRUTIL",91,0)
|
||
; RETURNS AN ARRAY RTN PASSED BY REFERENCE
|
||
"RTN","CCRUTIL",92,0)
|
||
; THIS ROUTINE CAN BE USED AS AN RPC
|
||
"RTN","CCRUTIL",93,0)
|
||
; RTN(0) IS THE NUMBER OF ELEMENTS IN THE ARRAY
|
||
"RTN","CCRUTIL",94,0)
|
||
; RTN(1) IS THE SNOMED CODE FOR THE DRUG ALLERGY
|
||
"RTN","CCRUTIL",95,0)
|
||
;
|
||
"RTN","CCRUTIL",96,0)
|
||
N LEXIEN
|
||
"RTN","CCRUTIL",97,0)
|
||
I $O(^LEX(757.21,"ADIS",DNAME,""))'="" D ; IEN FOUND FOR THIS DRUG
|
||
"RTN","CCRUTIL",98,0)
|
||
. S LEXIEN=$O(^LEX(757.21,"ADIS",DNAME,"")) ; GET THE IEN IN THE LEXICON
|
||
"RTN","CCRUTIL",99,0)
|
||
. W LEXIEN,!
|
||
"RTN","CCRUTIL",100,0)
|
||
. S RTN(1)=$P(^LEX(757.02,LEXIEN,0),"^",2) ; SNOMED CODE IN P2
|
||
"RTN","CCRUTIL",101,0)
|
||
. S RTN(0)=1 ; ONE THING RETURNED
|
||
"RTN","CCRUTIL",102,0)
|
||
E S RTN(0)=0 ; NOT FOUND
|
||
"RTN","CCRUTIL",103,0)
|
||
Q
|
||
"RTN","CCRUTIL",104,0)
|
||
;
|
||
"RTN","CCRUTIL",105,0)
|
||
DASNO(DANAME) ; PRINTS THE SNOMED CODE FOR ALLERGY TO DRUG DANAME
|
||
"RTN","CCRUTIL",106,0)
|
||
;
|
||
"RTN","CCRUTIL",107,0)
|
||
N DARTN
|
||
"RTN","CCRUTIL",108,0)
|
||
D DA2SNO(.DARTN,DANAME) ; CALL THE LOOKUP ROUTINE
|
||
"RTN","CCRUTIL",109,0)
|
||
I DARTN(0)>0 D ; GOT RESULTS
|
||
"RTN","CCRUTIL",110,0)
|
||
. W !,DARTN(1) ;PRINT THE SNOMED CODE
|
||
"RTN","CCRUTIL",111,0)
|
||
E W !,"NOT FOUND",!
|
||
"RTN","CCRUTIL",112,0)
|
||
Q
|
||
"RTN","CCRUTIL",113,0)
|
||
;
|
||
"RTN","CCRUTIL",114,0)
|
||
DASNALL(WHICH) ; ROUTINE TO EXAMINE THE ADIS INDEX IN LEX AND RETRIEVE ALL
|
||
"RTN","CCRUTIL",115,0)
|
||
; ASSOCIATED SNOMED CODES
|
||
"RTN","CCRUTIL",116,0)
|
||
N DASTMP,DASIEN,DASNO
|
||
"RTN","CCRUTIL",117,0)
|
||
S DASTMP=""
|
||
"RTN","CCRUTIL",118,0)
|
||
F S DASTMP=$O(^LEX(757.21,WHICH,DASTMP)) Q:DASTMP="" D ; NAME OF MED
|
||
"RTN","CCRUTIL",119,0)
|
||
. S DASIEN=$O(^LEX(757.21,WHICH,DASTMP,"")) ; IEN OF MED
|
||
"RTN","CCRUTIL",120,0)
|
||
. S DASNO=$P(^LEX(757.02,DASIEN,0),"^",2) ; SNOMED CODE FOR ENTRY
|
||
"RTN","CCRUTIL",121,0)
|
||
. W DASTMP,"=",DASNO,! ; PRINT IT OUT
|
||
"RTN","CCRUTIL",122,0)
|
||
Q
|
||
"RTN","CCRUTIL",123,0)
|
||
;
|
||
"RTN","CCRVA200")
|
||
0^7^B35847405
|
||
"RTN","CCRVA200",1,0)
|
||
CCRVA200 ;WV/CCDCCR/SMH - Routine to get Provider Data;07/13/2008
|
||
"RTN","CCRVA200",2,0)
|
||
;;0.1;CCDCCR;;JUL 13, 2007;Build 15
|
||
"RTN","CCRVA200",3,0)
|
||
;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
||
"RTN","CCRVA200",4,0)
|
||
;General Public License See attached copy of the License.
|
||
"RTN","CCRVA200",5,0)
|
||
;
|
||
"RTN","CCRVA200",6,0)
|
||
;This program is free software; you can redistribute it and/or modify
|
||
"RTN","CCRVA200",7,0)
|
||
;it under the terms of the GNU General Public License as published by
|
||
"RTN","CCRVA200",8,0)
|
||
;the Free Software Foundation; either version 2 of the License, or
|
||
"RTN","CCRVA200",9,0)
|
||
;(at your option) any later version.
|
||
"RTN","CCRVA200",10,0)
|
||
;
|
||
"RTN","CCRVA200",11,0)
|
||
;This program is distributed in the hope that it will be useful,
|
||
"RTN","CCRVA200",12,0)
|
||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
"RTN","CCRVA200",13,0)
|
||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
"RTN","CCRVA200",14,0)
|
||
;GNU General Public License for more details.
|
||
"RTN","CCRVA200",15,0)
|
||
;
|
||
"RTN","CCRVA200",16,0)
|
||
;You should have received a copy of the GNU General Public License along
|
||
"RTN","CCRVA200",17,0)
|
||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
||
"RTN","CCRVA200",18,0)
|
||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
||
"RTN","CCRVA200",19,0)
|
||
Q
|
||
"RTN","CCRVA200",20,0)
|
||
; This routine uses Kernel APIs and Direct Global Access to get
|
||
"RTN","CCRVA200",21,0)
|
||
; Proivder Data from File 200.
|
||
"RTN","CCRVA200",22,0)
|
||
;
|
||
"RTN","CCRVA200",23,0)
|
||
; The Global is VA(200,*)
|
||
"RTN","CCRVA200",24,0)
|
||
;
|
||
"RTN","CCRVA200",25,0)
|
||
FAMILY(DUZ) ; Get Family Name; PUBLIC; EXTRINSIC
|
||
"RTN","CCRVA200",26,0)
|
||
; INPUT: DUZ (i.e. File 200 IEN) ByVal
|
||
"RTN","CCRVA200",27,0)
|
||
; OUTPUT: String
|
||
"RTN","CCRVA200",28,0)
|
||
N NAME S NAME=$P(^VA(200,DUZ,0),U)
|
||
"RTN","CCRVA200",29,0)
|
||
D NAMECOMP^XLFNAME(.NAME)
|
||
"RTN","CCRVA200",30,0)
|
||
Q NAME("FAMILY")
|
||
"RTN","CCRVA200",31,0)
|
||
;
|
||
"RTN","CCRVA200",32,0)
|
||
GIVEN(DUZ) ; Get Given Name; PUBLIC; EXTRINSIC
|
||
"RTN","CCRVA200",33,0)
|
||
; INPUT: DUZ ByVal
|
||
"RTN","CCRVA200",34,0)
|
||
; OUTPUT: String
|
||
"RTN","CCRVA200",35,0)
|
||
N NAME S NAME=$P(^VA(200,DUZ,0),U)
|
||
"RTN","CCRVA200",36,0)
|
||
D NAMECOMP^XLFNAME(.NAME)
|
||
"RTN","CCRVA200",37,0)
|
||
Q NAME("GIVEN")
|
||
"RTN","CCRVA200",38,0)
|
||
;
|
||
"RTN","CCRVA200",39,0)
|
||
MIDDLE(DUZ) ; Get Middle Name, PUBLIC; EXTRINSIC
|
||
"RTN","CCRVA200",40,0)
|
||
; INPUT: DUZ ByVal
|
||
"RTN","CCRVA200",41,0)
|
||
; OUTPUT: String
|
||
"RTN","CCRVA200",42,0)
|
||
N NAME S NAME=$P(^VA(200,DUZ,0),U)
|
||
"RTN","CCRVA200",43,0)
|
||
D NAMECOMP^XLFNAME(.NAME)
|
||
"RTN","CCRVA200",44,0)
|
||
Q NAME("MIDDLE")
|
||
"RTN","CCRVA200",45,0)
|
||
;
|
||
"RTN","CCRVA200",46,0)
|
||
SUFFIX(DUZ) ; Get Suffix Name, PUBLIC; EXTRINSIC
|
||
"RTN","CCRVA200",47,0)
|
||
; INPUT: DUZ ByVal
|
||
"RTN","CCRVA200",48,0)
|
||
; OUTPUT: String
|
||
"RTN","CCRVA200",49,0)
|
||
N NAME S NAME=$P(^VA(200,DUZ,0),U)
|
||
"RTN","CCRVA200",50,0)
|
||
D NAMECOMP^XLFNAME(.NAME)
|
||
"RTN","CCRVA200",51,0)
|
||
Q NAME("SUFFIX")
|
||
"RTN","CCRVA200",52,0)
|
||
;
|
||
"RTN","CCRVA200",53,0)
|
||
TITLE(DUZ) ; Get Title for Proivder, PUBLIC; EXTRINSIC
|
||
"RTN","CCRVA200",54,0)
|
||
; INPUT: DUZ ByVal
|
||
"RTN","CCRVA200",55,0)
|
||
; OUTPUT: String
|
||
"RTN","CCRVA200",56,0)
|
||
; Gets External Value of Title field in New Person File.
|
||
"RTN","CCRVA200",57,0)
|
||
; It's actually a pointer to file 3.1
|
||
"RTN","CCRVA200",58,0)
|
||
; 200=New Person File; 8 is Title Field
|
||
"RTN","CCRVA200",59,0)
|
||
Q $$GET1^DIQ(200,DUZ_",",8)
|
||
"RTN","CCRVA200",60,0)
|
||
;
|
||
"RTN","CCRVA200",61,0)
|
||
NPI(DUZ) ; Get NPI Number, PUBLIC; EXTRINSIC
|
||
"RTN","CCRVA200",62,0)
|
||
; INPUT: DUZ ByVal
|
||
"RTN","CCRVA200",63,0)
|
||
; OUTPUT: Delimited String in format:
|
||
"RTN","CCRVA200",64,0)
|
||
; IDType^ID^IDDescription
|
||
"RTN","CCRVA200",65,0)
|
||
; If the NPI doesn't exist, "" is returned.
|
||
"RTN","CCRVA200",66,0)
|
||
; This routine uses a call documented in the Kernel dev guide
|
||
"RTN","CCRVA200",67,0)
|
||
; This call returns as "NPI^TimeEntered^ActiveInactive"
|
||
"RTN","CCRVA200",68,0)
|
||
; It returns -1 for NPI if NPI doesn't exist.
|
||
"RTN","CCRVA200",69,0)
|
||
N NPI S NPI=$P($$NPI^XUSNPI("Individual_ID",DUZ),U)
|
||
"RTN","CCRVA200",70,0)
|
||
Q:NPI=-1 ""
|
||
"RTN","CCRVA200",71,0)
|
||
Q "NPI^"_NPI_"^HHS"
|
||
"RTN","CCRVA200",72,0)
|
||
;
|
||
"RTN","CCRVA200",73,0)
|
||
SPEC(DUZ) ; Get Provider Specialty, PUBLIC; EXTRINSIC
|
||
"RTN","CCRVA200",74,0)
|
||
; INPUT: DUZ ByVal
|
||
"RTN","CCRVA200",75,0)
|
||
; OUTPUT: String: ProviderType/Specialty/Subspecialty OR ""
|
||
"RTN","CCRVA200",76,0)
|
||
; Uses a Kernel API. Returns -1 if a specialty is not specified
|
||
"RTN","CCRVA200",77,0)
|
||
; in file 200.
|
||
"RTN","CCRVA200",78,0)
|
||
; Otherwise, returns IEN^Profession^Specialty^Subspecialty^Effect date^Expired date^VA code
|
||
"RTN","CCRVA200",79,0)
|
||
N STR S STR=$$GET^XUA4A72(DUZ)
|
||
"RTN","CCRVA200",80,0)
|
||
Q:+STR<0 ""
|
||
"RTN","CCRVA200",81,0)
|
||
; Sometimes we have 3 pieces, or 2. Deal with that.
|
||
"RTN","CCRVA200",82,0)
|
||
Q:$L($P(STR,U,4)) $P(STR,U,2)_"-"_$P(STR,U,3)_"-"_$P(STR,U,4)
|
||
"RTN","CCRVA200",83,0)
|
||
Q $P(STR,U,2)_"-"_$P(STR,U,3)
|
||
"RTN","CCRVA200",84,0)
|
||
;
|
||
"RTN","CCRVA200",85,0)
|
||
ADDTYPE(DUZ) ; Get Address Type, PUBLIC; EXTRINSIC
|
||
"RTN","CCRVA200",86,0)
|
||
; INPUT: DUZ, but not needed really... here for future expansion
|
||
"RTN","CCRVA200",87,0)
|
||
; OUTPUT: At this point "Work"
|
||
"RTN","CCRVA200",88,0)
|
||
Q "Work"
|
||
"RTN","CCRVA200",89,0)
|
||
;
|
||
"RTN","CCRVA200",90,0)
|
||
ADDLINE1(DUZ) ; Get Address associated with this instituation; PUBLIC; EXTRINSIC
|
||
"RTN","CCRVA200",91,0)
|
||
; INPUT: DUZ ByVal
|
||
"RTN","CCRVA200",92,0)
|
||
; Output: String.
|
||
"RTN","CCRVA200",93,0)
|
||
;
|
||
"RTN","CCRVA200",94,0)
|
||
; First, get site number from the institution file.
|
||
"RTN","CCRVA200",95,0)
|
||
; 1st piece returned by $$SITE^VASITE, which gets the system institution
|
||
"RTN","CCRVA200",96,0)
|
||
N INST S INST=$P($$SITE^VASITE(),U)
|
||
"RTN","CCRVA200",97,0)
|
||
;
|
||
"RTN","CCRVA200",98,0)
|
||
; Second, get mailing address
|
||
"RTN","CCRVA200",99,0)
|
||
; There are two APIs to get the address, one for physical and one for
|
||
"RTN","CCRVA200",100,0)
|
||
; mailing. We will check if mailing exists first, since that's the
|
||
"RTN","CCRVA200",101,0)
|
||
; one we want to use; then check for physical. If neither exists,
|
||
"RTN","CCRVA200",102,0)
|
||
; then we return nothing. We check for the existence of an address
|
||
"RTN","CCRVA200",103,0)
|
||
; by the length of the returned string.
|
||
"RTN","CCRVA200",104,0)
|
||
; NOTE: API doesn't support Address 2, so I won't even include it
|
||
"RTN","CCRVA200",105,0)
|
||
; in the template.
|
||
"RTN","CCRVA200",106,0)
|
||
N ADD
|
||
"RTN","CCRVA200",107,0)
|
||
S ADD=$$MADD^XUAF4(INST) ; mailing address
|
||
"RTN","CCRVA200",108,0)
|
||
Q:$L(ADD) $P(ADD,U)
|
||
"RTN","CCRVA200",109,0)
|
||
S ADD=$$PADD^XUAF4(INST) ; physical address
|
||
"RTN","CCRVA200",110,0)
|
||
Q:$L(ADD) $P(ADD,U)
|
||
"RTN","CCRVA200",111,0)
|
||
Q ""
|
||
"RTN","CCRVA200",112,0)
|
||
;
|
||
"RTN","CCRVA200",113,0)
|
||
CITY(DUZ) ; Get City for Institution. PUBLIC; EXTRINSIC
|
||
"RTN","CCRVA200",114,0)
|
||
; INPUT: DUZ ByVal
|
||
"RTN","CCRVA200",115,0)
|
||
; Output: String.
|
||
"RTN","CCRVA200",116,0)
|
||
; See ADD1 for comments
|
||
"RTN","CCRVA200",117,0)
|
||
N INST S INST=$P($$SITE^VASITE(),U)
|
||
"RTN","CCRVA200",118,0)
|
||
N ADD
|
||
"RTN","CCRVA200",119,0)
|
||
S ADD=$$MADD^XUAF4(INST) ; mailing address
|
||
"RTN","CCRVA200",120,0)
|
||
Q:$L(ADD) $P(ADD,U,2)
|
||
"RTN","CCRVA200",121,0)
|
||
S ADD=$$PADD^XUAF4(INST) ; physical address
|
||
"RTN","CCRVA200",122,0)
|
||
Q:$L(ADD) $P(ADD,U,2)
|
||
"RTN","CCRVA200",123,0)
|
||
Q ""
|
||
"RTN","CCRVA200",124,0)
|
||
;
|
||
"RTN","CCRVA200",125,0)
|
||
STATE(DUZ) ; Get State for Institution. PUBLIC; EXTRINSIC
|
||
"RTN","CCRVA200",126,0)
|
||
; INPUT: DUZ ByVal
|
||
"RTN","CCRVA200",127,0)
|
||
; Output: String.
|
||
"RTN","CCRVA200",128,0)
|
||
; See ADD1 for comments
|
||
"RTN","CCRVA200",129,0)
|
||
N INST S INST=$P($$SITE^VASITE(),U)
|
||
"RTN","CCRVA200",130,0)
|
||
N ADD
|
||
"RTN","CCRVA200",131,0)
|
||
S ADD=$$MADD^XUAF4(INST) ; mailing address
|
||
"RTN","CCRVA200",132,0)
|
||
Q:$L(ADD) $P(ADD,U,3)
|
||
"RTN","CCRVA200",133,0)
|
||
S ADD=$$PADD^XUAF4(INST) ; physical address
|
||
"RTN","CCRVA200",134,0)
|
||
Q:$L(ADD) $P(ADD,U,3)
|
||
"RTN","CCRVA200",135,0)
|
||
Q ""
|
||
"RTN","CCRVA200",136,0)
|
||
;
|
||
"RTN","CCRVA200",137,0)
|
||
POSTCODE(DUZ) ; Get Postal Code for Institution. PUBLIC; EXTRINSIC
|
||
"RTN","CCRVA200",138,0)
|
||
; INPUT: DUZ ByVal
|
||
"RTN","CCRVA200",139,0)
|
||
; OUTPUT: String.
|
||
"RTN","CCRVA200",140,0)
|
||
; See ADD1 for comments
|
||
"RTN","CCRVA200",141,0)
|
||
N INST S INST=$P($$SITE^VASITE(),U)
|
||
"RTN","CCRVA200",142,0)
|
||
N ADD
|
||
"RTN","CCRVA200",143,0)
|
||
S ADD=$$MADD^XUAF4(INST) ; mailing address
|
||
"RTN","CCRVA200",144,0)
|
||
Q:$L(ADD) $P(ADD,U,4)
|
||
"RTN","CCRVA200",145,0)
|
||
S ADD=$$PADD^XUAF4(INST) ; physical address
|
||
"RTN","CCRVA200",146,0)
|
||
Q:$L(ADD) $P(ADD,U,4)
|
||
"RTN","CCRVA200",147,0)
|
||
Q ""
|
||
"RTN","CCRVA200",148,0)
|
||
;
|
||
"RTN","CCRVA200",149,0)
|
||
TEL(DUZ) ; Get Office Phone number. PUBLIC; EXTRINSIC
|
||
"RTN","CCRVA200",150,0)
|
||
; INPUT: DUZ ByVal
|
||
"RTN","CCRVA200",151,0)
|
||
; OUTPUT: String.
|
||
"RTN","CCRVA200",152,0)
|
||
; Direct global access
|
||
"RTN","CCRVA200",153,0)
|
||
N TEL S TEL=$G(^VA(200,DUZ,.13))
|
||
"RTN","CCRVA200",154,0)
|
||
Q $P(TEL,U,2)
|
||
"RTN","CCRVA200",155,0)
|
||
;
|
||
"RTN","CCRVA200",156,0)
|
||
TELTYPE(DUZ) ; Get Telephone Type. PUBLIC; EXTRINSIC
|
||
"RTN","CCRVA200",157,0)
|
||
; INPUT: DUZ ByVal
|
||
"RTN","CCRVA200",158,0)
|
||
; OUTPUT: String.
|
||
"RTN","CCRVA200",159,0)
|
||
Q "Office"
|
||
"RTN","CCRVA200",160,0)
|
||
;
|
||
"RTN","CCRVA200",161,0)
|
||
EMAIL(DUZ) ; Get Provider's Email. PUBLIC; EXTRINSIC
|
||
"RTN","CCRVA200",162,0)
|
||
; INPUT: DUZ ByVal
|
||
"RTN","CCRVA200",163,0)
|
||
; OUTPUT: String
|
||
"RTN","CCRVA200",164,0)
|
||
; Direct global access
|
||
"RTN","CCRVA200",165,0)
|
||
N EMAIL S EMAIL=$G(^VA(200,DUZ,.15))
|
||
"RTN","CCRVA200",166,0)
|
||
Q $P(EMAIL,U)
|
||
"RTN","CCRVA200",167,0)
|
||
;
|
||
"RTN","GPLACTOR")
|
||
0^16^B57497934
|
||
"RTN","GPLACTOR",1,0)
|
||
GPLACTOR ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
|
||
"RTN","GPLACTOR",2,0)
|
||
;;0.4;CCDCCR;nopatch;noreleasedate;Build 15
|
||
"RTN","GPLACTOR",3,0)
|
||
; Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
||
"RTN","GPLACTOR",4,0)
|
||
; General Public License See attached copy of the License.
|
||
"RTN","GPLACTOR",5,0)
|
||
;
|
||
"RTN","GPLACTOR",6,0)
|
||
; This program is free software; you can redistribute it and/or modify
|
||
"RTN","GPLACTOR",7,0)
|
||
; it under the terms of the GNU General Public License as published by
|
||
"RTN","GPLACTOR",8,0)
|
||
; the Free Software Foundation; either version 2 of the License, or
|
||
"RTN","GPLACTOR",9,0)
|
||
; (at your option) any later version.
|
||
"RTN","GPLACTOR",10,0)
|
||
;
|
||
"RTN","GPLACTOR",11,0)
|
||
; This program is distributed in the hope that it will be useful,
|
||
"RTN","GPLACTOR",12,0)
|
||
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
"RTN","GPLACTOR",13,0)
|
||
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
"RTN","GPLACTOR",14,0)
|
||
; GNU General Public License for more details.
|
||
"RTN","GPLACTOR",15,0)
|
||
;
|
||
"RTN","GPLACTOR",16,0)
|
||
; You should have received a copy of the GNU General Public License along
|
||
"RTN","GPLACTOR",17,0)
|
||
; with this program; if not, write to the Free Software Foundation, Inc.,
|
||
"RTN","GPLACTOR",18,0)
|
||
; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
||
"RTN","GPLACTOR",19,0)
|
||
;
|
||
"RTN","GPLACTOR",20,0)
|
||
; PROCESS THE ACTORS SECTION OF THE CCR
|
||
"RTN","GPLACTOR",21,0)
|
||
;
|
||
"RTN","GPLACTOR",22,0)
|
||
; ===Revision History===
|
||
"RTN","GPLACTOR",23,0)
|
||
; 0.1 Initial Writing of Skeleton--GPL
|
||
"RTN","GPLACTOR",24,0)
|
||
; 0.2 Patient Data Extraction--SMH
|
||
"RTN","GPLACTOR",25,0)
|
||
; 0.3 Information System Info Extraction--SMH
|
||
"RTN","GPLACTOR",26,0)
|
||
; 0.4 Patient data rouine refactored; adjustments here--SMH
|
||
"RTN","GPLACTOR",27,0)
|
||
;
|
||
"RTN","GPLACTOR",28,0)
|
||
EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
|
||
"RTN","GPLACTOR",29,0)
|
||
; IPXML is the Input Actor Template into which we substitute values
|
||
"RTN","GPLACTOR",30,0)
|
||
; This is straight XML. Values to be substituted are in @@VAL@@ format.
|
||
"RTN","GPLACTOR",31,0)
|
||
; ALST is the actor list global generated by ACTLST^GPLCCR and has format:
|
||
"RTN","GPLACTOR",32,0)
|
||
; ^TMP(7542,1,"ACTORS",0)=Count
|
||
"RTN","GPLACTOR",33,0)
|
||
; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN"
|
||
"RTN","GPLACTOR",34,0)
|
||
; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM"
|
||
"RTN","GPLACTOR",35,0)
|
||
; AXML is the output arrary, to contain XML.
|
||
"RTN","GPLACTOR",36,0)
|
||
;
|
||
"RTN","GPLACTOR",37,0)
|
||
N I,J,AMAP,AOID,ATYP,AIEN
|
||
"RTN","GPLACTOR",38,0)
|
||
D CP^GPLXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
|
||
"RTN","GPLACTOR",39,0)
|
||
D REPLACE^GPLXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
|
||
"RTN","GPLACTOR",40,0)
|
||
I DEBUG W "PROCESSING ACTORS ",!
|
||
"RTN","GPLACTOR",41,0)
|
||
F I=1:1:@ALST@(0) D ; PROCESS ALL ACTORS IN THE LIST
|
||
"RTN","GPLACTOR",42,0)
|
||
. I @ALST@(I)["@@" Q ; NOT A VALID ACTOR
|
||
"RTN","GPLACTOR",43,0)
|
||
. S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
|
||
"RTN","GPLACTOR",44,0)
|
||
. S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
|
||
"RTN","GPLACTOR",45,0)
|
||
. S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
|
||
"RTN","GPLACTOR",46,0)
|
||
. I AIEN="" D Q ; IEN CAN'T BE NULL
|
||
"RTN","GPLACTOR",47,0)
|
||
. . W "WARING NUL ACTOR: ",ATYP,!
|
||
"RTN","GPLACTOR",48,0)
|
||
. I ATYP="" Q ; NOT A VALID ACTOR
|
||
"RTN","GPLACTOR",49,0)
|
||
. ;
|
||
"RTN","GPLACTOR",50,0)
|
||
. I DEBUG W AOID_" "_ATYP_" "_AIEN,!
|
||
"RTN","GPLACTOR",51,0)
|
||
. I ATYP="PATIENT" D ; PATIENT ACTOR TYPE
|
||
"RTN","GPLACTOR",52,0)
|
||
. . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
|
||
"RTN","GPLACTOR",53,0)
|
||
. . D PATIENT("ATMP",AIEN,AOID,"ATMP2")
|
||
"RTN","GPLACTOR",54,0)
|
||
. ;
|
||
"RTN","GPLACTOR",55,0)
|
||
. I ATYP="SYSTEM" D ; SYSTEM ACTOR TYPE
|
||
"RTN","GPLACTOR",56,0)
|
||
. . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
|
||
"RTN","GPLACTOR",57,0)
|
||
. . D SYSTEM("ATMP",AIEN,AOID,"ATMP2")
|
||
"RTN","GPLACTOR",58,0)
|
||
. ;
|
||
"RTN","GPLACTOR",59,0)
|
||
. I ATYP="NOK" D ; NOK ACTOR TYPE
|
||
"RTN","GPLACTOR",60,0)
|
||
. . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
|
||
"RTN","GPLACTOR",61,0)
|
||
. . D NOK("ATMP",AIEN,AOID,"ATMP2")
|
||
"RTN","GPLACTOR",62,0)
|
||
. ;
|
||
"RTN","GPLACTOR",63,0)
|
||
. I ATYP="PROVIDER" D ; PROVIDER ACTOR TYPE
|
||
"RTN","GPLACTOR",64,0)
|
||
. . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
|
||
"RTN","GPLACTOR",65,0)
|
||
. . D PROVIDER("ATMP",AIEN,AOID,"ATMP2")
|
||
"RTN","GPLACTOR",66,0)
|
||
. ;
|
||
"RTN","GPLACTOR",67,0)
|
||
. I ATYP="ORGANIZATION" D ; PROVIDER ACTOR TYPE
|
||
"RTN","GPLACTOR",68,0)
|
||
. . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
|
||
"RTN","GPLACTOR",69,0)
|
||
. . D ORG("ATMP",AIEN,AOID,"ATMP2")
|
||
"RTN","GPLACTOR",70,0)
|
||
. ;
|
||
"RTN","GPLACTOR",71,0)
|
||
. W "PROCESSING:",ATYP," ",AIEN,!
|
||
"RTN","GPLACTOR",72,0)
|
||
. ;I @ATMP2@(0)=0 Q ; NOTHING RETURNED, SKIP THIS ONE
|
||
"RTN","GPLACTOR",73,0)
|
||
. D INSINNER^GPLXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
|
||
"RTN","GPLACTOR",74,0)
|
||
. K ATYP,AIEN,AOID,ATMP,ATMP2 ; BE SURE TO GET THE NEXT ONE
|
||
"RTN","GPLACTOR",75,0)
|
||
;
|
||
"RTN","GPLACTOR",76,0)
|
||
N ACTTMP
|
||
"RTN","GPLACTOR",77,0)
|
||
D MISSING^GPLXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
|
||
"RTN","GPLACTOR",78,0)
|
||
I ACTTMP(0)>0 D ; IF THERE ARE MISSING VARS -
|
||
"RTN","GPLACTOR",79,0)
|
||
. ; STRINGS MARKED AS @@X@@
|
||
"RTN","GPLACTOR",80,0)
|
||
. W "ACTORS Missing list: ",!
|
||
"RTN","GPLACTOR",81,0)
|
||
. F I=1:1:ACTTMP(0) W ACTTMP(I),!
|
||
"RTN","GPLACTOR",82,0)
|
||
Q
|
||
"RTN","GPLACTOR",83,0)
|
||
;
|
||
"RTN","GPLACTOR",84,0)
|
||
PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
|
||
"RTN","GPLACTOR",85,0)
|
||
I DEBUG W "PROCESSING ACTOR PATIENT ",AIEN,!
|
||
"RTN","GPLACTOR",86,0)
|
||
N AMAP,ZX
|
||
"RTN","GPLACTOR",87,0)
|
||
S AMAP=$NA(^TMP($J,"AMAP"))
|
||
"RTN","GPLACTOR",88,0)
|
||
K @AMAP
|
||
"RTN","GPLACTOR",89,0)
|
||
S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
||
"RTN","GPLACTOR",90,0)
|
||
S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRDPT(AIEN)
|
||
"RTN","GPLACTOR",91,0)
|
||
S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRDPT(AIEN)
|
||
"RTN","GPLACTOR",92,0)
|
||
S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRDPT(AIEN)
|
||
"RTN","GPLACTOR",93,0)
|
||
S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^CCRDPT(AIEN)
|
||
"RTN","GPLACTOR",94,0)
|
||
S @AMAP@("ACTORGENDER")=$$GENDER^CCRDPT(AIEN)
|
||
"RTN","GPLACTOR",95,0)
|
||
S @AMAP@("ACTORSSN")=""
|
||
"RTN","GPLACTOR",96,0)
|
||
S @AMAP@("ACTORSSNTEXT")=""
|
||
"RTN","GPLACTOR",97,0)
|
||
S @AMAP@("ACTORSSNSOURCEID")=""
|
||
"RTN","GPLACTOR",98,0)
|
||
S ZX=$$SSN^CCRDPT(AIEN)
|
||
"RTN","GPLACTOR",99,0)
|
||
I ZX'="" D ; IF THERE IS A SSN IN THE RECORD
|
||
"RTN","GPLACTOR",100,0)
|
||
. S @AMAP@("ACTORSSN")=ZX
|
||
"RTN","GPLACTOR",101,0)
|
||
. S @AMAP@("ACTORSSNTEXT")="SSN"
|
||
"RTN","GPLACTOR",102,0)
|
||
. S @AMAP@("ACTORSSNSOURCEID")=AOID
|
||
"RTN","GPLACTOR",103,0)
|
||
S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^CCRDPT(AIEN)
|
||
"RTN","GPLACTOR",104,0)
|
||
S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^CCRDPT(AIEN)
|
||
"RTN","GPLACTOR",105,0)
|
||
S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^CCRDPT(AIEN)
|
||
"RTN","GPLACTOR",106,0)
|
||
S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRDPT(AIEN)
|
||
"RTN","GPLACTOR",107,0)
|
||
S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRDPT(AIEN)
|
||
"RTN","GPLACTOR",108,0)
|
||
S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^CCRDPT(AIEN)
|
||
"RTN","GPLACTOR",109,0)
|
||
S @AMAP@("ACTORRESTEL")=""
|
||
"RTN","GPLACTOR",110,0)
|
||
S @AMAP@("ACTORRESTELTEXT")=""
|
||
"RTN","GPLACTOR",111,0)
|
||
S ZX=$$RESTEL^CCRDPT(AIEN)
|
||
"RTN","GPLACTOR",112,0)
|
||
I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD
|
||
"RTN","GPLACTOR",113,0)
|
||
. S @AMAP@("ACTORRESTEL")=ZX
|
||
"RTN","GPLACTOR",114,0)
|
||
. S @AMAP@("ACTORRESTELTEXT")="Residential Telephone"
|
||
"RTN","GPLACTOR",115,0)
|
||
S @AMAP@("ACTORWORKTEL")=""
|
||
"RTN","GPLACTOR",116,0)
|
||
S @AMAP@("ACTORWORKTELTEXT")=""
|
||
"RTN","GPLACTOR",117,0)
|
||
S ZX=$$WORKTEL^CCRDPT(AIEN)
|
||
"RTN","GPLACTOR",118,0)
|
||
I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD
|
||
"RTN","GPLACTOR",119,0)
|
||
. S @AMAP@("ACTORWORKTEL")=ZX
|
||
"RTN","GPLACTOR",120,0)
|
||
. S @AMAP@("ACTORWORKTELTEXT")="Work Telephone"
|
||
"RTN","GPLACTOR",121,0)
|
||
S @AMAP@("ACTORCELLTEL")=""
|
||
"RTN","GPLACTOR",122,0)
|
||
S @AMAP@("ACTORCELLTELTEXT")=""
|
||
"RTN","GPLACTOR",123,0)
|
||
S ZX=$$CELLTEL^CCRDPT(AIEN)
|
||
"RTN","GPLACTOR",124,0)
|
||
I ZX'="" D ; IF THERE IS A CELL PHONE IN THE RECORD
|
||
"RTN","GPLACTOR",125,0)
|
||
. S @AMAP@("ACTORCELLTEL")=ZX
|
||
"RTN","GPLACTOR",126,0)
|
||
. S @AMAP@("ACTORCELLTELTEXT")="Cell Phone"
|
||
"RTN","GPLACTOR",127,0)
|
||
S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRDPT(AIEN)
|
||
"RTN","GPLACTOR",128,0)
|
||
S @AMAP@("ACTORADDRESSSOURCEID")=AOID
|
||
"RTN","GPLACTOR",129,0)
|
||
S @AMAP@("ACTORIEN")=AIEN
|
||
"RTN","GPLACTOR",130,0)
|
||
S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX
|
||
"RTN","GPLACTOR",131,0)
|
||
S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
|
||
"RTN","GPLACTOR",132,0)
|
||
D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
||
"RTN","GPLACTOR",133,0)
|
||
Q
|
||
"RTN","GPLACTOR",134,0)
|
||
;
|
||
"RTN","GPLACTOR",135,0)
|
||
SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR
|
||
"RTN","GPLACTOR",136,0)
|
||
;
|
||
"RTN","GPLACTOR",137,0)
|
||
; N AMAP
|
||
"RTN","GPLACTOR",138,0)
|
||
S AMAP=$NA(^TMP($J,"AMAP"))
|
||
"RTN","GPLACTOR",139,0)
|
||
K @AMAP
|
||
"RTN","GPLACTOR",140,0)
|
||
S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
||
"RTN","GPLACTOR",141,0)
|
||
S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^CCRSYS
|
||
"RTN","GPLACTOR",142,0)
|
||
S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^CCRSYS
|
||
"RTN","GPLACTOR",143,0)
|
||
S @AMAP@("ACTORINFOSYSSOURCEID")=AOID
|
||
"RTN","GPLACTOR",144,0)
|
||
D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
||
"RTN","GPLACTOR",145,0)
|
||
Q
|
||
"RTN","GPLACTOR",146,0)
|
||
;
|
||
"RTN","GPLACTOR",147,0)
|
||
NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
|
||
"RTN","GPLACTOR",148,0)
|
||
;
|
||
"RTN","GPLACTOR",149,0)
|
||
; N AMAP
|
||
"RTN","GPLACTOR",150,0)
|
||
S AMAP=$NA(^TMP($J,"AMAP"))
|
||
"RTN","GPLACTOR",151,0)
|
||
K @AMAP
|
||
"RTN","GPLACTOR",152,0)
|
||
S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
||
"RTN","GPLACTOR",153,0)
|
||
S @AMAP@("ACTORDISPLAYNAME")=""
|
||
"RTN","GPLACTOR",154,0)
|
||
S @AMAP@("ACTORRELATION")=""
|
||
"RTN","GPLACTOR",155,0)
|
||
S @AMAP@("ACTORRELATIONSOURCEID")=""
|
||
"RTN","GPLACTOR",156,0)
|
||
S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
|
||
"RTN","GPLACTOR",157,0)
|
||
D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
||
"RTN","GPLACTOR",158,0)
|
||
Q
|
||
"RTN","GPLACTOR",159,0)
|
||
;
|
||
"RTN","GPLACTOR",160,0)
|
||
ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR
|
||
"RTN","GPLACTOR",161,0)
|
||
;
|
||
"RTN","GPLACTOR",162,0)
|
||
; N AMAP
|
||
"RTN","GPLACTOR",163,0)
|
||
S AMAP=$NA(^TMP($J,"AMAP"))
|
||
"RTN","GPLACTOR",164,0)
|
||
K @AMAP
|
||
"RTN","GPLACTOR",165,0)
|
||
S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
||
"RTN","GPLACTOR",166,0)
|
||
S @AMAP@("ORGANIZATIONNAME")=$P($$SITE^VASITE,U,2)
|
||
"RTN","GPLACTOR",167,0)
|
||
S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"
|
||
"RTN","GPLACTOR",168,0)
|
||
D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
||
"RTN","GPLACTOR",169,0)
|
||
Q
|
||
"RTN","GPLACTOR",170,0)
|
||
;
|
||
"RTN","GPLACTOR",171,0)
|
||
PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
|
||
"RTN","GPLACTOR",172,0)
|
||
;
|
||
"RTN","GPLACTOR",173,0)
|
||
; N AMAP
|
||
"RTN","GPLACTOR",174,0)
|
||
S AMAP=$NA(^TMP($J,"AMAP"))
|
||
"RTN","GPLACTOR",175,0)
|
||
K @AMAP
|
||
"RTN","GPLACTOR",176,0)
|
||
I '$D(^VA(200,AIEN,0)) D Q ; IF NO PROVIDER RECORD (SHOULDN'T HAPPEN)
|
||
"RTN","GPLACTOR",177,0)
|
||
. W "WARNING - MISSING PROVIDER: ",AIEN,!
|
||
"RTN","GPLACTOR",178,0)
|
||
. S @OUTXML@(0)=0 ; SIGNAL NO OUTPUT
|
||
"RTN","GPLACTOR",179,0)
|
||
S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
||
"RTN","GPLACTOR",180,0)
|
||
S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRVA200(AIEN)
|
||
"RTN","GPLACTOR",181,0)
|
||
S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRVA200(AIEN)
|
||
"RTN","GPLACTOR",182,0)
|
||
S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRVA200(AIEN)
|
||
"RTN","GPLACTOR",183,0)
|
||
S @AMAP@("ACTORTITLE")=$$TITLE^CCRVA200(AIEN)
|
||
"RTN","GPLACTOR",184,0)
|
||
S @AMAP@("IDTYPE")=$P($$NPI^CCRVA200(AIEN),U,1)
|
||
"RTN","GPLACTOR",185,0)
|
||
S @AMAP@("ID")=$P($$NPI^CCRVA200(AIEN),U,2)
|
||
"RTN","GPLACTOR",186,0)
|
||
S @AMAP@("IDDESC")=$P($$NPI^CCRVA200(AIEN),U,3)
|
||
"RTN","GPLACTOR",187,0)
|
||
S @AMAP@("ACTORSPECIALITY")=$$SPEC^CCRVA200(AIEN)
|
||
"RTN","GPLACTOR",188,0)
|
||
S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^CCRVA200(AIEN)
|
||
"RTN","GPLACTOR",189,0)
|
||
S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^CCRVA200(AIEN)
|
||
"RTN","GPLACTOR",190,0)
|
||
S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRVA200(AIEN)
|
||
"RTN","GPLACTOR",191,0)
|
||
S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRVA200(AIEN)
|
||
"RTN","GPLACTOR",192,0)
|
||
S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^CCRVA200(AIEN)
|
||
"RTN","GPLACTOR",193,0)
|
||
S @AMAP@("ACTORTELEPHONE")=""
|
||
"RTN","GPLACTOR",194,0)
|
||
S @AMAP@("ACTORTELEPHONETYPE")=""
|
||
"RTN","GPLACTOR",195,0)
|
||
S ZX=$$TEL^CCRVA200(AIEN)
|
||
"RTN","GPLACTOR",196,0)
|
||
I ZX'="" D ; THERE IS A PHONE NUMBER AVAILABLE
|
||
"RTN","GPLACTOR",197,0)
|
||
. S @AMAP@("ACTORTELEPHONE")=ZX
|
||
"RTN","GPLACTOR",198,0)
|
||
. S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^CCRVA200(AIEN)
|
||
"RTN","GPLACTOR",199,0)
|
||
S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRVA200(AIEN)
|
||
"RTN","GPLACTOR",200,0)
|
||
S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"
|
||
"RTN","GPLACTOR",201,0)
|
||
S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
|
||
"RTN","GPLACTOR",202,0)
|
||
D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
||
"RTN","GPLACTOR",203,0)
|
||
Q
|
||
"RTN","GPLACTOR",204,0)
|
||
;
|
||
"RTN","GPLALERT")
|
||
0^19^B21981592
|
||
"RTN","GPLALERT",1,0)
|
||
GPLALERT ; CCDCCR/CKU - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08
|
||
"RTN","GPLALERT",2,0)
|
||
;;0.1;CCDCCR;;SEP 11,2008;Build 15
|
||
"RTN","GPLALERT",3,0)
|
||
;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
||
"RTN","GPLALERT",4,0)
|
||
;General Public License See attached copy of the License.
|
||
"RTN","GPLALERT",5,0)
|
||
;
|
||
"RTN","GPLALERT",6,0)
|
||
;This program is free software; you can redistribute it and/or modify
|
||
"RTN","GPLALERT",7,0)
|
||
;it under the terms of the GNU General Public License as published by
|
||
"RTN","GPLALERT",8,0)
|
||
;the Free Software Foundation; either version 2 of the License, or
|
||
"RTN","GPLALERT",9,0)
|
||
;(at your option) any later version.
|
||
"RTN","GPLALERT",10,0)
|
||
;
|
||
"RTN","GPLALERT",11,0)
|
||
;This program is distributed in the hope that it will be useful,
|
||
"RTN","GPLALERT",12,0)
|
||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
"RTN","GPLALERT",13,0)
|
||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
"RTN","GPLALERT",14,0)
|
||
;GNU General Public License for more details.
|
||
"RTN","GPLALERT",15,0)
|
||
;
|
||
"RTN","GPLALERT",16,0)
|
||
;You should have received a copy of the GNU General Public License along
|
||
"RTN","GPLALERT",17,0)
|
||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
||
"RTN","GPLALERT",18,0)
|
||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
||
"RTN","GPLALERT",19,0)
|
||
;
|
||
"RTN","GPLALERT",20,0)
|
||
W "NO ENTRY FROM TOP",!
|
||
"RTN","GPLALERT",21,0)
|
||
Q
|
||
"RTN","GPLALERT",22,0)
|
||
;
|
||
"RTN","GPLALERT",23,0)
|
||
EXTRACT(ALTXML,DFN,ALTOUTXML) ; EXTRACT ALERTS INTO PROVIDED XML TEMPLATE
|
||
"RTN","GPLALERT",24,0)
|
||
;
|
||
"RTN","GPLALERT",25,0)
|
||
; ALTXML AND ALTOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
|
||
"RTN","GPLALERT",26,0)
|
||
;
|
||
"RTN","GPLALERT",27,0)
|
||
; GET ADVERSE REACTIONS AND ALLERGIES
|
||
"RTN","GPLALERT",28,0)
|
||
; N GMRA,GMRAL ; FOR DEBUGGING, DON'T NEW THESE VARIABLES
|
||
"RTN","GPLALERT",29,0)
|
||
S GMRA="0^0^111"
|
||
"RTN","GPLALERT",30,0)
|
||
D EN1^GMRADPT
|
||
"RTN","GPLALERT",31,0)
|
||
I $G(GMRAL)'=1 D Q ; NO ALLERGIES FOUND THUS *QUIT*
|
||
"RTN","GPLALERT",32,0)
|
||
. S @ALTOUTXML@(0)=0
|
||
"RTN","GPLALERT",33,0)
|
||
; DEFINE MAPPING
|
||
"RTN","GPLALERT",34,0)
|
||
N ALTTVMAP,ALTVMAP,ALTTARYTMP,ALTARYTMP
|
||
"RTN","GPLALERT",35,0)
|
||
S ALTTVMAP=$NA(^TMP("GPLCCR",$J,"ALERTS"))
|
||
"RTN","GPLALERT",36,0)
|
||
S ALTTARYTMP=$NA(^TMP("GPLCCR",$J,"ALERTSARYTMP"))
|
||
"RTN","GPLALERT",37,0)
|
||
K @ALTTVMAP,@ALTTARYTMP
|
||
"RTN","GPLALERT",38,0)
|
||
N ALTTMP,ALTCNT S ALTG=$NA(GMRAL),ALTCNT=1
|
||
"RTN","GPLALERT",39,0)
|
||
S ALTTMP="" ;
|
||
"RTN","GPLALERT",40,0)
|
||
F S ALTTMP=$O(@ALTG@(ALTTMP)) Q:ALTTMP="" D ; CHANGED TO $O BY GPL
|
||
"RTN","GPLALERT",41,0)
|
||
. W "ALTTMP="_ALTTMP,!
|
||
"RTN","GPLALERT",42,0)
|
||
. ; I $QS(ALTTMP,2)="S" W !,"S FOUND",! Q
|
||
"RTN","GPLALERT",43,0)
|
||
. S ALTVMAP=$NA(@ALTTVMAP@(ALTCNT))
|
||
"RTN","GPLALERT",44,0)
|
||
. K @ALTVMAP
|
||
"RTN","GPLALERT",45,0)
|
||
. S @ALTVMAP@("ALERTOBJECTID")="ALERT"_ALTCNT
|
||
"RTN","GPLALERT",46,0)
|
||
. N A1 S A1=@ALTG@(ALTTMP) ; ALL THE PIECES
|
||
"RTN","GPLALERT",47,0)
|
||
. N A2 S A2=$$GET1^DIQ(120.8,ALTTMP,"MECHANISM","I") ; MECHANISM
|
||
"RTN","GPLALERT",48,0)
|
||
. N A3 S A3=$P(A1,U,5) ; ADVERSE FLAG
|
||
"RTN","GPLALERT",49,0)
|
||
. N ADT S ADT="Patient has an " ; X $ZINT H 5
|
||
"RTN","GPLALERT",50,0)
|
||
. S ADT=ADT_$S(A2="P":"ADVERSE",A2="A":"ALLERGIC",1:"UNKNOWN")
|
||
"RTN","GPLALERT",51,0)
|
||
. S ADT=ADT_" reaction to "_$P(@ALTG@(ALTTMP),U,2)_"."
|
||
"RTN","GPLALERT",52,0)
|
||
. S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ADT
|
||
"RTN","GPLALERT",53,0)
|
||
. N ALTCDE ; SNOMED CODE THE THE ALERT
|
||
"RTN","GPLALERT",54,0)
|
||
. S ALTCDE=$S(A2="P":"282100009",A2="A":"418634005",1:"") ; IF NOT ADVERSE, IT IS ALLERGIC
|
||
"RTN","GPLALERT",55,0)
|
||
. S @ALTVMAP@("ALERTCODEVALUE")=ALTCDE ;
|
||
"RTN","GPLALERT",56,0)
|
||
. ; WILL USE 418634005 FOR ALLERGIC REACTION TO A SUBSTANCE
|
||
"RTN","GPLALERT",57,0)
|
||
. ; AND 282100009 FOR ADVERSE REACTION TO A SUBSTANCE
|
||
"RTN","GPLALERT",58,0)
|
||
. I ALTCDE'="" D ; IF THERE IS A CODE
|
||
"RTN","GPLALERT",59,0)
|
||
. . S @ALTVMAP@("ALERTCODESYSTEM")="SNOMED CT"
|
||
"RTN","GPLALERT",60,0)
|
||
. . S @ALTVMAP@("ALERTCODESYSTEMVERSION")="2008"
|
||
"RTN","GPLALERT",61,0)
|
||
. E D ; SET TO NULL
|
||
"RTN","GPLALERT",62,0)
|
||
. . S @ALTVMAP@("ALERTCODESYSTEM")=""
|
||
"RTN","GPLALERT",63,0)
|
||
. . S @ALTVMAP@("ALERTCODESYSTEMVERSION")=""
|
||
"RTN","GPLALERT",64,0)
|
||
. S @ALTVMAP@("ALERTSTATUSTEXT")="" ; WHERE DO WE GET THIS?
|
||
"RTN","GPLALERT",65,0)
|
||
. N ALTPROV S ALTPROV=$P(^GMR(120.8,ALTTMP,0),U,5) ; SOURCE PROVIDER IEN
|
||
"RTN","GPLALERT",66,0)
|
||
. I ALTPROV'="" D ; PROVIDER PROVIDEED
|
||
"RTN","GPLALERT",67,0)
|
||
. . S @ALTVMAP@("ALERTSOURCEID")="ACTORPROVIDER_"_ALTPROV
|
||
"RTN","GPLALERT",68,0)
|
||
. E S @ALTVMAP@("ALERTSOURCEID")="" ; SOURCE NULL - SHOULD NOT HAPPEN
|
||
"RTN","GPLALERT",69,0)
|
||
. W "RUNNING ALERTS, PROVIDER: ",@ALTVMAP@("ALERTSOURCEID"),!
|
||
"RTN","GPLALERT",70,0)
|
||
. N ACGL1,ACGFI,ACIEN,ACVUID
|
||
"RTN","GPLALERT",71,0)
|
||
. S ACGL1=$P(@ALTG@(ALTTMP),U,9) ; ADDRESS OF THE REACTANT XX;GLB(YY.Z,
|
||
"RTN","GPLALERT",72,0)
|
||
. S ACGFI=$$PRSGLB($P(ACGL1,";",2)) ; FILE NUMBER
|
||
"RTN","GPLALERT",73,0)
|
||
. S ACIEN=$P(ACGL1,";",1) ; IEN OF REACTANT
|
||
"RTN","GPLALERT",74,0)
|
||
. S ACVUID=$$GET1^DIQ(ACGFI,ACIEN,"VUID") ; VUID OF THE REACTANT
|
||
"RTN","GPLALERT",75,0)
|
||
. S @ALTVMAP@("ALERTAGENTPRODUCTOBJECTID")="PRODUCT_"_ACIEN ; IE OF REACTANT
|
||
"RTN","GPLALERT",76,0)
|
||
. S @ALTVMAP@("ALERTAGENTPRODUCTSOURCEID")="" ; WHERE DO WE GET THIS?
|
||
"RTN","GPLALERT",77,0)
|
||
. S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=$P(@ALTG@(ALTTMP),U,2) ; REACTANT
|
||
"RTN","GPLALERT",78,0)
|
||
. S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=ACVUID
|
||
"RTN","GPLALERT",79,0)
|
||
. I ACVUID'="" D ; IF VUID IS NOT NULL
|
||
"RTN","GPLALERT",80,0)
|
||
. . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")="VUID"
|
||
"RTN","GPLALERT",81,0)
|
||
. E D ; IF REACTANT CODE VALUE IS NULL
|
||
"RTN","GPLALERT",82,0)
|
||
. . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")=""
|
||
"RTN","GPLALERT",83,0)
|
||
. . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=""
|
||
"RTN","GPLALERT",84,0)
|
||
. ; REACTIONS - THIS SHOULD BE MULTIPLE, IS SINGLE NOW
|
||
"RTN","GPLALERT",85,0)
|
||
. N ARTMP,ARIEN,ARDES,ARVUID
|
||
"RTN","GPLALERT",86,0)
|
||
. S (ARTMP,ARDES,ARVUID)=""
|
||
"RTN","GPLALERT",87,0)
|
||
. I $D(@ALTG@(ALTTMP,"S",1)) D ; IF REACTION EXISTS
|
||
"RTN","GPLALERT",88,0)
|
||
. . S ARTMP=@ALTG@(ALTTMP,"S",1)
|
||
"RTN","GPLALERT",89,0)
|
||
. . W "REACTION:",ARTMP,!
|
||
"RTN","GPLALERT",90,0)
|
||
. . S ARIEN=$P(ARTMP,";",2)
|
||
"RTN","GPLALERT",91,0)
|
||
. . S ARDES=$P(ARTMP,";",1)
|
||
"RTN","GPLALERT",92,0)
|
||
. . S ARVUID=$$GET1^DIQ(120.83,ARIEN,"VUID")
|
||
"RTN","GPLALERT",93,0)
|
||
. S @ALTVMAP@("ALERTREACTIOINDESCRIPTIONTEXT")=ARDES
|
||
"RTN","GPLALERT",94,0)
|
||
. I ARVUID'="" D ; IF REACTION VUID IS NOT NULL
|
||
"RTN","GPLALERT",95,0)
|
||
. . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=ARVUID
|
||
"RTN","GPLALERT",96,0)
|
||
. . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")="VUID"
|
||
"RTN","GPLALERT",97,0)
|
||
. E D ; IF IT IS NULL DON'T SET CODE SYSTEM
|
||
"RTN","GPLALERT",98,0)
|
||
. . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=""
|
||
"RTN","GPLALERT",99,0)
|
||
. . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")=""
|
||
"RTN","GPLALERT",100,0)
|
||
. S ALTARYTMP=$NA(@ALTTARYTMP@(ALTCNT))
|
||
"RTN","GPLALERT",101,0)
|
||
. K @ALTARYTMP
|
||
"RTN","GPLALERT",102,0)
|
||
. D MAP^GPLXPATH(ALTXML,ALTVMAP,ALTARYTMP)
|
||
"RTN","GPLALERT",103,0)
|
||
. I ALTCNT=1 D CP^GPLXPATH(ALTARYTMP,ALTOUTXML)
|
||
"RTN","GPLALERT",104,0)
|
||
. I ALTCNT>1 D INSINNER^GPLXPATH(ALTOUTXML,ALTARYTMP)
|
||
"RTN","GPLALERT",105,0)
|
||
. S ALTCNT=ALTCNT+1
|
||
"RTN","GPLALERT",106,0)
|
||
S @ALTTVMAP@(0)=ALTCNT-1 ; RECORD THE NUMBER OF ALERTS
|
||
"RTN","GPLALERT",107,0)
|
||
Q
|
||
"RTN","GPLALERT",108,0)
|
||
PRSGLB(INGLB) ; EXTRINSIC TO PARSE GLOBALS AND RETURN THE FILE NUMBER
|
||
"RTN","GPLALERT",109,0)
|
||
; INGLB IS OF THE FORM: PSNDF(50.6,
|
||
"RTN","GPLALERT",110,0)
|
||
; RETURN 50.6
|
||
"RTN","GPLALERT",111,0)
|
||
Q $P($P(INGLB,"(",2),",",1) ;
|
||
"RTN","GPLCCD")
|
||
0^8^B114413975
|
||
"RTN","GPLCCD",1,0)
|
||
GPLCCD ; CCDCCR/GPL - CCD MAIN PROCESSING; 6/6/08
|
||
"RTN","GPLCCD",2,0)
|
||
;;0.1;CCDCCR;nopatch;noreleasedate;Build 15
|
||
"RTN","GPLCCD",3,0)
|
||
;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
||
"RTN","GPLCCD",4,0)
|
||
;General Public License See attached copy of the License.
|
||
"RTN","GPLCCD",5,0)
|
||
;
|
||
"RTN","GPLCCD",6,0)
|
||
;This program is free software; you can redistribute it and/or modify
|
||
"RTN","GPLCCD",7,0)
|
||
;it under the terms of the GNU General Public License as published by
|
||
"RTN","GPLCCD",8,0)
|
||
;the Free Software Foundation; either version 2 of the License, or
|
||
"RTN","GPLCCD",9,0)
|
||
;(at your option) any later version.
|
||
"RTN","GPLCCD",10,0)
|
||
;
|
||
"RTN","GPLCCD",11,0)
|
||
;This program is distributed in the hope that it will be useful,
|
||
"RTN","GPLCCD",12,0)
|
||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
"RTN","GPLCCD",13,0)
|
||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
"RTN","GPLCCD",14,0)
|
||
;GNU General Public License for more details.
|
||
"RTN","GPLCCD",15,0)
|
||
;
|
||
"RTN","GPLCCD",16,0)
|
||
;You should have received a copy of the GNU General Public License along
|
||
"RTN","GPLCCD",17,0)
|
||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
||
"RTN","GPLCCD",18,0)
|
||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
||
"RTN","GPLCCD",19,0)
|
||
;
|
||
"RTN","GPLCCD",20,0)
|
||
; EXPORT A CCR
|
||
"RTN","GPLCCD",21,0)
|
||
;
|
||
"RTN","GPLCCD",22,0)
|
||
EXPORT ; EXPORT ENTRY POINT FOR CCR
|
||
"RTN","GPLCCD",23,0)
|
||
; Select a patient.
|
||
"RTN","GPLCCD",24,0)
|
||
S DIC=2,DIC(0)="AEMQ" D ^DIC
|
||
"RTN","GPLCCD",25,0)
|
||
I Y<1 Q ; EXIT
|
||
"RTN","GPLCCD",26,0)
|
||
S DFN=$P(Y,U,1) ; SET THE PATIENT
|
||
"RTN","GPLCCD",27,0)
|
||
D XPAT(DFN,"","") ; EXPORT TO A FILE
|
||
"RTN","GPLCCD",28,0)
|
||
Q
|
||
"RTN","GPLCCD",29,0)
|
||
;
|
||
"RTN","GPLCCD",30,0)
|
||
XPAT(DFN,DIR,FN) ; EXPORT ONE PATIENT TO A FILE
|
||
"RTN","GPLCCD",31,0)
|
||
; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("GPLCCR","ODIR")
|
||
"RTN","GPLCCD",32,0)
|
||
; FN IS FILE NAME, DEFAULTS IF NULL
|
||
"RTN","GPLCCD",33,0)
|
||
; N CCDGLO
|
||
"RTN","GPLCCD",34,0)
|
||
D CCDRPC(.CCDGLO,DFN,"CCD","","","")
|
||
"RTN","GPLCCD",35,0)
|
||
S OARY=$NA(^TMP("GPLCCR",$J,DFN,"CCD",1))
|
||
"RTN","GPLCCD",36,0)
|
||
S ONAM=FN
|
||
"RTN","GPLCCD",37,0)
|
||
I FN="" S ONAM="PAT_"_DFN_"_CCD_V1.xml"
|
||
"RTN","GPLCCD",38,0)
|
||
S ODIRGLB=$NA(^TMP("GPLCCR","ODIR"))
|
||
"RTN","GPLCCD",39,0)
|
||
I '$D(@ODIRGLB) D ; IF NOT ODIR HAS BEEN SET
|
||
"RTN","GPLCCD",40,0)
|
||
. S @ODIRGLB="/home/glilly/CCROUT"
|
||
"RTN","GPLCCD",41,0)
|
||
. ;S @ODIRGLB="/home/cedwards/"
|
||
"RTN","GPLCCD",42,0)
|
||
. ;S @ODIRGLB="/opt/wv/p/"
|
||
"RTN","GPLCCD",43,0)
|
||
S ODIR=DIR
|
||
"RTN","GPLCCD",44,0)
|
||
I DIR="" S ODIR=@ODIRGLB
|
||
"RTN","GPLCCD",45,0)
|
||
N ZY
|
||
"RTN","GPLCCD",46,0)
|
||
S ZY=$$OUTPUT^GPLXPATH(OARY,ONAM,ODIR)
|
||
"RTN","GPLCCD",47,0)
|
||
W $P(ZY,U,2)
|
||
"RTN","GPLCCD",48,0)
|
||
Q
|
||
"RTN","GPLCCD",49,0)
|
||
;
|
||
"RTN","GPLCCD",50,0)
|
||
CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT
|
||
"RTN","GPLCCD",51,0)
|
||
; CCRGRTN IS RETURN ARRAY PASSED BY NAME
|
||
"RTN","GPLCCD",52,0)
|
||
; DFN IS PATIENT IEN
|
||
"RTN","GPLCCD",53,0)
|
||
; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
|
||
"RTN","GPLCCD",54,0)
|
||
; OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
|
||
"RTN","GPLCCD",55,0)
|
||
; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
|
||
"RTN","GPLCCD",56,0)
|
||
; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
|
||
"RTN","GPLCCD",57,0)
|
||
; - NULL MEANS NOW
|
||
"RTN","GPLCCD",58,0)
|
||
; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
|
||
"RTN","GPLCCD",59,0)
|
||
; "TO" VARIABLES
|
||
"RTN","GPLCCD",60,0)
|
||
; IF NULL WILL DEFAULT TO "FROM" ORGANIZATION AND "TO" DFN
|
||
"RTN","GPLCCD",61,0)
|
||
I '$D(DEBUG) S DEBUG=0
|
||
"RTN","GPLCCD",62,0)
|
||
N CCD S CCD=0 ; FLAG FOR PROCESSING A CCD
|
||
"RTN","GPLCCD",63,0)
|
||
I CCRPART="CCD" S CCD=1 ; WE ARE PROCESSING A CCD
|
||
"RTN","GPLCCD",64,0)
|
||
S TGLOBAL=$NA(^TMP("GPLCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
|
||
"RTN","GPLCCD",65,0)
|
||
I CCD S CCDGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCD")) ; GLOBAL FOR THE CCD
|
||
"RTN","GPLCCD",66,0)
|
||
E S CCDGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
|
||
"RTN","GPLCCD",67,0)
|
||
S ACTGLO=$NA(^TMP("GPLCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
|
||
"RTN","GPLCCD",68,0)
|
||
; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
|
||
"RTN","GPLCCD",69,0)
|
||
S CCRGRTN=$NA(^TMP("GPLCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
|
||
"RTN","GPLCCD",70,0)
|
||
I CCD D LOAD^GPLCCD1(TGLOBAL) ; LOAD THE CCR TEMPLATE
|
||
"RTN","GPLCCD",71,0)
|
||
E D LOAD^GPLCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE
|
||
"RTN","GPLCCD",72,0)
|
||
D CP^GPLXPATH(TGLOBAL,CCDGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
|
||
"RTN","GPLCCD",73,0)
|
||
N CAPSAVE,CAPSAVE2 ; FOR HOLDING THE CCD ROOT LINES
|
||
"RTN","GPLCCD",74,0)
|
||
S CAPSAVE=@TGLOBAL@(3) ; SAVE THE CCD ROOT
|
||
"RTN","GPLCCD",75,0)
|
||
S CAPSAVE2=@TGLOBAL@(@TGLOBAL@(0)) ; SAVE LAST LINE OF CCD
|
||
"RTN","GPLCCD",76,0)
|
||
S @CCDGLO@(3)="<ContinuityOfCareRecord>" ; CAP WITH CCR ROOT
|
||
"RTN","GPLCCD",77,0)
|
||
S @TGLOBAL@(3)=@CCDGLO@(3) ; CAP THE TEMPLATE TOO
|
||
"RTN","GPLCCD",78,0)
|
||
S @CCDGLO@(@CCDGLO@(0))="</ContinuityOfCareRecord>" ; FINISH CAP
|
||
"RTN","GPLCCD",79,0)
|
||
S @TGLOBAL@(@TGLOBAL@(0))="</ContinuityOfCareRecord>" ; FINISH CAP TEMP
|
||
"RTN","GPLCCD",80,0)
|
||
;
|
||
"RTN","GPLCCD",81,0)
|
||
; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
|
||
"RTN","GPLCCD",82,0)
|
||
; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
|
||
"RTN","GPLCCD",83,0)
|
||
D REPLACE^GPLXPATH(CCDGLO,"","//ContinuityOfCareRecord/Body")
|
||
"RTN","GPLCCD",84,0)
|
||
D REPLACE^GPLXPATH(CCDGLO,"","//ContinuityOfCareRecord/Actors")
|
||
"RTN","GPLCCD",85,0)
|
||
I 'CCD D REPLACE^GPLXPATH(CCDGLO,"","//ContinuityOfCareRecord/Signatures")
|
||
"RTN","GPLCCD",86,0)
|
||
I DEBUG F I=1:1:@CCDGLO@(0) W @CCDGLO@(I),!
|
||
"RTN","GPLCCD",87,0)
|
||
;
|
||
"RTN","GPLCCD",88,0)
|
||
I 'CCD D HDRMAP(CCDGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
|
||
"RTN","GPLCCD",89,0)
|
||
; MAPPING THE PATIENT PORTION OF THE CDA HEADER
|
||
"RTN","GPLCCD",90,0)
|
||
S ZZX="//ContinuityOfCareRecord/recordTarget/patientRole/patient"
|
||
"RTN","GPLCCD",91,0)
|
||
D QUERY^GPLXPATH(CCDGLO,ZZX,"ACTT1")
|
||
"RTN","GPLCCD",92,0)
|
||
D PATIENT^GPLACTOR("ACTT1",DFN,"ACTORPATIENT_"_DFN,"ACTT2") ; MAP PATIENT
|
||
"RTN","GPLCCD",93,0)
|
||
I DEBUG D PARY^GPLXPATH("ACTT2")
|
||
"RTN","GPLCCD",94,0)
|
||
D REPLACE^GPLXPATH(CCDGLO,"ACTT2",ZZX)
|
||
"RTN","GPLCCD",95,0)
|
||
I DEBUG D PARY^GPLXPATH(CCDGLO)
|
||
"RTN","GPLCCD",96,0)
|
||
K ACTT1 K ACCT2
|
||
"RTN","GPLCCD",97,0)
|
||
; MAPPING THE PROVIDER ORGANIZATION,AUTHOR,INFORMANT,CUSTODIAN CDA HEADER
|
||
"RTN","GPLCCD",98,0)
|
||
; FOR NOW, THEY ARE ALL THE SAME AND RESOLVE TO ORGANIZATION
|
||
"RTN","GPLCCD",99,0)
|
||
D ORG^GPLACTOR(CCDGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG
|
||
"RTN","GPLCCD",100,0)
|
||
D CP^GPLXPATH("ACTT2",CCDGLO)
|
||
"RTN","GPLCCD",101,0)
|
||
;
|
||
"RTN","GPLCCD",102,0)
|
||
K ^TMP("GPLCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
|
||
"RTN","GPLCCD",103,0)
|
||
S CCRXTAB=$NA(^TMP("GPLCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
|
||
"RTN","GPLCCD",104,0)
|
||
D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
|
||
"RTN","GPLCCD",105,0)
|
||
N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
|
||
"RTN","GPLCCD",106,0)
|
||
F I=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS
|
||
"RTN","GPLCCD",107,0)
|
||
. S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE
|
||
"RTN","GPLCCD",108,0)
|
||
. S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
|
||
"RTN","GPLCCD",109,0)
|
||
. S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
|
||
"RTN","GPLCCD",110,0)
|
||
. S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
|
||
"RTN","GPLCCD",111,0)
|
||
. D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
|
||
"RTN","GPLCCD",112,0)
|
||
. S IXML="INXML"
|
||
"RTN","GPLCCD",113,0)
|
||
. I CCD D SHAVE(IXML) ; REMOVE ALL BUT REPEATING PARTS OF TEMPLATE SECTION
|
||
"RTN","GPLCCD",114,0)
|
||
. S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
|
||
"RTN","GPLCCD",115,0)
|
||
. ; W OXML,!
|
||
"RTN","GPLCCD",116,0)
|
||
. S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
|
||
"RTN","GPLCCD",117,0)
|
||
. W "RUNNING ",CALL,!
|
||
"RTN","GPLCCD",118,0)
|
||
. X CALL
|
||
"RTN","GPLCCD",119,0)
|
||
. I @OXML@(0)'=0 D ; THERE IS A RESULT
|
||
"RTN","GPLCCD",120,0)
|
||
. . I CCD D QUERY^GPLXPATH(TGLOBAL,XPATH,"ITMP") ; XML TO UNSHAVE WITH
|
||
"RTN","GPLCCD",121,0)
|
||
. . I CCD D UNSHAVE("ITMP",OXML)
|
||
"RTN","GPLCCD",122,0)
|
||
. . I CCD D UNMARK^GPLXPATH(OXML) ; REMOVE THE CCR MARKUP FROM SECTION
|
||
"RTN","GPLCCD",123,0)
|
||
. ; NOW INSERT THE RESULTS IN THE CCR BUFFER
|
||
"RTN","GPLCCD",124,0)
|
||
. D INSERT^GPLXPATH(CCDGLO,OXML,"//ContinuityOfCareRecord/Body")
|
||
"RTN","GPLCCD",125,0)
|
||
. I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
|
||
"RTN","GPLCCD",126,0)
|
||
; NEED TO ADD BACK IN ACTOR PROCESSING AFTER WE FIGURE OUT LINKAGE
|
||
"RTN","GPLCCD",127,0)
|
||
; D ACTLST^GPLCCR(CCDGLO,ACTGLO) ; GEN THE ACTOR LIST
|
||
"RTN","GPLCCD",128,0)
|
||
; D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
|
||
"RTN","GPLCCD",129,0)
|
||
; D EXTRACT^GPLACTOR("ACTT",ACTGLO,"ACTT2")
|
||
"RTN","GPLCCD",130,0)
|
||
; D INSINNER^GPLXPATH(CCDGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
|
||
"RTN","GPLCCD",131,0)
|
||
N I,J,DONE S DONE=0
|
||
"RTN","GPLCCD",132,0)
|
||
F I=0:0 D Q:DONE ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
|
||
"RTN","GPLCCD",133,0)
|
||
. S J=$$TRIM^GPLXPATH(CCDGLO) ; DELETE EMPTY ELEMENTS
|
||
"RTN","GPLCCD",134,0)
|
||
. W "TRIMMED",J,!
|
||
"RTN","GPLCCD",135,0)
|
||
. I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
|
||
"RTN","GPLCCD",136,0)
|
||
I CCD D ; TURN THE BODY INTO A CCD COMPONENT
|
||
"RTN","GPLCCD",137,0)
|
||
. N I
|
||
"RTN","GPLCCD",138,0)
|
||
. F I=1:1:@CCDGLO@(0) D ; SEARCH THROUGH THE ENTIRE ARRAY
|
||
"RTN","GPLCCD",139,0)
|
||
. . I @CCDGLO@(I)["<Body>" D ; REPLACE BODY MARKUP
|
||
"RTN","GPLCCD",140,0)
|
||
. . . S @CCDGLO@(I)="<component><structuredBody>" ; WITH CCD EQ
|
||
"RTN","GPLCCD",141,0)
|
||
. . I @CCDGLO@(I)["</Body>" D ; REPLACE BODY MARKUP
|
||
"RTN","GPLCCD",142,0)
|
||
. . . S @CCDGLO@(I)="</structuredBody></component>"
|
||
"RTN","GPLCCD",143,0)
|
||
S @CCDGLO@(3)=CAPSAVE ; UNCAP - TURN IT BACK INTO A CCD
|
||
"RTN","GPLCCD",144,0)
|
||
S @CCDGLO@(@CCDGLO@(0))=CAPSAVE2 ; UNCAP LAST LINE
|
||
"RTN","GPLCCD",145,0)
|
||
Q
|
||
"RTN","GPLCCD",146,0)
|
||
;
|
||
"RTN","GPLCCD",147,0)
|
||
INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS
|
||
"RTN","GPLCCD",148,0)
|
||
; TAB IS PASSED BY NAME
|
||
"RTN","GPLCCD",149,0)
|
||
W "TAB= ",TAB,!
|
||
"RTN","GPLCCD",150,0)
|
||
; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
|
||
"RTN","GPLCCD",151,0)
|
||
D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""GPLCCR"",$J,DFN,""PROBLEMS"")")
|
||
"RTN","GPLCCD",152,0)
|
||
;D PUSH^GPLXPATH(TAB,"EXTRACT;GPLMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")")
|
||
"RTN","GPLCCD",153,0)
|
||
I 'CCD D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""GPLCCR"",$J,DFN,""VITALS"")")
|
||
"RTN","GPLCCD",154,0)
|
||
Q
|
||
"RTN","GPLCCD",155,0)
|
||
;
|
||
"RTN","GPLCCD",156,0)
|
||
SHAVE(SHXML) ; REMOVES THE 2-6 AND N-1 AND N-2 LINES FROM A COMPONENT
|
||
"RTN","GPLCCD",157,0)
|
||
; NEEDED TO EXPOSE THE REPEATING PARTS FOR GENERATION
|
||
"RTN","GPLCCD",158,0)
|
||
N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
|
||
"RTN","GPLCCD",159,0)
|
||
W SHXML,!
|
||
"RTN","GPLCCD",160,0)
|
||
W @SHXML@(1),!
|
||
"RTN","GPLCCD",161,0)
|
||
D QUEUE^GPLXPATH("SHBLD",SHXML,1,1) ; THE FIRST LINE IS NEEDED
|
||
"RTN","GPLCCD",162,0)
|
||
D QUEUE^GPLXPATH("SHBLD",SHXML,7,@SHXML@(0)-3) ; REPEATING PART
|
||
"RTN","GPLCCD",163,0)
|
||
D QUEUE^GPLXPATH("SHBLD",SHXML,@SHXML@(0),@SHXML@(0)) ; LAST LINE
|
||
"RTN","GPLCCD",164,0)
|
||
D PARY^GPLXPATH("SHBLD") ; PRINT BUILD LIST
|
||
"RTN","GPLCCD",165,0)
|
||
D BUILD^GPLXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
|
||
"RTN","GPLCCD",166,0)
|
||
D CP^GPLXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
|
||
"RTN","GPLCCD",167,0)
|
||
Q
|
||
"RTN","GPLCCD",168,0)
|
||
;
|
||
"RTN","GPLCCD",169,0)
|
||
UNSHAVE(ORIGXML,SHXML) ; REPLACES THE 2-6 AND N-1 AND N-2 LINES FROM TEMPLATE
|
||
"RTN","GPLCCD",170,0)
|
||
; NEEDED TO RESTORM FIXED TOP AND BOTTOM OF THE COMPONENT XML
|
||
"RTN","GPLCCD",171,0)
|
||
N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
|
||
"RTN","GPLCCD",172,0)
|
||
W SHXML,!
|
||
"RTN","GPLCCD",173,0)
|
||
W @SHXML@(1),!
|
||
"RTN","GPLCCD",174,0)
|
||
D QUEUE^GPLXPATH("SHBLD",ORIGXML,1,6) ; FIRST 6 LINES OF TEMPLATE
|
||
"RTN","GPLCCD",175,0)
|
||
D QUEUE^GPLXPATH("SHBLD",SHXML,2,@SHXML@(0)-1) ; INS ALL BUT FIRST/LAST
|
||
"RTN","GPLCCD",176,0)
|
||
D QUEUE^GPLXPATH("SHBLD",ORIGXML,@ORIGXML@(0)-2,@ORIGXML@(0)) ; FROM TEMP
|
||
"RTN","GPLCCD",177,0)
|
||
D PARY^GPLXPATH("SHBLD") ; PRINT BUILD LIST
|
||
"RTN","GPLCCD",178,0)
|
||
D BUILD^GPLXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
|
||
"RTN","GPLCCD",179,0)
|
||
D CP^GPLXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
|
||
"RTN","GPLCCD",180,0)
|
||
Q
|
||
"RTN","GPLCCD",181,0)
|
||
;
|
||
"RTN","GPLCCD",182,0)
|
||
HDRMAP(CXML,DFN,IHDR) ; MAP HEADER VARIABLES: FROM, TO ECT
|
||
"RTN","GPLCCD",183,0)
|
||
N VMAP S VMAP=$NA(^TMP("GPLCCR",$J,DFN,"HEADER"))
|
||
"RTN","GPLCCD",184,0)
|
||
; K @VMAP
|
||
"RTN","GPLCCD",185,0)
|
||
S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$NOW^XLFDT,"DT")
|
||
"RTN","GPLCCD",186,0)
|
||
I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
|
||
"RTN","GPLCCD",187,0)
|
||
. S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
|
||
"RTN","GPLCCD",188,0)
|
||
. S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
|
||
"RTN","GPLCCD",189,0)
|
||
. S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
|
||
"RTN","GPLCCD",190,0)
|
||
. S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES
|
||
"RTN","GPLCCD",191,0)
|
||
. S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR" ; FOR TEST PURPOSES
|
||
"RTN","GPLCCD",192,0)
|
||
. S @VMAP@("ACTORTOTEXT")="Patient" ; FOR TEST PURPOSES
|
||
"RTN","GPLCCD",193,0)
|
||
. ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
|
||
"RTN","GPLCCD",194,0)
|
||
I IHDR'="" D ; HEADER VALUES ARE PROVIDED
|
||
"RTN","GPLCCD",195,0)
|
||
. D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
|
||
"RTN","GPLCCD",196,0)
|
||
N CTMP
|
||
"RTN","GPLCCD",197,0)
|
||
D MAP^GPLXPATH(CXML,VMAP,"CTMP")
|
||
"RTN","GPLCCD",198,0)
|
||
D CP^GPLXPATH("CTMP",CXML)
|
||
"RTN","GPLCCD",199,0)
|
||
Q
|
||
"RTN","GPLCCD",200,0)
|
||
;
|
||
"RTN","GPLCCD",201,0)
|
||
ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
|
||
"RTN","GPLCCD",202,0)
|
||
; AXML AND ACTRTN ARE PASSED BY NAME
|
||
"RTN","GPLCCD",203,0)
|
||
; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
|
||
"RTN","GPLCCD",204,0)
|
||
; P1= OBJECTID - ACTORPATIENT_2
|
||
"RTN","GPLCCD",205,0)
|
||
; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
|
||
"RTN","GPLCCD",206,0)
|
||
;OR INSTITUTION
|
||
"RTN","GPLCCD",207,0)
|
||
; OR PERSON(IN PATIENT FILE IE NOK)
|
||
"RTN","GPLCCD",208,0)
|
||
; P3= IEN RECORD NUMBER FOR ACTOR - 2
|
||
"RTN","GPLCCD",209,0)
|
||
N I,J,K,L
|
||
"RTN","GPLCCD",210,0)
|
||
K @ACTRTN ; CLEAR RETURN ARRAY
|
||
"RTN","GPLCCD",211,0)
|
||
F I=1:1:@AXML@(0) D ; SCAN ALL LINES
|
||
"RTN","GPLCCD",212,0)
|
||
. I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR THIS LINE
|
||
"RTN","GPLCCD",213,0)
|
||
. . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
|
||
"RTN","GPLCCD",214,0)
|
||
. . W "<ActorID>=>",J,!
|
||
"RTN","GPLCCD",215,0)
|
||
. . I J'="" S K(J)="" ; HASHING ACTOR
|
||
"RTN","GPLCCD",216,0)
|
||
. . ; TO GET RID OF DUPLICATES
|
||
"RTN","GPLCCD",217,0)
|
||
S I="" ; GOING TO $O THROUGH THE HASH
|
||
"RTN","GPLCCD",218,0)
|
||
F J=0:0 D Q:$O(K(I))="" ;
|
||
"RTN","GPLCCD",219,0)
|
||
. S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
|
||
"RTN","GPLCCD",220,0)
|
||
. S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
|
||
"RTN","GPLCCD",221,0)
|
||
. S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
|
||
"RTN","GPLCCD",222,0)
|
||
. S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
|
||
"RTN","GPLCCD",223,0)
|
||
. D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
|
||
"RTN","GPLCCD",224,0)
|
||
Q
|
||
"RTN","GPLCCD",225,0)
|
||
;
|
||
"RTN","GPLCCD",226,0)
|
||
TEST ; RUN ALL THE TEST CASES
|
||
"RTN","GPLCCD",227,0)
|
||
D TESTALL^GPLUNIT("GPLCCR")
|
||
"RTN","GPLCCD",228,0)
|
||
Q
|
||
"RTN","GPLCCD",229,0)
|
||
;
|
||
"RTN","GPLCCD",230,0)
|
||
ZTEST(WHICH) ; RUN ONE SET OF TESTS
|
||
"RTN","GPLCCD",231,0)
|
||
N ZTMP
|
||
"RTN","GPLCCD",232,0)
|
||
D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
|
||
"RTN","GPLCCD",233,0)
|
||
D ZTEST^GPLUNIT(.ZTMP,WHICH)
|
||
"RTN","GPLCCD",234,0)
|
||
Q
|
||
"RTN","GPLCCD",235,0)
|
||
;
|
||
"RTN","GPLCCD",236,0)
|
||
TLIST ; LIST THE TESTS
|
||
"RTN","GPLCCD",237,0)
|
||
N ZTMP
|
||
"RTN","GPLCCD",238,0)
|
||
D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
|
||
"RTN","GPLCCD",239,0)
|
||
D TLIST^GPLUNIT(.ZTMP)
|
||
"RTN","GPLCCD",240,0)
|
||
Q
|
||
"RTN","GPLCCD",241,0)
|
||
;
|
||
"RTN","GPLCCD",242,0)
|
||
;;><TEST>
|
||
"RTN","GPLCCD",243,0)
|
||
;;><PROBLEMS>
|
||
"RTN","GPLCCD",244,0)
|
||
;;>>>K GPL S GPL=""
|
||
"RTN","GPLCCD",245,0)
|
||
;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","")
|
||
"RTN","GPLCCD",246,0)
|
||
;;>>?@GPL@(@GPL@(0))["</Problems>"
|
||
"RTN","GPLCCD",247,0)
|
||
;;><VITALS>
|
||
"RTN","GPLCCD",248,0)
|
||
;;>>>K GPL S GPL=""
|
||
"RTN","GPLCCD",249,0)
|
||
;;>>>D CCRRPC^GPLCCR(.GPL,"2","VITALS","","","")
|
||
"RTN","GPLCCD",250,0)
|
||
;;>>?@GPL@(@GPL@(0))["</VitalSigns>"
|
||
"RTN","GPLCCD",251,0)
|
||
;;><CCR>
|
||
"RTN","GPLCCD",252,0)
|
||
;;>>>K GPL S GPL=""
|
||
"RTN","GPLCCD",253,0)
|
||
;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
|
||
"RTN","GPLCCD",254,0)
|
||
;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>"
|
||
"RTN","GPLCCD",255,0)
|
||
;;><ACTLST>
|
||
"RTN","GPLCCD",256,0)
|
||
;;>>>K GPL S GPL=""
|
||
"RTN","GPLCCD",257,0)
|
||
;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
|
||
"RTN","GPLCCD",258,0)
|
||
;;>>>D ACTLST^GPLCCR(GPL,"ACTTEST")
|
||
"RTN","GPLCCD",259,0)
|
||
;;><ACTORS>
|
||
"RTN","GPLCCD",260,0)
|
||
;;>>>D ZTEST^GPLCCR("ACTLST")
|
||
"RTN","GPLCCD",261,0)
|
||
;;>>>D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
|
||
"RTN","GPLCCD",262,0)
|
||
;;>>>D EXTRACT^GPLACTOR("G2","ACTTEST","G3")
|
||
"RTN","GPLCCD",263,0)
|
||
;;>>?G3(G3(0))["</Actors>"
|
||
"RTN","GPLCCD",264,0)
|
||
;;><TRIM>
|
||
"RTN","GPLCCD",265,0)
|
||
;;>>>D ZTEST^GPLCCR("CCR")
|
||
"RTN","GPLCCD",266,0)
|
||
;;>>>W $$TRIM^GPLXPATH(CCDGLO)
|
||
"RTN","GPLCCD",267,0)
|
||
;;><CCD>
|
||
"RTN","GPLCCD",268,0)
|
||
;;>>>K GPL S GPL=""
|
||
"RTN","GPLCCD",269,0)
|
||
;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCD","","","")
|
||
"RTN","GPLCCD",270,0)
|
||
;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>"
|
||
"RTN","GPLCCD",271,0)
|
||
;;></TEST>
|
||
"RTN","GPLCCD1")
|
||
0^15^B100039732
|
||
"RTN","GPLCCD1",1,0)
|
||
GPLCCD1 ; CCDCCR/GPL - CCD TEMPLATE AND ACCESS ROUTINES; 6/7/08
|
||
"RTN","GPLCCD1",2,0)
|
||
;;0.1;CCDCCR;nopatch;noreleasedate;Build 15
|
||
"RTN","GPLCCD1",3,0)
|
||
;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
||
"RTN","GPLCCD1",4,0)
|
||
;General Public License See attached copy of the License.
|
||
"RTN","GPLCCD1",5,0)
|
||
;
|
||
"RTN","GPLCCD1",6,0)
|
||
;This program is free software; you can redistribute it and/or modify
|
||
"RTN","GPLCCD1",7,0)
|
||
;it under the terms of the GNU General Public License as published by
|
||
"RTN","GPLCCD1",8,0)
|
||
;the Free Software Foundation; either version 2 of the License, or
|
||
"RTN","GPLCCD1",9,0)
|
||
;(at your option) any later version.
|
||
"RTN","GPLCCD1",10,0)
|
||
;
|
||
"RTN","GPLCCD1",11,0)
|
||
;This program is distributed in the hope that it will be useful,
|
||
"RTN","GPLCCD1",12,0)
|
||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
"RTN","GPLCCD1",13,0)
|
||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
"RTN","GPLCCD1",14,0)
|
||
;GNU General Public License for more details.
|
||
"RTN","GPLCCD1",15,0)
|
||
;
|
||
"RTN","GPLCCD1",16,0)
|
||
;You should have received a copy of the GNU General Public License along
|
||
"RTN","GPLCCD1",17,0)
|
||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
||
"RTN","GPLCCD1",18,0)
|
||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
||
"RTN","GPLCCD1",19,0)
|
||
;
|
||
"RTN","GPLCCD1",20,0)
|
||
W "This is a CCD TEMPLATE with processing routines",!
|
||
"RTN","GPLCCD1",21,0)
|
||
W !
|
||
"RTN","GPLCCD1",22,0)
|
||
Q
|
||
"RTN","GPLCCD1",23,0)
|
||
;
|
||
"RTN","GPLCCD1",24,0)
|
||
ZT(ZARY,BAT,LINE) ; private routine to add a line to the ZARY array
|
||
"RTN","GPLCCD1",25,0)
|
||
; ZARY IS PASSED BY NAME
|
||
"RTN","GPLCCD1",26,0)
|
||
; BAT is a string identifying the section
|
||
"RTN","GPLCCD1",27,0)
|
||
; LINE is a test which will evaluate to true or false
|
||
"RTN","GPLCCD1",28,0)
|
||
; I '$G(@ZARY) D ; IF ZARY DOES NOT EXIST '
|
||
"RTN","GPLCCD1",29,0)
|
||
; . S @ZARY@(0)=0 ; initially there are no elements
|
||
"RTN","GPLCCD1",30,0)
|
||
; . W "GOT HERE LOADING "_LINE,!
|
||
"RTN","GPLCCD1",31,0)
|
||
N CNT ; count of array elements
|
||
"RTN","GPLCCD1",32,0)
|
||
S CNT=@ZARY@(0) ; contains array count
|
||
"RTN","GPLCCD1",33,0)
|
||
S CNT=CNT+1 ; increment count
|
||
"RTN","GPLCCD1",34,0)
|
||
S @ZARY@(CNT)=LINE ; put the line in the array
|
||
"RTN","GPLCCD1",35,0)
|
||
; S @ZARY@(BAT,CNT)="" ; index the test by battery
|
||
"RTN","GPLCCD1",36,0)
|
||
S @ZARY@(0)=CNT ; update the array counter
|
||
"RTN","GPLCCD1",37,0)
|
||
Q
|
||
"RTN","GPLCCD1",38,0)
|
||
;
|
||
"RTN","GPLCCD1",39,0)
|
||
ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference
|
||
"RTN","GPLCCD1",40,0)
|
||
; ZARY IS PASSED BY NAME
|
||
"RTN","GPLCCD1",41,0)
|
||
; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
|
||
"RTN","GPLCCD1",42,0)
|
||
; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
|
||
"RTN","GPLCCD1",43,0)
|
||
K @ZARY S @ZARY=""
|
||
"RTN","GPLCCD1",44,0)
|
||
S @ZARY@(0)=0 ; initialize array count
|
||
"RTN","GPLCCD1",45,0)
|
||
N LINE,LABEL,BODY
|
||
"RTN","GPLCCD1",46,0)
|
||
N INTEST S INTEST=0 ; switch for in the TEMPLATE section
|
||
"RTN","GPLCCD1",47,0)
|
||
N SECTION S SECTION="[anonymous]" ; NO section LABEL
|
||
"RTN","GPLCCD1",48,0)
|
||
;
|
||
"RTN","GPLCCD1",49,0)
|
||
N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D
|
||
"RTN","GPLCCD1",50,0)
|
||
. I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section
|
||
"RTN","GPLCCD1",51,0)
|
||
. I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section
|
||
"RTN","GPLCCD1",52,0)
|
||
. I INTEST D ; within the section
|
||
"RTN","GPLCCD1",53,0)
|
||
. . I LINE?." "1";><".E D ; sub-section name found
|
||
"RTN","GPLCCD1",54,0)
|
||
. . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
|
||
"RTN","GPLCCD1",55,0)
|
||
. . I LINE?." "1";;".E D ; line found
|
||
"RTN","GPLCCD1",56,0)
|
||
. . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
|
||
"RTN","GPLCCD1",57,0)
|
||
Q
|
||
"RTN","GPLCCD1",58,0)
|
||
;
|
||
"RTN","GPLCCD1",59,0)
|
||
LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
|
||
"RTN","GPLCCD1",60,0)
|
||
D ZLOAD(ARY,"GPLCCD1")
|
||
"RTN","GPLCCD1",61,0)
|
||
; ZWR @ARY
|
||
"RTN","GPLCCD1",62,0)
|
||
Q
|
||
"RTN","GPLCCD1",63,0)
|
||
;
|
||
"RTN","GPLCCD1",64,0)
|
||
TRMCCD ; ROUTINE TO BE WRITTEN TO REMOVE CCR MARKUP FROM CCD
|
||
"RTN","GPLCCD1",65,0)
|
||
Q
|
||
"RTN","GPLCCD1",66,0)
|
||
MARKUP ;<MARKUP>
|
||
"RTN","GPLCCD1",67,0)
|
||
;;<Body>
|
||
"RTN","GPLCCD1",68,0)
|
||
;;<Problems>
|
||
"RTN","GPLCCD1",69,0)
|
||
;;</Problems>
|
||
"RTN","GPLCCD1",70,0)
|
||
;;<FamilyHistory>
|
||
"RTN","GPLCCD1",71,0)
|
||
;;</FamilyHistory>
|
||
"RTN","GPLCCD1",72,0)
|
||
;;<SocialHistory>
|
||
"RTN","GPLCCD1",73,0)
|
||
;;</SocialHistory>
|
||
"RTN","GPLCCD1",74,0)
|
||
;;<Alerts>
|
||
"RTN","GPLCCD1",75,0)
|
||
;;</Alerts>
|
||
"RTN","GPLCCD1",76,0)
|
||
;;<Medications>
|
||
"RTN","GPLCCD1",77,0)
|
||
;;</Medications>
|
||
"RTN","GPLCCD1",78,0)
|
||
;;<VitalSigns>
|
||
"RTN","GPLCCD1",79,0)
|
||
;;</VitalSigns>
|
||
"RTN","GPLCCD1",80,0)
|
||
;;<Results>
|
||
"RTN","GPLCCD1",81,0)
|
||
;;</Results>
|
||
"RTN","GPLCCD1",82,0)
|
||
;;</Body>
|
||
"RTN","GPLCCD1",83,0)
|
||
;;</ContinuityOfCareRecord>
|
||
"RTN","GPLCCD1",84,0)
|
||
;</MARKUP>
|
||
"RTN","GPLCCD1",85,0)
|
||
;;<ClinicalDocument xmlns="urn:hl7-org:v3" xmlns:voc="urn:hl7-org:v3/voc" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="urn:hl7-org:v3 CDA.xsd">
|
||
"RTN","GPLCCD1",86,0)
|
||
;;</ClinicalDocument>
|
||
"RTN","GPLCCD1",87,0)
|
||
Q
|
||
"RTN","GPLCCD1",88,0)
|
||
;
|
||
"RTN","GPLCCD1",89,0)
|
||
;<TEMPLATE>
|
||
"RTN","GPLCCD1",90,0)
|
||
;;<?xml version="1.0"?>
|
||
"RTN","GPLCCD1",91,0)
|
||
;;<?xml-stylesheet type="text/xsl" href="CCD.xsl"?>
|
||
"RTN","GPLCCD1",92,0)
|
||
;;<ClinicalDocument xmlns="urn:hl7-org:v3" xmlns:voc="urn:hl7-org:v3/voc" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="urn:hl7-org:v3 CDA.xsd">
|
||
"RTN","GPLCCD1",93,0)
|
||
;;<typeId root="2.16.840.1.113883.1.3" extension="POCD_HD000040"/>
|
||
"RTN","GPLCCD1",94,0)
|
||
;;<templateId root="2.16.840.1.113883.10.20.1"/>
|
||
"RTN","GPLCCD1",95,0)
|
||
;;<id root="db734647-fc99-424c-a864-7e3cda82e703"/>
|
||
"RTN","GPLCCD1",96,0)
|
||
;;<code code="34133-9" codeSystem="2.16.840.1.113883.6.1" displayName="Summarization of episode note"/>
|
||
"RTN","GPLCCD1",97,0)
|
||
;;<title>Continuity of Care Document</title>
|
||
"RTN","GPLCCD1",98,0)
|
||
;;<effectiveTime value="20000407130000+0500"/>
|
||
"RTN","GPLCCD1",99,0)
|
||
;;<confidentialityCode code="N" codeSystem="2.16.840.1.113883.5.25"/>
|
||
"RTN","GPLCCD1",100,0)
|
||
;;<languageCode code="en-US"/>
|
||
"RTN","GPLCCD1",101,0)
|
||
;;<recordTarget>
|
||
"RTN","GPLCCD1",102,0)
|
||
;;<patientRole>
|
||
"RTN","GPLCCD1",103,0)
|
||
;;<id extension="@@ACTORIEN@@" root="2.16.840.1.113883.19.5"/>
|
||
"RTN","GPLCCD1",104,0)
|
||
;;<patient>
|
||
"RTN","GPLCCD1",105,0)
|
||
;;<name>
|
||
"RTN","GPLCCD1",106,0)
|
||
;;<given>@@ACTORGIVENNAME@@</given>
|
||
"RTN","GPLCCD1",107,0)
|
||
;;<family>@@ACTORFAMILYNAME@@</family>
|
||
"RTN","GPLCCD1",108,0)
|
||
;;<suffix>@@ACTORSUFFIXNAME@@</suffix>
|
||
"RTN","GPLCCD1",109,0)
|
||
;;</name>
|
||
"RTN","GPLCCD1",110,0)
|
||
;;<administrativeGenderCode code="@@ACTORGENDER@@" codeSystem="2.16.840.1.113883.5.1"/>
|
||
"RTN","GPLCCD1",111,0)
|
||
;;<birthTime value="@@ACTORDATEOFBIRTH@@"/>
|
||
"RTN","GPLCCD1",112,0)
|
||
;;</patient>
|
||
"RTN","GPLCCD1",113,0)
|
||
;;<providerOrganization>
|
||
"RTN","GPLCCD1",114,0)
|
||
;;<id root="2.16.840.1.113883.19.5"/>
|
||
"RTN","GPLCCD1",115,0)
|
||
;;<name>@@ORGANIZATIONNAME@@</name>
|
||
"RTN","GPLCCD1",116,0)
|
||
;;</providerOrganization>
|
||
"RTN","GPLCCD1",117,0)
|
||
;;</patientRole>
|
||
"RTN","GPLCCD1",118,0)
|
||
;;</recordTarget>
|
||
"RTN","GPLCCD1",119,0)
|
||
;;<author>
|
||
"RTN","GPLCCD1",120,0)
|
||
;;<time value="20000407130000+0500"/>
|
||
"RTN","GPLCCD1",121,0)
|
||
;;<assignedAuthor>
|
||
"RTN","GPLCCD1",122,0)
|
||
;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/>
|
||
"RTN","GPLCCD1",123,0)
|
||
;;<assignedPerson>
|
||
"RTN","GPLCCD1",124,0)
|
||
;;<name>
|
||
"RTN","GPLCCD1",125,0)
|
||
;;<prefix>@@ACTORNAMEPREFIX@@</prefix>
|
||
"RTN","GPLCCD1",126,0)
|
||
;;<given>@@ACTORGIVENNAME@@</given>
|
||
"RTN","GPLCCD1",127,0)
|
||
;;<family>@@ACTORFAMILYNAME@@</family>
|
||
"RTN","GPLCCD1",128,0)
|
||
;;</name>
|
||
"RTN","GPLCCD1",129,0)
|
||
;;</assignedPerson>
|
||
"RTN","GPLCCD1",130,0)
|
||
;;<representedOrganization>
|
||
"RTN","GPLCCD1",131,0)
|
||
;;<id root="2.16.840.1.113883.19.5"/>
|
||
"RTN","GPLCCD1",132,0)
|
||
;;<name>@@ORGANIZATIONNAME@@</name>
|
||
"RTN","GPLCCD1",133,0)
|
||
;;</representedOrganization>
|
||
"RTN","GPLCCD1",134,0)
|
||
;;</assignedAuthor>
|
||
"RTN","GPLCCD1",135,0)
|
||
;;</author>
|
||
"RTN","GPLCCD1",136,0)
|
||
;;<informant>
|
||
"RTN","GPLCCD1",137,0)
|
||
;;<assignedEntity>
|
||
"RTN","GPLCCD1",138,0)
|
||
;;<id nullFlavor="NI"/>
|
||
"RTN","GPLCCD1",139,0)
|
||
;;<representedOrganization>
|
||
"RTN","GPLCCD1",140,0)
|
||
;;<id root="2.16.840.1.113883.19.5"/>
|
||
"RTN","GPLCCD1",141,0)
|
||
;;<name>@@ORGANIZATIONNAME@@</name>
|
||
"RTN","GPLCCD1",142,0)
|
||
;;</representedOrganization>
|
||
"RTN","GPLCCD1",143,0)
|
||
;;</assignedEntity>
|
||
"RTN","GPLCCD1",144,0)
|
||
;;</informant>
|
||
"RTN","GPLCCD1",145,0)
|
||
;;<custodian>
|
||
"RTN","GPLCCD1",146,0)
|
||
;;<assignedCustodian>
|
||
"RTN","GPLCCD1",147,0)
|
||
;;<representedCustodianOrganization>
|
||
"RTN","GPLCCD1",148,0)
|
||
;;<id root="2.16.840.1.113883.19.5"/>
|
||
"RTN","GPLCCD1",149,0)
|
||
;;<name>@@ORGANIZATIONNAME@@</name>
|
||
"RTN","GPLCCD1",150,0)
|
||
;;</representedCustodianOrganization>
|
||
"RTN","GPLCCD1",151,0)
|
||
;;</assignedCustodian>
|
||
"RTN","GPLCCD1",152,0)
|
||
;;</custodian>
|
||
"RTN","GPLCCD1",153,0)
|
||
;;<legalAuthenticator>
|
||
"RTN","GPLCCD1",154,0)
|
||
;;<time value="20000407130000+0500"/>
|
||
"RTN","GPLCCD1",155,0)
|
||
;;<signatureCode code="S"/>
|
||
"RTN","GPLCCD1",156,0)
|
||
;;<assignedEntity>
|
||
"RTN","GPLCCD1",157,0)
|
||
;;<id nullFlavor="NI"/>
|
||
"RTN","GPLCCD1",158,0)
|
||
;;<representedOrganization>
|
||
"RTN","GPLCCD1",159,0)
|
||
;;<id root="2.16.840.1.113883.19.5"/>
|
||
"RTN","GPLCCD1",160,0)
|
||
;;<name>@@ORGANIZATIONNAME@@</name>
|
||
"RTN","GPLCCD1",161,0)
|
||
;;</representedOrganization>
|
||
"RTN","GPLCCD1",162,0)
|
||
;;</assignedEntity>
|
||
"RTN","GPLCCD1",163,0)
|
||
;;</legalAuthenticator>
|
||
"RTN","GPLCCD1",164,0)
|
||
;;<Actors>
|
||
"RTN","GPLCCD1",165,0)
|
||
;;<ACTOR-NOK>
|
||
"RTN","GPLCCD1",166,0)
|
||
;;<participant typeCode="IND">
|
||
"RTN","GPLCCD1",167,0)
|
||
;;<associatedEntity classCode="NOK">
|
||
"RTN","GPLCCD1",168,0)
|
||
;;<id root="4ac71514-6a10-4164-9715-f8d96af48e6d"/>
|
||
"RTN","GPLCCD1",169,0)
|
||
;;<code code="65656005" codeSystem="2.16.840.1.113883.6.96" displayName="Biiological mother"/>
|
||
"RTN","GPLCCD1",170,0)
|
||
;;<telecom value="tel:(999)555-1212"/>
|
||
"RTN","GPLCCD1",171,0)
|
||
;;<associatedPerson>
|
||
"RTN","GPLCCD1",172,0)
|
||
;;<name>
|
||
"RTN","GPLCCD1",173,0)
|
||
;;<given>Henrietta</given>
|
||
"RTN","GPLCCD1",174,0)
|
||
;;<family>Levin</family>
|
||
"RTN","GPLCCD1",175,0)
|
||
;;</name>
|
||
"RTN","GPLCCD1",176,0)
|
||
;;</associatedPerson>
|
||
"RTN","GPLCCD1",177,0)
|
||
;;</associatedEntity>
|
||
"RTN","GPLCCD1",178,0)
|
||
;;</participant>
|
||
"RTN","GPLCCD1",179,0)
|
||
;;</ACTOR-NOK>
|
||
"RTN","GPLCCD1",180,0)
|
||
;;</Actors>
|
||
"RTN","GPLCCD1",181,0)
|
||
;;<documentationOf>
|
||
"RTN","GPLCCD1",182,0)
|
||
;;<serviceEvent classCode="PCPR">
|
||
"RTN","GPLCCD1",183,0)
|
||
;;<effectiveTime>
|
||
"RTN","GPLCCD1",184,0)
|
||
;;<high value="@@DATETIME@@"/>
|
||
"RTN","GPLCCD1",185,0)
|
||
;;</effectiveTime>
|
||
"RTN","GPLCCD1",186,0)
|
||
;;<performer typeCode="PRF">
|
||
"RTN","GPLCCD1",187,0)
|
||
;;<functionCode code="PCP" codeSystem="2.16.840.1.113883.5.88"/>
|
||
"RTN","GPLCCD1",188,0)
|
||
;;<time>
|
||
"RTN","GPLCCD1",189,0)
|
||
;;<low value="1990"/>
|
||
"RTN","GPLCCD1",190,0)
|
||
;;<high value='20000407'/>
|
||
"RTN","GPLCCD1",191,0)
|
||
;;</time>
|
||
"RTN","GPLCCD1",192,0)
|
||
;;<assignedEntity>
|
||
"RTN","GPLCCD1",193,0)
|
||
;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/>
|
||
"RTN","GPLCCD1",194,0)
|
||
;;<assignedPerson>
|
||
"RTN","GPLCCD1",195,0)
|
||
;;<name>
|
||
"RTN","GPLCCD1",196,0)
|
||
;;<prefix>@@ACTORPREFIXNAME@@</prefix>
|
||
"RTN","GPLCCD1",197,0)
|
||
;;<given>@@ACTORGIVENNAME@@</given>
|
||
"RTN","GPLCCD1",198,0)
|
||
;;<family>@@ACTORFAMILYNAME@@</family>
|
||
"RTN","GPLCCD1",199,0)
|
||
;;</name>
|
||
"RTN","GPLCCD1",200,0)
|
||
;;</assignedPerson>
|
||
"RTN","GPLCCD1",201,0)
|
||
;;<representedOrganization>
|
||
"RTN","GPLCCD1",202,0)
|
||
;;<id root="2.16.840.1.113883.19.5"/>
|
||
"RTN","GPLCCD1",203,0)
|
||
;;<name>@@ORGANIZATIONNAME@@</name>
|
||
"RTN","GPLCCD1",204,0)
|
||
;;</representedOrganization>
|
||
"RTN","GPLCCD1",205,0)
|
||
;;</assignedEntity>
|
||
"RTN","GPLCCD1",206,0)
|
||
;;</performer>
|
||
"RTN","GPLCCD1",207,0)
|
||
;;</serviceEvent>
|
||
"RTN","GPLCCD1",208,0)
|
||
;;</documentationOf>
|
||
"RTN","GPLCCD1",209,0)
|
||
;;<Body>
|
||
"RTN","GPLCCD1",210,0)
|
||
;;<PROBLEMS-HTML>
|
||
"RTN","GPLCCD1",211,0)
|
||
;;<text><table border="1" width="100%"><thead><tr><th>Condition</th><th>Effective Dates</th><th>Condition Status</th></tr></thead><tbody>
|
||
"RTN","GPLCCD1",212,0)
|
||
;;<tr><td>@@PROBLEMDESCRIPTION@@</td>
|
||
"RTN","GPLCCD1",213,0)
|
||
;;<td>@@PROBLEMDATEOFONSET@@</td>
|
||
"RTN","GPLCCD1",214,0)
|
||
;;<td>Active</td></tr>
|
||
"RTN","GPLCCD1",215,0)
|
||
;;</tbody></table></text>
|
||
"RTN","GPLCCD1",216,0)
|
||
;;</PROBLEMS-HTML>
|
||
"RTN","GPLCCD1",217,0)
|
||
;;<Problems>
|
||
"RTN","GPLCCD1",218,0)
|
||
;;<component>
|
||
"RTN","GPLCCD1",219,0)
|
||
;;<section>
|
||
"RTN","GPLCCD1",220,0)
|
||
;;<templateId root='2.16.840.1.113883.10.20.1.11'/>
|
||
"RTN","GPLCCD1",221,0)
|
||
;;<code code="11450-4" codeSystem="2.16.840.1.113883.6.1"/>
|
||
"RTN","GPLCCD1",222,0)
|
||
;;<title>Problems</title>
|
||
"RTN","GPLCCD1",223,0)
|
||
;;<entry typeCode="DRIV">
|
||
"RTN","GPLCCD1",224,0)
|
||
;;<act classCode="ACT" moodCode="EVN">
|
||
"RTN","GPLCCD1",225,0)
|
||
;;<templateId root='2.16.840.1.113883.10.20.1.27'/>
|
||
"RTN","GPLCCD1",226,0)
|
||
;;<id root="6a2fa88d-4174-4909-aece-db44b60a3abb"/>
|
||
"RTN","GPLCCD1",227,0)
|
||
;;<code nullFlavor="NA"/>
|
||
"RTN","GPLCCD1",228,0)
|
||
;;<entryRelationship typeCode="SUBJ">
|
||
"RTN","GPLCCD1",229,0)
|
||
;;<observation classCode="OBS" moodCode="EVN">
|
||
"RTN","GPLCCD1",230,0)
|
||
;;<templateId root='2.16.840.1.113883.10.20.1.28'/>
|
||
"RTN","GPLCCD1",231,0)
|
||
;;<id root="d11275e7-67ae-11db-bd13-0800200c9a66"/>
|
||
"RTN","GPLCCD1",232,0)
|
||
;;<code code="ASSERTION" codeSystem="2.16.840.1.113883.5.4"/>
|
||
"RTN","GPLCCD1",233,0)
|
||
;;<statusCode code="completed"/>
|
||
"RTN","GPLCCD1",234,0)
|
||
;;<effectiveTime>
|
||
"RTN","GPLCCD1",235,0)
|
||
;;<low value="@@PROBLEMDATEOFONSET@@"/>
|
||
"RTN","GPLCCD1",236,0)
|
||
;;</effectiveTime>
|
||
"RTN","GPLCCD1",237,0)
|
||
;;<value xsi:type="CD" code="@@PROBLEMCODEVALUE@@" codeSystem="2.16.840.1.113883.6.96" displayName="@@PROBLEMDESCRIPTION@@"/>
|
||
"RTN","GPLCCD1",238,0)
|
||
;;<entryRelationship typeCode="REFR">
|
||
"RTN","GPLCCD1",239,0)
|
||
;;<observation classCode="OBS" moodCode="EVN">
|
||
"RTN","GPLCCD1",240,0)
|
||
;;<templateId root='2.16.840.1.113883.10.20.1.50'/>
|
||
"RTN","GPLCCD1",241,0)
|
||
;;<code code="33999-4" codeSystem="2.16.840.1.113883.6.1" displayName="Status"/>
|
||
"RTN","GPLCCD1",242,0)
|
||
;;<statusCode code="completed"/>
|
||
"RTN","GPLCCD1",243,0)
|
||
;;<value xsi:type="CE" code="55561003" codeSystem="2.16.840.1.113883.6.96" displayName="Active"/>
|
||
"RTN","GPLCCD1",244,0)
|
||
;;</observation>
|
||
"RTN","GPLCCD1",245,0)
|
||
;;</entryRelationship>
|
||
"RTN","GPLCCD1",246,0)
|
||
;;</observation>
|
||
"RTN","GPLCCD1",247,0)
|
||
;;</entryRelationship>
|
||
"RTN","GPLCCD1",248,0)
|
||
;;</act>
|
||
"RTN","GPLCCD1",249,0)
|
||
;;</entry>
|
||
"RTN","GPLCCD1",250,0)
|
||
;;</section>
|
||
"RTN","GPLCCD1",251,0)
|
||
;;</component>
|
||
"RTN","GPLCCD1",252,0)
|
||
;;</Problems>
|
||
"RTN","GPLCCD1",253,0)
|
||
;;<FamilyHistory>
|
||
"RTN","GPLCCD1",254,0)
|
||
;;</FamilyHistory>
|
||
"RTN","GPLCCD1",255,0)
|
||
;;<SocialHistory>
|
||
"RTN","GPLCCD1",256,0)
|
||
;;</SocialHistory>
|
||
"RTN","GPLCCD1",257,0)
|
||
;;<Alerts>
|
||
"RTN","GPLCCD1",258,0)
|
||
;;</Alerts>
|
||
"RTN","GPLCCD1",259,0)
|
||
;;<Medications>
|
||
"RTN","GPLCCD1",260,0)
|
||
;;</Medications>
|
||
"RTN","GPLCCD1",261,0)
|
||
;;<VitalSigns>
|
||
"RTN","GPLCCD1",262,0)
|
||
;;</VitalSigns>
|
||
"RTN","GPLCCD1",263,0)
|
||
;;<Results>
|
||
"RTN","GPLCCD1",264,0)
|
||
;;</Results>
|
||
"RTN","GPLCCD1",265,0)
|
||
;;</Body>
|
||
"RTN","GPLCCD1",266,0)
|
||
;;</ClinicalDocument>
|
||
"RTN","GPLCCD1",267,0)
|
||
;</TEMPLATE>
|
||
"RTN","GPLCCR")
|
||
0^13^B81638593
|
||
"RTN","GPLCCR",1,0)
|
||
GPLCCR ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
|
||
"RTN","GPLCCR",2,0)
|
||
;;0.1;CCDCCR;nopatch;noreleasedate;Build 15
|
||
"RTN","GPLCCR",3,0)
|
||
;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
||
"RTN","GPLCCR",4,0)
|
||
;General Public License See attached copy of the License.
|
||
"RTN","GPLCCR",5,0)
|
||
;
|
||
"RTN","GPLCCR",6,0)
|
||
;This program is free software; you can redistribute it and/or modify
|
||
"RTN","GPLCCR",7,0)
|
||
;it under the terms of the GNU General Public License as published by
|
||
"RTN","GPLCCR",8,0)
|
||
;the Free Software Foundation; either version 2 of the License, or
|
||
"RTN","GPLCCR",9,0)
|
||
;(at your option) any later version.
|
||
"RTN","GPLCCR",10,0)
|
||
;
|
||
"RTN","GPLCCR",11,0)
|
||
;This program is distributed in the hope that it will be useful,
|
||
"RTN","GPLCCR",12,0)
|
||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
"RTN","GPLCCR",13,0)
|
||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
"RTN","GPLCCR",14,0)
|
||
;GNU General Public License for more details.
|
||
"RTN","GPLCCR",15,0)
|
||
;
|
||
"RTN","GPLCCR",16,0)
|
||
;You should have received a copy of the GNU General Public License along
|
||
"RTN","GPLCCR",17,0)
|
||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
||
"RTN","GPLCCR",18,0)
|
||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
||
"RTN","GPLCCR",19,0)
|
||
;
|
||
"RTN","GPLCCR",20,0)
|
||
; EXPORT A CCR
|
||
"RTN","GPLCCR",21,0)
|
||
;
|
||
"RTN","GPLCCR",22,0)
|
||
EXPORT ; EXPORT ENTRY POINT FOR CCR
|
||
"RTN","GPLCCR",23,0)
|
||
; Select a patient.
|
||
"RTN","GPLCCR",24,0)
|
||
S DIC=2,DIC(0)="AEMQ" D ^DIC
|
||
"RTN","GPLCCR",25,0)
|
||
I Y<1 Q ; EXIT
|
||
"RTN","GPLCCR",26,0)
|
||
S DFN=$P(Y,U,1) ; SET THE PATIENT
|
||
"RTN","GPLCCR",27,0)
|
||
D XPAT(DFN,"","") ; EXPORT TO A FILE
|
||
"RTN","GPLCCR",28,0)
|
||
Q
|
||
"RTN","GPLCCR",29,0)
|
||
;
|
||
"RTN","GPLCCR",30,0)
|
||
XPAT(DFN,DIR,FN) ; EXPORT ONE PATIENT TO A FILE
|
||
"RTN","GPLCCR",31,0)
|
||
; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("GPLCCR","ODIR")
|
||
"RTN","GPLCCR",32,0)
|
||
; FN IS FILE NAME, DEFAULTS IF NULL
|
||
"RTN","GPLCCR",33,0)
|
||
N CCRGLO,UDIR,UFN
|
||
"RTN","GPLCCR",34,0)
|
||
I '$D(DIR) S UDIR=""
|
||
"RTN","GPLCCR",35,0)
|
||
E S UDIR=DIR
|
||
"RTN","GPLCCR",36,0)
|
||
I '$D(FN) S UFN=""
|
||
"RTN","GPLCCR",37,0)
|
||
E S UFN=FN
|
||
"RTN","GPLCCR",38,0)
|
||
D CCRRPC(.CCRGLO,DFN,"CCR","","","")
|
||
"RTN","GPLCCR",39,0)
|
||
S OARY=$NA(^TMP("GPLCCR",$J,DFN,"CCR",1))
|
||
"RTN","GPLCCR",40,0)
|
||
S ONAM=UFN
|
||
"RTN","GPLCCR",41,0)
|
||
I UFN="" S ONAM="PAT_"_DFN_"_CCR_V1_0_7.xml"
|
||
"RTN","GPLCCR",42,0)
|
||
S ODIRGLB=$NA(^TMP("GPLCCR","ODIR"))
|
||
"RTN","GPLCCR",43,0)
|
||
I '$D(@ODIRGLB) D ; IF NOT ODIR HAS BEEN SET
|
||
"RTN","GPLCCR",44,0)
|
||
. ;S @ODIRGLB="/home/glilly/CCROUT"
|
||
"RTN","GPLCCR",45,0)
|
||
. ;S @ODIRGLB="/home/cedwards/"
|
||
"RTN","GPLCCR",46,0)
|
||
. S @ODIRGLB="/opt/wv/p/"
|
||
"RTN","GPLCCR",47,0)
|
||
S ODIR=UDIR
|
||
"RTN","GPLCCR",48,0)
|
||
I UDIR="" S ODIR=@ODIRGLB
|
||
"RTN","GPLCCR",49,0)
|
||
N ZY
|
||
"RTN","GPLCCR",50,0)
|
||
S ZY=$$OUTPUT^GPLXPATH(OARY,ONAM,ODIR)
|
||
"RTN","GPLCCR",51,0)
|
||
W !,$P(ZY,U,2),!
|
||
"RTN","GPLCCR",52,0)
|
||
Q
|
||
"RTN","GPLCCR",53,0)
|
||
;
|
||
"RTN","GPLCCR",54,0)
|
||
DCCR(DFN) ; DISPLAY A CCR THAT HAS JUST BEEN EXTRACTED
|
||
"RTN","GPLCCR",55,0)
|
||
;
|
||
"RTN","GPLCCR",56,0)
|
||
N G1
|
||
"RTN","GPLCCR",57,0)
|
||
S G1=$NA(^TMP("GPLCCR",$J,DFN,"CCR"))
|
||
"RTN","GPLCCR",58,0)
|
||
I $D(@G1@(0)) D ; CCR EXISTS
|
||
"RTN","GPLCCR",59,0)
|
||
. D PARY^GPLXPATH(G1)
|
||
"RTN","GPLCCR",60,0)
|
||
E W "CCR NOT CREATED, RUN D XPAT^GPLCCR(DFN,"""","""") FIRST",!
|
||
"RTN","GPLCCR",61,0)
|
||
Q
|
||
"RTN","GPLCCR",62,0)
|
||
;
|
||
"RTN","GPLCCR",63,0)
|
||
CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT
|
||
"RTN","GPLCCR",64,0)
|
||
; CCRGRTN IS RETURN ARRAY PASSED BY NAME
|
||
"RTN","GPLCCR",65,0)
|
||
; DFN IS PATIENT IEN
|
||
"RTN","GPLCCR",66,0)
|
||
; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
|
||
"RTN","GPLCCR",67,0)
|
||
; OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
|
||
"RTN","GPLCCR",68,0)
|
||
; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
|
||
"RTN","GPLCCR",69,0)
|
||
; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
|
||
"RTN","GPLCCR",70,0)
|
||
; - NULL MEANS NOW
|
||
"RTN","GPLCCR",71,0)
|
||
; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
|
||
"RTN","GPLCCR",72,0)
|
||
; "TO" VARIABLES
|
||
"RTN","GPLCCR",73,0)
|
||
; IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN
|
||
"RTN","GPLCCR",74,0)
|
||
I '$D(DEBUG) S DEBUG=0
|
||
"RTN","GPLCCR",75,0)
|
||
S CCD=0 ; NEED THIS FLAG TO DISTINGUISH FROM CCD
|
||
"RTN","GPLCCR",76,0)
|
||
I '$D(TESTLAB) S TESTLAB=0 ; FLAG FOR TESTING RESULTS SECTION
|
||
"RTN","GPLCCR",77,0)
|
||
I '$D(TESTALERT) S TESTALERT=1 ; FLAG FOR TESTING ALERTS SECTION
|
||
"RTN","GPLCCR",78,0)
|
||
I '$D(TESTMEDS) S TESTMEDS=0 ; FLAG FOR TESTING CCRMEDS SECTION
|
||
"RTN","GPLCCR",79,0)
|
||
S TGLOBAL=$NA(^TMP("GPLCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
|
||
"RTN","GPLCCR",80,0)
|
||
S CCRGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
|
||
"RTN","GPLCCR",81,0)
|
||
S ACTGLO=$NA(^TMP("GPLCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
|
||
"RTN","GPLCCR",82,0)
|
||
; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
|
||
"RTN","GPLCCR",83,0)
|
||
S CCRGRTN=$NA(^TMP("GPLCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
|
||
"RTN","GPLCCR",84,0)
|
||
D LOAD^GPLCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE
|
||
"RTN","GPLCCR",85,0)
|
||
D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
|
||
"RTN","GPLCCR",86,0)
|
||
;
|
||
"RTN","GPLCCR",87,0)
|
||
; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
|
||
"RTN","GPLCCR",88,0)
|
||
; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
|
||
"RTN","GPLCCR",89,0)
|
||
D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
|
||
"RTN","GPLCCR",90,0)
|
||
D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
|
||
"RTN","GPLCCR",91,0)
|
||
D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
|
||
"RTN","GPLCCR",92,0)
|
||
I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
|
||
"RTN","GPLCCR",93,0)
|
||
;
|
||
"RTN","GPLCCR",94,0)
|
||
D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
|
||
"RTN","GPLCCR",95,0)
|
||
;
|
||
"RTN","GPLCCR",96,0)
|
||
K ^TMP("GPLCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
|
||
"RTN","GPLCCR",97,0)
|
||
S CCRXTAB=$NA(^TMP("GPLCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
|
||
"RTN","GPLCCR",98,0)
|
||
D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
|
||
"RTN","GPLCCR",99,0)
|
||
N PROCI,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
|
||
"RTN","GPLCCR",100,0)
|
||
F PROCI=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS
|
||
"RTN","GPLCCR",101,0)
|
||
. S XI=@CCRXTAB@(PROCI) ; CALL COPONENTS TO PARSE
|
||
"RTN","GPLCCR",102,0)
|
||
. S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
|
||
"RTN","GPLCCR",103,0)
|
||
. S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
|
||
"RTN","GPLCCR",104,0)
|
||
. S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
|
||
"RTN","GPLCCR",105,0)
|
||
. D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
|
||
"RTN","GPLCCR",106,0)
|
||
. S IXML="INXML"
|
||
"RTN","GPLCCR",107,0)
|
||
. S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
|
||
"RTN","GPLCCR",108,0)
|
||
. ; K @OXML ; KILL EXPECTED OUTPUT ARRAY
|
||
"RTN","GPLCCR",109,0)
|
||
. ; W OXML,!
|
||
"RTN","GPLCCR",110,0)
|
||
. S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
|
||
"RTN","GPLCCR",111,0)
|
||
. W "RUNNING ",CALL,!
|
||
"RTN","GPLCCR",112,0)
|
||
. X CALL
|
||
"RTN","GPLCCR",113,0)
|
||
. ; NOW INSERT THE RESULTS IN THE CCR BUFFER
|
||
"RTN","GPLCCR",114,0)
|
||
. I @OXML@(0)'=0 D ; THERE IS A RESULT
|
||
"RTN","GPLCCR",115,0)
|
||
. . D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
|
||
"RTN","GPLCCR",116,0)
|
||
. . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
|
||
"RTN","GPLCCR",117,0)
|
||
N ACTT,ATMP,ACTT2,ATMP2 ; TEMPORARY ARRAY SYMBOLS FOR ACTOR PROCESSING
|
||
"RTN","GPLCCR",118,0)
|
||
D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
|
||
"RTN","GPLCCR",119,0)
|
||
D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
|
||
"RTN","GPLCCR",120,0)
|
||
D EXTRACT^GPLACTOR("ACTT",ACTGLO,"ACTT2")
|
||
"RTN","GPLCCR",121,0)
|
||
D INSINNER^GPLXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
|
||
"RTN","GPLCCR",122,0)
|
||
N TRIMI,J,DONE S DONE=0
|
||
"RTN","GPLCCR",123,0)
|
||
F TRIMI=0:0 D Q:DONE ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
|
||
"RTN","GPLCCR",124,0)
|
||
. S J=$$TRIM^GPLXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS
|
||
"RTN","GPLCCR",125,0)
|
||
. I DEBUG W "TRIMMED",J,!
|
||
"RTN","GPLCCR",126,0)
|
||
. I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
|
||
"RTN","GPLCCR",127,0)
|
||
Q
|
||
"RTN","GPLCCR",128,0)
|
||
;
|
||
"RTN","GPLCCR",129,0)
|
||
INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS
|
||
"RTN","GPLCCR",130,0)
|
||
; TAB IS PASSED BY NAME
|
||
"RTN","GPLCCR",131,0)
|
||
I DEBUG W "TAB= ",TAB,!
|
||
"RTN","GPLCCR",132,0)
|
||
; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
|
||
"RTN","GPLCCR",133,0)
|
||
D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""GPLCCR"",$J,DFN,""PROBLEMS"")")
|
||
"RTN","GPLCCR",134,0)
|
||
D PUSH^GPLXPATH(TAB,"EXTRACT;CCRMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")")
|
||
"RTN","GPLCCR",135,0)
|
||
D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""GPLCCR"",$J,DFN,""VITALS"")")
|
||
"RTN","GPLCCR",136,0)
|
||
D PUSH^GPLXPATH(TAB,"MAP;GPLLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""GPLCCR"",$J,DFN,""RESULTS"")")
|
||
"RTN","GPLCCR",137,0)
|
||
I TESTALERT D PUSH^GPLXPATH(TAB,"EXTRACT;GPLALERT;//ContinuityOfCareRecord/Body/Alerts;^TMP(""GPLCCR"",$J,DFN,""ALERTS"")")
|
||
"RTN","GPLCCR",138,0)
|
||
Q
|
||
"RTN","GPLCCR",139,0)
|
||
;
|
||
"RTN","GPLCCR",140,0)
|
||
HDRMAP(CXML,DFN,IHDR) ; MAP HEADER VARIABLES: FROM, TO ECT
|
||
"RTN","GPLCCR",141,0)
|
||
N VMAP S VMAP=$NA(^TMP("GPLCCR",$J,DFN,"HEADER"))
|
||
"RTN","GPLCCR",142,0)
|
||
; K @VMAP
|
||
"RTN","GPLCCR",143,0)
|
||
S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$NOW^XLFDT,"DT")
|
||
"RTN","GPLCCR",144,0)
|
||
I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
|
||
"RTN","GPLCCR",145,0)
|
||
. S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
|
||
"RTN","GPLCCR",146,0)
|
||
. S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
|
||
"RTN","GPLCCR",147,0)
|
||
. S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
|
||
"RTN","GPLCCR",148,0)
|
||
. S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES
|
||
"RTN","GPLCCR",149,0)
|
||
. S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR" ; FOR TEST PURPOSES
|
||
"RTN","GPLCCR",150,0)
|
||
. S @VMAP@("ACTORTOTEXT")="Patient" ; FOR TEST PURPOSES
|
||
"RTN","GPLCCR",151,0)
|
||
. ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
|
||
"RTN","GPLCCR",152,0)
|
||
I IHDR'="" D ; HEADER VALUES ARE PROVIDED
|
||
"RTN","GPLCCR",153,0)
|
||
. D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
|
||
"RTN","GPLCCR",154,0)
|
||
N CTMP
|
||
"RTN","GPLCCR",155,0)
|
||
D MAP^GPLXPATH(CXML,VMAP,"CTMP")
|
||
"RTN","GPLCCR",156,0)
|
||
D CP^GPLXPATH("CTMP",CXML)
|
||
"RTN","GPLCCR",157,0)
|
||
Q
|
||
"RTN","GPLCCR",158,0)
|
||
;
|
||
"RTN","GPLCCR",159,0)
|
||
ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
|
||
"RTN","GPLCCR",160,0)
|
||
; AXML AND ACTRTN ARE PASSED BY NAME
|
||
"RTN","GPLCCR",161,0)
|
||
; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
|
||
"RTN","GPLCCR",162,0)
|
||
; P1= OBJECTID - ACTORPATIENT_2
|
||
"RTN","GPLCCR",163,0)
|
||
; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
|
||
"RTN","GPLCCR",164,0)
|
||
;OR INSTITUTION
|
||
"RTN","GPLCCR",165,0)
|
||
; OR PERSON(IN PATIENT FILE IE NOK)
|
||
"RTN","GPLCCR",166,0)
|
||
; P3= IEN RECORD NUMBER FOR ACTOR - 2
|
||
"RTN","GPLCCR",167,0)
|
||
N I,J,K,L
|
||
"RTN","GPLCCR",168,0)
|
||
K @ACTRTN ; CLEAR RETURN ARRAY
|
||
"RTN","GPLCCR",169,0)
|
||
F I=1:1:@AXML@(0) D ; SCAN ALL LINES
|
||
"RTN","GPLCCR",170,0)
|
||
. I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR THIS LINE
|
||
"RTN","GPLCCR",171,0)
|
||
. . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
|
||
"RTN","GPLCCR",172,0)
|
||
. . I DEBUG W "<ActorID>=>",J,!
|
||
"RTN","GPLCCR",173,0)
|
||
. . I J'="" S K(J)="" ; HASHING ACTOR
|
||
"RTN","GPLCCR",174,0)
|
||
. . ; TO GET RID OF DUPLICATES
|
||
"RTN","GPLCCR",175,0)
|
||
S I="" ; GOING TO $O THROUGH THE HASH
|
||
"RTN","GPLCCR",176,0)
|
||
F J=0:0 D Q:$O(K(I))=""
|
||
"RTN","GPLCCR",177,0)
|
||
. S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
|
||
"RTN","GPLCCR",178,0)
|
||
. S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
|
||
"RTN","GPLCCR",179,0)
|
||
. S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
|
||
"RTN","GPLCCR",180,0)
|
||
. S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
|
||
"RTN","GPLCCR",181,0)
|
||
. D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
|
||
"RTN","GPLCCR",182,0)
|
||
Q
|
||
"RTN","GPLCCR",183,0)
|
||
;
|
||
"RTN","GPLCCR",184,0)
|
||
TEST ; RUN ALL THE TEST CASES
|
||
"RTN","GPLCCR",185,0)
|
||
D TESTALL^GPLUNIT("GPLCCR")
|
||
"RTN","GPLCCR",186,0)
|
||
Q
|
||
"RTN","GPLCCR",187,0)
|
||
;
|
||
"RTN","GPLCCR",188,0)
|
||
ZTEST(WHICH) ; RUN ONE SET OF TESTS
|
||
"RTN","GPLCCR",189,0)
|
||
N ZTMP
|
||
"RTN","GPLCCR",190,0)
|
||
D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
|
||
"RTN","GPLCCR",191,0)
|
||
D ZTEST^GPLUNIT(.ZTMP,WHICH)
|
||
"RTN","GPLCCR",192,0)
|
||
Q
|
||
"RTN","GPLCCR",193,0)
|
||
;
|
||
"RTN","GPLCCR",194,0)
|
||
TLIST ; LIST THE TESTS
|
||
"RTN","GPLCCR",195,0)
|
||
N ZTMP
|
||
"RTN","GPLCCR",196,0)
|
||
D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
|
||
"RTN","GPLCCR",197,0)
|
||
D TLIST^GPLUNIT(.ZTMP)
|
||
"RTN","GPLCCR",198,0)
|
||
Q
|
||
"RTN","GPLCCR",199,0)
|
||
;
|
||
"RTN","GPLCCR",200,0)
|
||
;;><TEST>
|
||
"RTN","GPLCCR",201,0)
|
||
;;><PROBLEMS>
|
||
"RTN","GPLCCR",202,0)
|
||
;;>>>K GPL S GPL=""
|
||
"RTN","GPLCCR",203,0)
|
||
;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","")
|
||
"RTN","GPLCCR",204,0)
|
||
;;>>?@GPL@(@GPL@(0))["</Problems>"
|
||
"RTN","GPLCCR",205,0)
|
||
;;><VITALS>
|
||
"RTN","GPLCCR",206,0)
|
||
;;>>>K GPL S GPL=""
|
||
"RTN","GPLCCR",207,0)
|
||
;;>>>D CCRRPC^GPLCCR(.GPL,"2","VITALS","","","")
|
||
"RTN","GPLCCR",208,0)
|
||
;;>>?@GPL@(@GPL@(0))["</VitalSigns>"
|
||
"RTN","GPLCCR",209,0)
|
||
;;><CCR>
|
||
"RTN","GPLCCR",210,0)
|
||
;;>>>K GPL S GPL=""
|
||
"RTN","GPLCCR",211,0)
|
||
;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
|
||
"RTN","GPLCCR",212,0)
|
||
;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>"
|
||
"RTN","GPLCCR",213,0)
|
||
;;><ACTLST>
|
||
"RTN","GPLCCR",214,0)
|
||
;;>>>K GPL S GPL=""
|
||
"RTN","GPLCCR",215,0)
|
||
;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
|
||
"RTN","GPLCCR",216,0)
|
||
;;>>>D ACTLST^GPLCCR(GPL,"ACTTEST")
|
||
"RTN","GPLCCR",217,0)
|
||
;;><ACTORS>
|
||
"RTN","GPLCCR",218,0)
|
||
;;>>>D ZTEST^GPLCCR("ACTLST")
|
||
"RTN","GPLCCR",219,0)
|
||
;;>>>D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
|
||
"RTN","GPLCCR",220,0)
|
||
;;>>>D EXTRACT^GPLACTOR("G2","ACTTEST","G3")
|
||
"RTN","GPLCCR",221,0)
|
||
;;>>?G3(G3(0))["</Actors>"
|
||
"RTN","GPLCCR",222,0)
|
||
;;><TRIM>
|
||
"RTN","GPLCCR",223,0)
|
||
;;>>>D ZTEST^GPLCCR("CCR")
|
||
"RTN","GPLCCR",224,0)
|
||
;;>>>W $$TRIM^GPLXPATH(CCRGLO)
|
||
"RTN","GPLCCR",225,0)
|
||
;;><ALERTS>
|
||
"RTN","GPLCCR",226,0)
|
||
;;>>>S TESTALERT=1
|
||
"RTN","GPLCCR",227,0)
|
||
;;>>>K GPL S GPL=""
|
||
"RTN","GPLCCR",228,0)
|
||
;;>>>D CCRRPC^GPLCCR(.GPL,"2","ALERTS","","","")
|
||
"RTN","GPLCCR",229,0)
|
||
;;>>?@GPL@(@GPL@(0))["</Alerts>"
|
||
"RTN","GPLCCR",230,0)
|
||
|
||
"RTN","GPLCCR0")
|
||
0^14^B555785104
|
||
"RTN","GPLCCR0",1,0)
|
||
GPLCCR0 ; CCDCCR/GPL - CCR TEMPLATE AND ACCESS ROUTINES; 5/31/08
|
||
"RTN","GPLCCR0",2,0)
|
||
;;0.1;CCDCCR;nopatch;noreleasedate;Build 15
|
||
"RTN","GPLCCR0",3,0)
|
||
;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
||
"RTN","GPLCCR0",4,0)
|
||
;General Public License See attached copy of the License.
|
||
"RTN","GPLCCR0",5,0)
|
||
;
|
||
"RTN","GPLCCR0",6,0)
|
||
;This program is free software; you can redistribute it and/or modify
|
||
"RTN","GPLCCR0",7,0)
|
||
;it under the terms of the GNU General Public License as published by
|
||
"RTN","GPLCCR0",8,0)
|
||
;the Free Software Foundation; either version 2 of the License, or
|
||
"RTN","GPLCCR0",9,0)
|
||
;(at your option) any later version.
|
||
"RTN","GPLCCR0",10,0)
|
||
;
|
||
"RTN","GPLCCR0",11,0)
|
||
;This program is distributed in the hope that it will be useful,
|
||
"RTN","GPLCCR0",12,0)
|
||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
"RTN","GPLCCR0",13,0)
|
||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
"RTN","GPLCCR0",14,0)
|
||
;GNU General Public License for more details.
|
||
"RTN","GPLCCR0",15,0)
|
||
;
|
||
"RTN","GPLCCR0",16,0)
|
||
;You should have received a copy of the GNU General Public License along
|
||
"RTN","GPLCCR0",17,0)
|
||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
||
"RTN","GPLCCR0",18,0)
|
||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
||
"RTN","GPLCCR0",19,0)
|
||
;
|
||
"RTN","GPLCCR0",20,0)
|
||
W "This is a CCR TEMPLATE with processing routines",!
|
||
"RTN","GPLCCR0",21,0)
|
||
W !
|
||
"RTN","GPLCCR0",22,0)
|
||
Q
|
||
"RTN","GPLCCR0",23,0)
|
||
;
|
||
"RTN","GPLCCR0",24,0)
|
||
ZT(ZARY,BAT,LINE) ; private routine to add a line to the ZARY array
|
||
"RTN","GPLCCR0",25,0)
|
||
; ZARY IS PASSED BY NAME
|
||
"RTN","GPLCCR0",26,0)
|
||
; BAT is a string identifying the section
|
||
"RTN","GPLCCR0",27,0)
|
||
; LINE is a test which will evaluate to true or false
|
||
"RTN","GPLCCR0",28,0)
|
||
; I '$G(@ZARY) D ;
|
||
"RTN","GPLCCR0",29,0)
|
||
; . S @ZARY@(0)=0 ; initially there are no elements
|
||
"RTN","GPLCCR0",30,0)
|
||
; . W "GOT HERE LOADING "_LINE,!
|
||
"RTN","GPLCCR0",31,0)
|
||
N CNT ; count of array elements
|
||
"RTN","GPLCCR0",32,0)
|
||
S CNT=@ZARY@(0) ; contains array count
|
||
"RTN","GPLCCR0",33,0)
|
||
S CNT=CNT+1 ; increment count
|
||
"RTN","GPLCCR0",34,0)
|
||
S @ZARY@(CNT)=LINE ; put the line in the array
|
||
"RTN","GPLCCR0",35,0)
|
||
; S @ZARY@(BAT,CNT)="" ; index the test by battery
|
||
"RTN","GPLCCR0",36,0)
|
||
S @ZARY@(0)=CNT ; update the array counter
|
||
"RTN","GPLCCR0",37,0)
|
||
Q
|
||
"RTN","GPLCCR0",38,0)
|
||
;
|
||
"RTN","GPLCCR0",39,0)
|
||
ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference
|
||
"RTN","GPLCCR0",40,0)
|
||
; ZARY IS PASSED BY NAME
|
||
"RTN","GPLCCR0",41,0)
|
||
; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
|
||
"RTN","GPLCCR0",42,0)
|
||
; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
|
||
"RTN","GPLCCR0",43,0)
|
||
K @ZARY S @ZARY=""
|
||
"RTN","GPLCCR0",44,0)
|
||
S @ZARY@(0)=0 ; initialize array count
|
||
"RTN","GPLCCR0",45,0)
|
||
N LINE,LABEL,BODY
|
||
"RTN","GPLCCR0",46,0)
|
||
N INTEST S INTEST=0 ; switch for in the TEMPLATE section
|
||
"RTN","GPLCCR0",47,0)
|
||
N SECTION S SECTION="[anonymous]" ; NO section LABEL
|
||
"RTN","GPLCCR0",48,0)
|
||
;
|
||
"RTN","GPLCCR0",49,0)
|
||
N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D
|
||
"RTN","GPLCCR0",50,0)
|
||
. I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section
|
||
"RTN","GPLCCR0",51,0)
|
||
. I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section
|
||
"RTN","GPLCCR0",52,0)
|
||
. I INTEST D ; within the section
|
||
"RTN","GPLCCR0",53,0)
|
||
. . I LINE?." "1";><".E D ; sub-section name found
|
||
"RTN","GPLCCR0",54,0)
|
||
. . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
|
||
"RTN","GPLCCR0",55,0)
|
||
. . I LINE?." "1";;".E D ; line found
|
||
"RTN","GPLCCR0",56,0)
|
||
. . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
|
||
"RTN","GPLCCR0",57,0)
|
||
Q
|
||
"RTN","GPLCCR0",58,0)
|
||
;
|
||
"RTN","GPLCCR0",59,0)
|
||
LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
|
||
"RTN","GPLCCR0",60,0)
|
||
D ZLOAD(ARY,"GPLCCR0")
|
||
"RTN","GPLCCR0",61,0)
|
||
; ZWR @ARY
|
||
"RTN","GPLCCR0",62,0)
|
||
Q
|
||
"RTN","GPLCCR0",63,0)
|
||
;
|
||
"RTN","GPLCCR0",64,0)
|
||
;<TEMPLATE>
|
||
"RTN","GPLCCR0",65,0)
|
||
;;<?xml version="1.0" encoding="UTF-8"?>
|
||
"RTN","GPLCCR0",66,0)
|
||
;;<?xml-stylesheet type="text/xsl" href="ccr.xsl"?>
|
||
"RTN","GPLCCR0",67,0)
|
||
;;<ContinuityOfCareRecord xmlns="urn:astm-org:CCR">
|
||
"RTN","GPLCCR0",68,0)
|
||
;;<CCRDocumentObjectID>871bd605-e8f8-4b80-9918-4b03f781129e</CCRDocumentObjectID>
|
||
"RTN","GPLCCR0",69,0)
|
||
;;<Language>
|
||
"RTN","GPLCCR0",70,0)
|
||
;;<Text>English</Text>
|
||
"RTN","GPLCCR0",71,0)
|
||
;;</Language>
|
||
"RTN","GPLCCR0",72,0)
|
||
;;<Version>V1.0</Version>
|
||
"RTN","GPLCCR0",73,0)
|
||
;;<DateTime>
|
||
"RTN","GPLCCR0",74,0)
|
||
;;<ExactDateTime>@@DATETIME@@</ExactDateTime>
|
||
"RTN","GPLCCR0",75,0)
|
||
;;</DateTime>
|
||
"RTN","GPLCCR0",76,0)
|
||
;;<Patient>
|
||
"RTN","GPLCCR0",77,0)
|
||
;;<ActorID>@@ACTORPATIENT@@</ActorID>
|
||
"RTN","GPLCCR0",78,0)
|
||
;;</Patient>
|
||
"RTN","GPLCCR0",79,0)
|
||
;;<From>
|
||
"RTN","GPLCCR0",80,0)
|
||
;;<ActorLink>
|
||
"RTN","GPLCCR0",81,0)
|
||
;;<ActorID>@@ACTORFROM@@</ActorID>
|
||
"RTN","GPLCCR0",82,0)
|
||
;;</ActorLink>
|
||
"RTN","GPLCCR0",83,0)
|
||
;;<ActorLink>
|
||
"RTN","GPLCCR0",84,0)
|
||
;;<ActorID>@@ACTORFROM2@@</ActorID>
|
||
"RTN","GPLCCR0",85,0)
|
||
;;</ActorLink>
|
||
"RTN","GPLCCR0",86,0)
|
||
;;</From>
|
||
"RTN","GPLCCR0",87,0)
|
||
;;<To>
|
||
"RTN","GPLCCR0",88,0)
|
||
;;<ActorLink>
|
||
"RTN","GPLCCR0",89,0)
|
||
;;<ActorID>@@ACTORTO@@</ActorID>
|
||
"RTN","GPLCCR0",90,0)
|
||
;;<ActorRole>
|
||
"RTN","GPLCCR0",91,0)
|
||
;;<Text>@@ACTORTOTEXT@@</Text>
|
||
"RTN","GPLCCR0",92,0)
|
||
;;</ActorRole>
|
||
"RTN","GPLCCR0",93,0)
|
||
;;</ActorLink>
|
||
"RTN","GPLCCR0",94,0)
|
||
;;</To>
|
||
"RTN","GPLCCR0",95,0)
|
||
;;<Purpose>
|
||
"RTN","GPLCCR0",96,0)
|
||
;;<Description>
|
||
"RTN","GPLCCR0",97,0)
|
||
;;<Text>@@PURPOSEDESCRIPTION@@</Text>
|
||
"RTN","GPLCCR0",98,0)
|
||
;;</Description>
|
||
"RTN","GPLCCR0",99,0)
|
||
;;</Purpose>
|
||
"RTN","GPLCCR0",100,0)
|
||
;;<Body>
|
||
"RTN","GPLCCR0",101,0)
|
||
;;<Problems>
|
||
"RTN","GPLCCR0",102,0)
|
||
;;<Problem>
|
||
"RTN","GPLCCR0",103,0)
|
||
;;<CCRDataObjectID>@@PROBLEMOBJECTID@@</CCRDataObjectID>
|
||
"RTN","GPLCCR0",104,0)
|
||
;;<Type>
|
||
"RTN","GPLCCR0",105,0)
|
||
;;<Text>Problem</Text>
|
||
"RTN","GPLCCR0",106,0)
|
||
;;</Type>
|
||
"RTN","GPLCCR0",107,0)
|
||
;;<Description>
|
||
"RTN","GPLCCR0",108,0)
|
||
;;<Text>@@PROBLEMDESCRIPTION@@</Text>
|
||
"RTN","GPLCCR0",109,0)
|
||
;;<Code>
|
||
"RTN","GPLCCR0",110,0)
|
||
;;<Value>@@PROBLEMCODEVALUE@@</Value>
|
||
"RTN","GPLCCR0",111,0)
|
||
;;<CodingSystem>ICD9CM</CodingSystem>
|
||
"RTN","GPLCCR0",112,0)
|
||
;;<Version>@@PROBLEMCODINGVERSION@@</Version>
|
||
"RTN","GPLCCR0",113,0)
|
||
;;</Code>
|
||
"RTN","GPLCCR0",114,0)
|
||
;;</Description>
|
||
"RTN","GPLCCR0",115,0)
|
||
;;<Source>
|
||
"RTN","GPLCCR0",116,0)
|
||
;;<Actor>
|
||
"RTN","GPLCCR0",117,0)
|
||
;;<ActorID>@@PROBLEMSOURCEACTORID@@</ActorID>
|
||
"RTN","GPLCCR0",118,0)
|
||
;;</Actor>
|
||
"RTN","GPLCCR0",119,0)
|
||
;;</Source>
|
||
"RTN","GPLCCR0",120,0)
|
||
;;</Problem>
|
||
"RTN","GPLCCR0",121,0)
|
||
;;</Problems>
|
||
"RTN","GPLCCR0",122,0)
|
||
;;<FamilyHistory>
|
||
"RTN","GPLCCR0",123,0)
|
||
;;<FamilyProblemHistory>
|
||
"RTN","GPLCCR0",124,0)
|
||
;;<CCRDataObjectID>@@FAMILYHISTORYOBJECTID@@</CCRDataObjectID>
|
||
"RTN","GPLCCR0",125,0)
|
||
;;<Source>
|
||
"RTN","GPLCCR0",126,0)
|
||
;;<Actor>
|
||
"RTN","GPLCCR0",127,0)
|
||
;;<ActorID>@@FAMILYHISTORYACTORID@@</ActorID>
|
||
"RTN","GPLCCR0",128,0)
|
||
;;</Actor>
|
||
"RTN","GPLCCR0",129,0)
|
||
;;</Source>
|
||
"RTN","GPLCCR0",130,0)
|
||
;;<FamilyMember>
|
||
"RTN","GPLCCR0",131,0)
|
||
;;<ActorID>@@FAMILYMEMBERACTORID@@</ActorID>
|
||
"RTN","GPLCCR0",132,0)
|
||
;;<ActorRole>
|
||
"RTN","GPLCCR0",133,0)
|
||
;;<Text>@@FAMILYMEMBERACTORROLETEXT@@</Text>
|
||
"RTN","GPLCCR0",134,0)
|
||
;;</ActorRole>
|
||
"RTN","GPLCCR0",135,0)
|
||
;;<Source>
|
||
"RTN","GPLCCR0",136,0)
|
||
;;<Actor>
|
||
"RTN","GPLCCR0",137,0)
|
||
;;<ActorID>@@FAMILYMEMBERSOURCACTORID@@</ActorID>
|
||
"RTN","GPLCCR0",138,0)
|
||
;;</Actor>
|
||
"RTN","GPLCCR0",139,0)
|
||
;;</Source>
|
||
"RTN","GPLCCR0",140,0)
|
||
;;</FamilyMember>
|
||
"RTN","GPLCCR0",141,0)
|
||
;;<Problem>
|
||
"RTN","GPLCCR0",142,0)
|
||
;;<Type>
|
||
"RTN","GPLCCR0",143,0)
|
||
;;<Text>Problem</Text>
|
||
"RTN","GPLCCR0",144,0)
|
||
;;</Type>
|
||
"RTN","GPLCCR0",145,0)
|
||
;;<Description>
|
||
"RTN","GPLCCR0",146,0)
|
||
;;<Text>@@FAMILYMEMBERPROBLEMDESCRIPTION@@</Text>
|
||
"RTN","GPLCCR0",147,0)
|
||
;;<Code>
|
||
"RTN","GPLCCR0",148,0)
|
||
;;<Value>@@FAMILYMEMBERPROBLEMCODE@@</Value>
|
||
"RTN","GPLCCR0",149,0)
|
||
;;<CodingSystem>@@FAMILYMEMBERCODESYSTEM@@</CodingSystem>
|
||
"RTN","GPLCCR0",150,0)
|
||
;;<Version>@@FAMILYMEMBERCODEVERSION@@</Version>
|
||
"RTN","GPLCCR0",151,0)
|
||
;;</Code>
|
||
"RTN","GPLCCR0",152,0)
|
||
;;</Description>
|
||
"RTN","GPLCCR0",153,0)
|
||
;;<Source>
|
||
"RTN","GPLCCR0",154,0)
|
||
;;<Actor>
|
||
"RTN","GPLCCR0",155,0)
|
||
;;<ActorID>@@FAMILYMEMBERPROBLEMSOURCEID@@</ActorID>
|
||
"RTN","GPLCCR0",156,0)
|
||
;;</Actor>
|
||
"RTN","GPLCCR0",157,0)
|
||
;;</Source>
|
||
"RTN","GPLCCR0",158,0)
|
||
;;</Problem>
|
||
"RTN","GPLCCR0",159,0)
|
||
;;</FamilyProblemHistory>
|
||
"RTN","GPLCCR0",160,0)
|
||
;;</FamilyHistory>
|
||
"RTN","GPLCCR0",161,0)
|
||
;;<SocialHistory>
|
||
"RTN","GPLCCR0",162,0)
|
||
;;<SocialHistoryElement>
|
||
"RTN","GPLCCR0",163,0)
|
||
;;<CCRDataObjectID>@@SOCIALHISTORYOBJECTID@@</CCRDataObjectID>
|
||
"RTN","GPLCCR0",164,0)
|
||
;;<Type>
|
||
"RTN","GPLCCR0",165,0)
|
||
;;<Text>@@SOCIALHISTORYTYPETEXT@@</Text>
|
||
"RTN","GPLCCR0",166,0)
|
||
;;</Type>
|
||
"RTN","GPLCCR0",167,0)
|
||
;;<Description>
|
||
"RTN","GPLCCR0",168,0)
|
||
;;<Text>@@SOCIALHISTORYDESCRIPTIONTEXT@@</Text>
|
||
"RTN","GPLCCR0",169,0)
|
||
;;</Description>
|
||
"RTN","GPLCCR0",170,0)
|
||
;;<Source>
|
||
"RTN","GPLCCR0",171,0)
|
||
;;<Actor>
|
||
"RTN","GPLCCR0",172,0)
|
||
;;<ActorID>@@SOCIALHISTORYSOURCACTORID@@</ActorID>
|
||
"RTN","GPLCCR0",173,0)
|
||
;;</Actor>
|
||
"RTN","GPLCCR0",174,0)
|
||
;;</Source>
|
||
"RTN","GPLCCR0",175,0)
|
||
;;</SocialHistoryElement>
|
||
"RTN","GPLCCR0",176,0)
|
||
;;<SocialHistoryElement>
|
||
"RTN","GPLCCR0",177,0)
|
||
;;<CCRDataObjectID>BB0005</CCRDataObjectID>
|
||
"RTN","GPLCCR0",178,0)
|
||
;;<Type>
|
||
"RTN","GPLCCR0",179,0)
|
||
;;<Text>Ethnic Origin</Text>
|
||
"RTN","GPLCCR0",180,0)
|
||
;;</Type>
|
||
"RTN","GPLCCR0",181,0)
|
||
;;<Description>
|
||
"RTN","GPLCCR0",182,0)
|
||
;;<Text>Not Hispanic or Latino</Text>
|
||
"RTN","GPLCCR0",183,0)
|
||
;;</Description>
|
||
"RTN","GPLCCR0",184,0)
|
||
;;<Source>
|
||
"RTN","GPLCCR0",185,0)
|
||
;;<Actor>
|
||
"RTN","GPLCCR0",186,0)
|
||
;;<ActorID>AA0001</ActorID>
|
||
"RTN","GPLCCR0",187,0)
|
||
;;</Actor>
|
||
"RTN","GPLCCR0",188,0)
|
||
;;</Source>
|
||
"RTN","GPLCCR0",189,0)
|
||
;;</SocialHistoryElement>
|
||
"RTN","GPLCCR0",190,0)
|
||
;;<SocialHistoryElement>
|
||
"RTN","GPLCCR0",191,0)
|
||
;;<CCRDataObjectID>BB0006</CCRDataObjectID>
|
||
"RTN","GPLCCR0",192,0)
|
||
;;<Type>
|
||
"RTN","GPLCCR0",193,0)
|
||
;;<Text>Race</Text>
|
||
"RTN","GPLCCR0",194,0)
|
||
;;</Type>
|
||
"RTN","GPLCCR0",195,0)
|
||
;;<Description>
|
||
"RTN","GPLCCR0",196,0)
|
||
;;<Text>White</Text>
|
||
"RTN","GPLCCR0",197,0)
|
||
;;</Description>
|
||
"RTN","GPLCCR0",198,0)
|
||
;;<Source>
|
||
"RTN","GPLCCR0",199,0)
|
||
;;<Actor>
|
||
"RTN","GPLCCR0",200,0)
|
||
;;<ActorID>AA0001</ActorID>
|
||
"RTN","GPLCCR0",201,0)
|
||
;;</Actor>
|
||
"RTN","GPLCCR0",202,0)
|
||
;;</Source>
|
||
"RTN","GPLCCR0",203,0)
|
||
;;</SocialHistoryElement>
|
||
"RTN","GPLCCR0",204,0)
|
||
;;<SocialHistoryElement>
|
||
"RTN","GPLCCR0",205,0)
|
||
;;<CCRDataObjectID>BB0007</CCRDataObjectID>
|
||
"RTN","GPLCCR0",206,0)
|
||
;;<Type>
|
||
"RTN","GPLCCR0",207,0)
|
||
;;<Text>Occupation</Text>
|
||
"RTN","GPLCCR0",208,0)
|
||
;;</Type>
|
||
"RTN","GPLCCR0",209,0)
|
||
;;<Description>
|
||
"RTN","GPLCCR0",210,0)
|
||
;;<Text>Physician</Text>
|
||
"RTN","GPLCCR0",211,0)
|
||
;;</Description>
|
||
"RTN","GPLCCR0",212,0)
|
||
;;<Source>
|
||
"RTN","GPLCCR0",213,0)
|
||
;;<Actor>
|
||
"RTN","GPLCCR0",214,0)
|
||
;;<ActorID>AA0001</ActorID>
|
||
"RTN","GPLCCR0",215,0)
|
||
;;</Actor>
|
||
"RTN","GPLCCR0",216,0)
|
||
;;</Source>
|
||
"RTN","GPLCCR0",217,0)
|
||
;;</SocialHistoryElement>
|
||
"RTN","GPLCCR0",218,0)
|
||
;;</SocialHistory>
|
||
"RTN","GPLCCR0",219,0)
|
||
;;<Alerts>
|
||
"RTN","GPLCCR0",220,0)
|
||
;;<Alert>
|
||
"RTN","GPLCCR0",221,0)
|
||
;;<CCRDataObjectID>@@ALERTOBJECTID@@</CCRDataObjectID>
|
||
"RTN","GPLCCR0",222,0)
|
||
;;<Description>
|
||
"RTN","GPLCCR0",223,0)
|
||
;;<Text>@@ALERTDESCRIPTIONTEXT@@</Text>
|
||
"RTN","GPLCCR0",224,0)
|
||
;;<Code>
|
||
"RTN","GPLCCR0",225,0)
|
||
;;<Value>@@ALERTCODEVALUE@@</Value>
|
||
"RTN","GPLCCR0",226,0)
|
||
;;<CodingSystem>@@ALERTCODESYSTEM@@</CodingSystem>
|
||
"RTN","GPLCCR0",227,0)
|
||
;;</Code>
|
||
"RTN","GPLCCR0",228,0)
|
||
;;</Description>
|
||
"RTN","GPLCCR0",229,0)
|
||
;;<Status>
|
||
"RTN","GPLCCR0",230,0)
|
||
;;<Text>@@ALERTSTATUSTEXT@@</Text>
|
||
"RTN","GPLCCR0",231,0)
|
||
;;</Status>
|
||
"RTN","GPLCCR0",232,0)
|
||
;;<Source>
|
||
"RTN","GPLCCR0",233,0)
|
||
;;<Actor>
|
||
"RTN","GPLCCR0",234,0)
|
||
;;<ActorID>@@ALERTSOURCEID@@</ActorID>
|
||
"RTN","GPLCCR0",235,0)
|
||
;;</Actor>
|
||
"RTN","GPLCCR0",236,0)
|
||
;;</Source>
|
||
"RTN","GPLCCR0",237,0)
|
||
;;<Agent>
|
||
"RTN","GPLCCR0",238,0)
|
||
;;<Products>
|
||
"RTN","GPLCCR0",239,0)
|
||
;;<Product>
|
||
"RTN","GPLCCR0",240,0)
|
||
;;<CCRDataObjectID>@@ALERTAGENTPRODUCTOBJECTID@@</CCRDataObjectID>
|
||
"RTN","GPLCCR0",241,0)
|
||
;;<Source>
|
||
"RTN","GPLCCR0",242,0)
|
||
;;<Actor>
|
||
"RTN","GPLCCR0",243,0)
|
||
;;<ActorID>@@ALERTAGENTPRODUCTSOURCEID@@</ActorID>
|
||
"RTN","GPLCCR0",244,0)
|
||
;;</Actor>
|
||
"RTN","GPLCCR0",245,0)
|
||
;;</Source>
|
||
"RTN","GPLCCR0",246,0)
|
||
;;<ProductName>
|
||
"RTN","GPLCCR0",247,0)
|
||
;;<Text>@@ALERTAGENTPRODUCTNAMETEXT@@</Text>
|
||
"RTN","GPLCCR0",248,0)
|
||
;;<Code>
|
||
"RTN","GPLCCR0",249,0)
|
||
;;<Value>@@ALERTAGENTPRODUCTCODEVALUE@@</Value>
|
||
"RTN","GPLCCR0",250,0)
|
||
;;<CodingSystem>@@ALERTAGENTPRODUCTCODESYSTEM@@</CodingSystem>
|
||
"RTN","GPLCCR0",251,0)
|
||
;;</Code>
|
||
"RTN","GPLCCR0",252,0)
|
||
;;</ProductName>
|
||
"RTN","GPLCCR0",253,0)
|
||
;;</Product>
|
||
"RTN","GPLCCR0",254,0)
|
||
;;</Products>
|
||
"RTN","GPLCCR0",255,0)
|
||
;;</Agent>
|
||
"RTN","GPLCCR0",256,0)
|
||
;;<Reaction>
|
||
"RTN","GPLCCR0",257,0)
|
||
;;<Description>
|
||
"RTN","GPLCCR0",258,0)
|
||
;;<Text>@@ALERTREACTIOINDESCRIPTIONTEXT@@</Text>
|
||
"RTN","GPLCCR0",259,0)
|
||
;;<Code>
|
||
"RTN","GPLCCR0",260,0)
|
||
;;<Value>@@ALERTREACTIONCODEVALUE@@</Value>
|
||
"RTN","GPLCCR0",261,0)
|
||
;;<CodingSystem>@@ALERTREACTIONCODESYSTEM@@</CodingSystem>
|
||
"RTN","GPLCCR0",262,0)
|
||
;;</Code>
|
||
"RTN","GPLCCR0",263,0)
|
||
;;</Description>
|
||
"RTN","GPLCCR0",264,0)
|
||
;;</Reaction>
|
||
"RTN","GPLCCR0",265,0)
|
||
;;</Alert>
|
||
"RTN","GPLCCR0",266,0)
|
||
;;</Alerts>
|
||
"RTN","GPLCCR0",267,0)
|
||
;;<Medications>
|
||
"RTN","GPLCCR0",268,0)
|
||
;;<Medication>
|
||
"RTN","GPLCCR0",269,0)
|
||
;;<CCRDataObjectID>@@MEDOBJECTID@@</CCRDataObjectID>
|
||
"RTN","GPLCCR0",270,0)
|
||
;;<DateTime>
|
||
"RTN","GPLCCR0",271,0)
|
||
;;<Type>
|
||
"RTN","GPLCCR0",272,0)
|
||
;;<Text>@@MEDISSUEDATETXT@@</Text>
|
||
"RTN","GPLCCR0",273,0)
|
||
;;</Type>
|
||
"RTN","GPLCCR0",274,0)
|
||
;;<ExactDateTime>@@MEDISSUEDATE@@</ExactDateTime>
|
||
"RTN","GPLCCR0",275,0)
|
||
;;<Type>
|
||
"RTN","GPLCCR0",276,0)
|
||
;;<Text>@@MEDLASTFILLDATETXT@@</Text>
|
||
"RTN","GPLCCR0",277,0)
|
||
;;</Type>
|
||
"RTN","GPLCCR0",278,0)
|
||
;;<ExactDateTime>@@MEDLASTFILLDATE@@</ExactDateTime>
|
||
"RTN","GPLCCR0",279,0)
|
||
;;</DateTime>
|
||
"RTN","GPLCCR0",280,0)
|
||
;;<IDs>
|
||
"RTN","GPLCCR0",281,0)
|
||
;;<Type>
|
||
"RTN","GPLCCR0",282,0)
|
||
;;<Text>@@MEDRXNOTXT@@</Text>
|
||
"RTN","GPLCCR0",283,0)
|
||
;;</Type>
|
||
"RTN","GPLCCR0",284,0)
|
||
;;<ID>@@MEDRXNO@@</ID>
|
||
"RTN","GPLCCR0",285,0)
|
||
;;</IDs>
|
||
"RTN","GPLCCR0",286,0)
|
||
;;<Type>
|
||
"RTN","GPLCCR0",287,0)
|
||
;;<Text>@@MEDTYPETEXT@@</Text>
|
||
"RTN","GPLCCR0",288,0)
|
||
;;</Type>
|
||
"RTN","GPLCCR0",289,0)
|
||
;;<Description>
|
||
"RTN","GPLCCR0",290,0)
|
||
;;<Text>@@MEDDETAILUNADORNED@@</Text>
|
||
"RTN","GPLCCR0",291,0)
|
||
;;</Description>
|
||
"RTN","GPLCCR0",292,0)
|
||
;;<Status>
|
||
"RTN","GPLCCR0",293,0)
|
||
;;<Text>@@MEDSTATUSTEXT@@</Text>
|
||
"RTN","GPLCCR0",294,0)
|
||
;;</Status>
|
||
"RTN","GPLCCR0",295,0)
|
||
;;<Source>
|
||
"RTN","GPLCCR0",296,0)
|
||
;;<Actor>
|
||
"RTN","GPLCCR0",297,0)
|
||
;;<ActorID>@@MEDSOURCEACTORID@@</ActorID>
|
||
"RTN","GPLCCR0",298,0)
|
||
;;</Actor>
|
||
"RTN","GPLCCR0",299,0)
|
||
;;</Source>
|
||
"RTN","GPLCCR0",300,0)
|
||
;;<Product>
|
||
"RTN","GPLCCR0",301,0)
|
||
;;<ProductName>
|
||
"RTN","GPLCCR0",302,0)
|
||
;;<Text>@@MEDPRODUCTNAMETEXT@@</Text>
|
||
"RTN","GPLCCR0",303,0)
|
||
;;<Code>
|
||
"RTN","GPLCCR0",304,0)
|
||
;;<Value>@@MEDPRODUCTNAMECODEVALUE@@</Value>
|
||
"RTN","GPLCCR0",305,0)
|
||
;;<CodingSystem>@@MEDPRODUCTNAMECODINGINGSYSTEM@@</CodingSystem>
|
||
"RTN","GPLCCR0",306,0)
|
||
;;<Version>@@MEDPRODUCTNAMECODEVERSION@@</Version>
|
||
"RTN","GPLCCR0",307,0)
|
||
;;</Code>
|
||
"RTN","GPLCCR0",308,0)
|
||
;;</ProductName>
|
||
"RTN","GPLCCR0",309,0)
|
||
;;<BrandName>
|
||
"RTN","GPLCCR0",310,0)
|
||
;;<Text>@@MEDBRANDNAMETEXT@@</Text>
|
||
"RTN","GPLCCR0",311,0)
|
||
;;</BrandName>
|
||
"RTN","GPLCCR0",312,0)
|
||
;;<Strength>
|
||
"RTN","GPLCCR0",313,0)
|
||
;;<Value>@@MEDSTRENGTHVALUE@@</Value>
|
||
"RTN","GPLCCR0",314,0)
|
||
;;<Units>
|
||
"RTN","GPLCCR0",315,0)
|
||
;;<Unit>@@MEDSTRENGTHUNIT@@</Unit>
|
||
"RTN","GPLCCR0",316,0)
|
||
;;</Units>
|
||
"RTN","GPLCCR0",317,0)
|
||
;;</Strength>
|
||
"RTN","GPLCCR0",318,0)
|
||
;;<Form>
|
||
"RTN","GPLCCR0",319,0)
|
||
;;<Text>@@MEDFORMTEXT@@</Text>
|
||
"RTN","GPLCCR0",320,0)
|
||
;;</Form>
|
||
"RTN","GPLCCR0",321,0)
|
||
;;<Concentration>
|
||
"RTN","GPLCCR0",322,0)
|
||
;;<Value>@@MEDCONCVALUE@@</Value>
|
||
"RTN","GPLCCR0",323,0)
|
||
;;<Units>
|
||
"RTN","GPLCCR0",324,0)
|
||
;;<Unit>@@MEDCONCUNIT@@</Unit>
|
||
"RTN","GPLCCR0",325,0)
|
||
;;</Units>
|
||
"RTN","GPLCCR0",326,0)
|
||
;;</Concentration>
|
||
"RTN","GPLCCR0",327,0)
|
||
;;<Size>
|
||
"RTN","GPLCCR0",328,0)
|
||
;;<Text>@@MEDSIZETEXT@@</Text>
|
||
"RTN","GPLCCR0",329,0)
|
||
;;</Size>
|
||
"RTN","GPLCCR0",330,0)
|
||
;;</Product>
|
||
"RTN","GPLCCR0",331,0)
|
||
;;<Quantity>
|
||
"RTN","GPLCCR0",332,0)
|
||
;;<Value>@@MEDQUANTITYVALUE@@</Value>
|
||
"RTN","GPLCCR0",333,0)
|
||
;;<Units>
|
||
"RTN","GPLCCR0",334,0)
|
||
;;<Unit>@@MEDQUANTITYUNIT@@</Unit>
|
||
"RTN","GPLCCR0",335,0)
|
||
;;</Units>
|
||
"RTN","GPLCCR0",336,0)
|
||
;;</Quantity>
|
||
"RTN","GPLCCR0",337,0)
|
||
;;<Directions>
|
||
"RTN","GPLCCR0",338,0)
|
||
;;<Direction>
|
||
"RTN","GPLCCR0",339,0)
|
||
;;<Description>
|
||
"RTN","GPLCCR0",340,0)
|
||
;;<Text>@@MEDDIRECTIONDESCRIPTIONTEXT@@</Text>
|
||
"RTN","GPLCCR0",341,0)
|
||
;;</Description>
|
||
"RTN","GPLCCR0",342,0)
|
||
;;<DoseIndicator>
|
||
"RTN","GPLCCR0",343,0)
|
||
;;<Text>@@MEDDOSEINDICATOR@@</Text>
|
||
"RTN","GPLCCR0",344,0)
|
||
;;</DoseIndicator>
|
||
"RTN","GPLCCR0",345,0)
|
||
;;<DeliveryMethod>
|
||
"RTN","GPLCCR0",346,0)
|
||
;;<Text>@@MEDDELIVERYMETHOD@@</Text>
|
||
"RTN","GPLCCR0",347,0)
|
||
;;</DeliveryMethod>
|
||
"RTN","GPLCCR0",348,0)
|
||
;;<Dose>
|
||
"RTN","GPLCCR0",349,0)
|
||
;;<Value>@@MEDDOSEVALUE@@</Value>
|
||
"RTN","GPLCCR0",350,0)
|
||
;;<Units>
|
||
"RTN","GPLCCR0",351,0)
|
||
;;<Unit>@@MEDDOSEUNIT@@</Unit>
|
||
"RTN","GPLCCR0",352,0)
|
||
;;</Units>
|
||
"RTN","GPLCCR0",353,0)
|
||
;;<Rate>
|
||
"RTN","GPLCCR0",354,0)
|
||
;;<Value>@@MEDRATEVALUE@@</Value>
|
||
"RTN","GPLCCR0",355,0)
|
||
;;<Units>
|
||
"RTN","GPLCCR0",356,0)
|
||
;;<Unit>@@MEDRATEUNIT@@</Unit>
|
||
"RTN","GPLCCR0",357,0)
|
||
;;</Units>
|
||
"RTN","GPLCCR0",358,0)
|
||
;;</Rate>
|
||
"RTN","GPLCCR0",359,0)
|
||
;;</Dose>
|
||
"RTN","GPLCCR0",360,0)
|
||
;;<Vehicle>
|
||
"RTN","GPLCCR0",361,0)
|
||
;;<Text>@@MEDVEHICLETEXT@@</Text>
|
||
"RTN","GPLCCR0",362,0)
|
||
;;</Vehicle>
|
||
"RTN","GPLCCR0",363,0)
|
||
;;<Route>
|
||
"RTN","GPLCCR0",364,0)
|
||
;;<Text>@@MEDDIRECTIONROUTETEXT@@</Text>
|
||
"RTN","GPLCCR0",365,0)
|
||
;;</Route>
|
||
"RTN","GPLCCR0",366,0)
|
||
;;<Frequency>
|
||
"RTN","GPLCCR0",367,0)
|
||
;;<Value>@@MEDFREQUENCYVALUE@@</Value>
|
||
"RTN","GPLCCR0",368,0)
|
||
;;</Frequency>
|
||
"RTN","GPLCCR0",369,0)
|
||
;;<Interval>
|
||
"RTN","GPLCCR0",370,0)
|
||
;;<Value>@@MEDINTERVALVALUE@@</Value>
|
||
"RTN","GPLCCR0",371,0)
|
||
;;<Units>
|
||
"RTN","GPLCCR0",372,0)
|
||
;;<Unit>@@MEDINTERVALUNIT@@</Unit>
|
||
"RTN","GPLCCR0",373,0)
|
||
;;</Units>
|
||
"RTN","GPLCCR0",374,0)
|
||
;;</Interval>
|
||
"RTN","GPLCCR0",375,0)
|
||
;;<Duration>
|
||
"RTN","GPLCCR0",376,0)
|
||
;;<Value>@@MEDDURATIONVALUE@@</Value>
|
||
"RTN","GPLCCR0",377,0)
|
||
;;<Units>
|
||
"RTN","GPLCCR0",378,0)
|
||
;;<Unit>@@MEDDURATIONUNIT@@</Unit>
|
||
"RTN","GPLCCR0",379,0)
|
||
;;</Units>
|
||
"RTN","GPLCCR0",380,0)
|
||
;;</Duration>
|
||
"RTN","GPLCCR0",381,0)
|
||
;;<Indication>
|
||
"RTN","GPLCCR0",382,0)
|
||
;;<PRNFlag>
|
||
"RTN","GPLCCR0",383,0)
|
||
;;<Text>@@MEDPRNFLAG@@</Text>
|
||
"RTN","GPLCCR0",384,0)
|
||
;;</PRNFlag>
|
||
"RTN","GPLCCR0",385,0)
|
||
;;<Problem>
|
||
"RTN","GPLCCR0",386,0)
|
||
;;<CCRDataObjectID>@@MEDPROBLEMOBJECTID@@</CCRDataObjectID>
|
||
"RTN","GPLCCR0",387,0)
|
||
;;<Type>
|
||
"RTN","GPLCCR0",388,0)
|
||
;;<Text>@@MEDPROBLEMTYPETXT@@</Text>
|
||
"RTN","GPLCCR0",389,0)
|
||
;;</Type>
|
||
"RTN","GPLCCR0",390,0)
|
||
;;<Description>
|
||
"RTN","GPLCCR0",391,0)
|
||
;;<Text>@@MEDPROBLEMDESCRIPTION@@</Text>
|
||
"RTN","GPLCCR0",392,0)
|
||
;;<Code>
|
||
"RTN","GPLCCR0",393,0)
|
||
;;<Value>@@MEDPROBLEMCODEVALUE@@</Value>
|
||
"RTN","GPLCCR0",394,0)
|
||
;;<CodingSystem>@@MEDPROBLEMCODINGSYSTEM@@</CodingSystem>
|
||
"RTN","GPLCCR0",395,0)
|
||
;;<Version>@@MEDPROBLEMCODINGVERSION@@</Version>
|
||
"RTN","GPLCCR0",396,0)
|
||
;;</Code>
|
||
"RTN","GPLCCR0",397,0)
|
||
;;</Description>
|
||
"RTN","GPLCCR0",398,0)
|
||
;;<Source>
|
||
"RTN","GPLCCR0",399,0)
|
||
;;<Actor>
|
||
"RTN","GPLCCR0",400,0)
|
||
;;<ActorID>@@MEDPROBLEMSOURCEACTORID@@</ActorID>
|
||
"RTN","GPLCCR0",401,0)
|
||
;;</Actor>
|
||
"RTN","GPLCCR0",402,0)
|
||
;;</Source>
|
||
"RTN","GPLCCR0",403,0)
|
||
;;</Problem>
|
||
"RTN","GPLCCR0",404,0)
|
||
;;</Indication>
|
||
"RTN","GPLCCR0",405,0)
|
||
;;<StopIndicator>
|
||
"RTN","GPLCCR0",406,0)
|
||
;;<Text>@@MEDSTOPINDICATOR@@</Text>
|
||
"RTN","GPLCCR0",407,0)
|
||
;;</StopIndicator>
|
||
"RTN","GPLCCR0",408,0)
|
||
;;<DirectionSequenceModifier>@@MEDDIRSEQ@@</DirectionSequenceModifier>
|
||
"RTN","GPLCCR0",409,0)
|
||
;;<MultipleDirectionModifier>
|
||
"RTN","GPLCCR0",410,0)
|
||
;;<Text>@@MEDMULDIRMOD@@</Text>
|
||
"RTN","GPLCCR0",411,0)
|
||
;;</MultipleDirectionModifier>
|
||
"RTN","GPLCCR0",412,0)
|
||
;;</Direction>
|
||
"RTN","GPLCCR0",413,0)
|
||
;;</Directions>
|
||
"RTN","GPLCCR0",414,0)
|
||
;;<PatientInstructions>
|
||
"RTN","GPLCCR0",415,0)
|
||
;;<Instruction>@@MEDPTINSTRUCTIONS@@</Instruction>
|
||
"RTN","GPLCCR0",416,0)
|
||
;;</PatientInstructions>
|
||
"RTN","GPLCCR0",417,0)
|
||
;;<FullfillmentInstructions>
|
||
"RTN","GPLCCR0",418,0)
|
||
;;<Text>@@MEDFULLFILLMENTINSTRUCTIONS@@</Text>
|
||
"RTN","GPLCCR0",419,0)
|
||
;;</FullfillmentInstructions>
|
||
"RTN","GPLCCR0",420,0)
|
||
;;<Refills>
|
||
"RTN","GPLCCR0",421,0)
|
||
;;<Refill>
|
||
"RTN","GPLCCR0",422,0)
|
||
;;<Number>@@MEDRFNO@@</Number>
|
||
"RTN","GPLCCR0",423,0)
|
||
;;</Refill>
|
||
"RTN","GPLCCR0",424,0)
|
||
;;</Refills>
|
||
"RTN","GPLCCR0",425,0)
|
||
;;</Medication>
|
||
"RTN","GPLCCR0",426,0)
|
||
;;</Medications>
|
||
"RTN","GPLCCR0",427,0)
|
||
;;<VitalSigns>
|
||
"RTN","GPLCCR0",428,0)
|
||
;;<Result>
|
||
"RTN","GPLCCR0",429,0)
|
||
;;<CCRDataObjectID>@@VITALSIGNSDATAOBJECTID@@</CCRDataObjectID>
|
||
"RTN","GPLCCR0",430,0)
|
||
;;<DateTime>
|
||
"RTN","GPLCCR0",431,0)
|
||
;;<Type>
|
||
"RTN","GPLCCR0",432,0)
|
||
;;<Text>@@VITALSIGNSDATETIMETYPETEXT@@</Text>
|
||
"RTN","GPLCCR0",433,0)
|
||
;;</Type>
|
||
"RTN","GPLCCR0",434,0)
|
||
;;<ExactDateTime>@@VITALSIGNSEXACTDATETIME@@</ExactDateTime>
|
||
"RTN","GPLCCR0",435,0)
|
||
;;</DateTime>
|
||
"RTN","GPLCCR0",436,0)
|
||
;;<Description>
|
||
"RTN","GPLCCR0",437,0)
|
||
;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
|
||
"RTN","GPLCCR0",438,0)
|
||
;;</Description>
|
||
"RTN","GPLCCR0",439,0)
|
||
;;<Source>
|
||
"RTN","GPLCCR0",440,0)
|
||
;;<Actor>
|
||
"RTN","GPLCCR0",441,0)
|
||
;;<ActorID>@@VITALSIGNSSOURCEACTORID@@</ActorID>
|
||
"RTN","GPLCCR0",442,0)
|
||
;;</Actor>
|
||
"RTN","GPLCCR0",443,0)
|
||
;;</Source>
|
||
"RTN","GPLCCR0",444,0)
|
||
;;<Test>
|
||
"RTN","GPLCCR0",445,0)
|
||
;;<CCRDataObjectID>@@VITALSIGNSTESTOBJECTID@@</CCRDataObjectID>
|
||
"RTN","GPLCCR0",446,0)
|
||
;;<Type>
|
||
"RTN","GPLCCR0",447,0)
|
||
;;<Text>@@VITALSIGNSTESTTYPETEXT@@</Text>
|
||
"RTN","GPLCCR0",448,0)
|
||
;;</Type>
|
||
"RTN","GPLCCR0",449,0)
|
||
;;<Description>
|
||
"RTN","GPLCCR0",450,0)
|
||
;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
|
||
"RTN","GPLCCR0",451,0)
|
||
;;<Code>
|
||
"RTN","GPLCCR0",452,0)
|
||
;;<Value>@@VITALSIGNSDESCRIPTIONCODEVALUE@@</Value>
|
||
"RTN","GPLCCR0",453,0)
|
||
;;<CodingSystem>@@VITALSIGNSDESCRIPTIONCODINGSYSTEM@@</CodingSystem>
|
||
"RTN","GPLCCR0",454,0)
|
||
;;<Version>@@VITALSIGNSCODEVERSION@@</Version>
|
||
"RTN","GPLCCR0",455,0)
|
||
;;</Code>
|
||
"RTN","GPLCCR0",456,0)
|
||
;;</Description>
|
||
"RTN","GPLCCR0",457,0)
|
||
;;<Source>
|
||
"RTN","GPLCCR0",458,0)
|
||
;;<Actor>
|
||
"RTN","GPLCCR0",459,0)
|
||
;;<ActorID>@@VITALSIGNSTESTSOURCEACTORID@@</ActorID>
|
||
"RTN","GPLCCR0",460,0)
|
||
;;</Actor>
|
||
"RTN","GPLCCR0",461,0)
|
||
;;</Source>
|
||
"RTN","GPLCCR0",462,0)
|
||
;;<TestResult>
|
||
"RTN","GPLCCR0",463,0)
|
||
;;<Value>@@VITALSIGNSTESTRESULTVALUE@@</Value>
|
||
"RTN","GPLCCR0",464,0)
|
||
;;<Units>
|
||
"RTN","GPLCCR0",465,0)
|
||
;;<Unit>@@VITALSIGNSTESTRESULTUNIT@@</Unit>
|
||
"RTN","GPLCCR0",466,0)
|
||
;;</Units>
|
||
"RTN","GPLCCR0",467,0)
|
||
;;</TestResult>
|
||
"RTN","GPLCCR0",468,0)
|
||
;;</Test>
|
||
"RTN","GPLCCR0",469,0)
|
||
;;</Result>
|
||
"RTN","GPLCCR0",470,0)
|
||
;;</VitalSigns>
|
||
"RTN","GPLCCR0",471,0)
|
||
;;<Results>
|
||
"RTN","GPLCCR0",472,0)
|
||
;;<Result>
|
||
"RTN","GPLCCR0",473,0)
|
||
;;<CCRDataObjectID>@@RESULTOBJECTID@@</CCRDataObjectID>
|
||
"RTN","GPLCCR0",474,0)
|
||
;;<DateTime>
|
||
"RTN","GPLCCR0",475,0)
|
||
;;<Type>
|
||
"RTN","GPLCCR0",476,0)
|
||
;;<Text>Assessment Time</Text>
|
||
"RTN","GPLCCR0",477,0)
|
||
;;</Type>
|
||
"RTN","GPLCCR0",478,0)
|
||
;;<ExactDateTime>@@RESULTASSESSMENTDATETIME@@</ExactDateTime>
|
||
"RTN","GPLCCR0",479,0)
|
||
;;</DateTime>
|
||
"RTN","GPLCCR0",480,0)
|
||
;;<Description>
|
||
"RTN","GPLCCR0",481,0)
|
||
;;<Text>@@RESULTDESCRIPTIONTEXT@@</Text>
|
||
"RTN","GPLCCR0",482,0)
|
||
;;<Code>
|
||
"RTN","GPLCCR0",483,0)
|
||
;;<Value>@@RESULTCODE@@</Value>
|
||
"RTN","GPLCCR0",484,0)
|
||
;;<CodingSystem>@@RESULTCODINGSYSTEM@@</CodingSystem>
|
||
"RTN","GPLCCR0",485,0)
|
||
;;</Code>
|
||
"RTN","GPLCCR0",486,0)
|
||
;;</Description>
|
||
"RTN","GPLCCR0",487,0)
|
||
;;<Status>
|
||
"RTN","GPLCCR0",488,0)
|
||
;;<Text>@@RESULTSTATUS@@</Text>
|
||
"RTN","GPLCCR0",489,0)
|
||
;;</Status>
|
||
"RTN","GPLCCR0",490,0)
|
||
;;<Source>
|
||
"RTN","GPLCCR0",491,0)
|
||
;;<Actor>
|
||
"RTN","GPLCCR0",492,0)
|
||
;;<ActorID>@@RESULTSOURCEACTORID@@</ActorID>
|
||
"RTN","GPLCCR0",493,0)
|
||
;;</Actor>
|
||
"RTN","GPLCCR0",494,0)
|
||
;;</Source>
|
||
"RTN","GPLCCR0",495,0)
|
||
;;<Test>
|
||
"RTN","GPLCCR0",496,0)
|
||
;;<CCRDataObjectID>@@RESULTTESTOBJECTID@@</CCRDataObjectID>
|
||
"RTN","GPLCCR0",497,0)
|
||
;;<DateTime>
|
||
"RTN","GPLCCR0",498,0)
|
||
;;<Type>
|
||
"RTN","GPLCCR0",499,0)
|
||
;;<Text>Assessment Time</Text>
|
||
"RTN","GPLCCR0",500,0)
|
||
;;</Type>
|
||
"RTN","GPLCCR0",501,0)
|
||
;;<ExactDateTime>@@RESULTTESTDATETIME@@</ExactDateTime>
|
||
"RTN","GPLCCR0",502,0)
|
||
;;</DateTime>
|
||
"RTN","GPLCCR0",503,0)
|
||
;;<Description>
|
||
"RTN","GPLCCR0",504,0)
|
||
;;<Text>@@RESULTTESTDESCRIPTIONTEXT@@</Text>
|
||
"RTN","GPLCCR0",505,0)
|
||
;;<Code>
|
||
"RTN","GPLCCR0",506,0)
|
||
;;<Value>@@RESULTTESTCODEVALUE@@</Value>
|
||
"RTN","GPLCCR0",507,0)
|
||
;;<CodingSystem>@@RESULTTESTCODINGSYSTEM@@</CodingSystem>
|
||
"RTN","GPLCCR0",508,0)
|
||
;;</Code>
|
||
"RTN","GPLCCR0",509,0)
|
||
;;</Description>
|
||
"RTN","GPLCCR0",510,0)
|
||
;;<Status>
|
||
"RTN","GPLCCR0",511,0)
|
||
;;<Text>@@RESULTTESTSTATUSTEXT@@</Text>
|
||
"RTN","GPLCCR0",512,0)
|
||
;;</Status>
|
||
"RTN","GPLCCR0",513,0)
|
||
;;<Source>
|
||
"RTN","GPLCCR0",514,0)
|
||
;;<Actor>
|
||
"RTN","GPLCCR0",515,0)
|
||
;;<ActorID>@@RESULTTESTSOURCEACTORID@@</ActorID>
|
||
"RTN","GPLCCR0",516,0)
|
||
;;</Actor>
|
||
"RTN","GPLCCR0",517,0)
|
||
;;</Source>
|
||
"RTN","GPLCCR0",518,0)
|
||
;;<TestResult>
|
||
"RTN","GPLCCR0",519,0)
|
||
;;<Value>@@RESULTTESTVALUE@@</Value>
|
||
"RTN","GPLCCR0",520,0)
|
||
;;<Units>
|
||
"RTN","GPLCCR0",521,0)
|
||
;;<Unit>@@RESULTTESTUNITS@@</Unit>
|
||
"RTN","GPLCCR0",522,0)
|
||
;;</Units>
|
||
"RTN","GPLCCR0",523,0)
|
||
;;</TestResult>
|
||
"RTN","GPLCCR0",524,0)
|
||
;;<NormalResult>
|
||
"RTN","GPLCCR0",525,0)
|
||
;;<Normal>
|
||
"RTN","GPLCCR0",526,0)
|
||
;;<Description>
|
||
"RTN","GPLCCR0",527,0)
|
||
;;<Text>@@RESULTTESTNORMALDESCRIPTIONTEXT@@</Text>
|
||
"RTN","GPLCCR0",528,0)
|
||
;;</Description>
|
||
"RTN","GPLCCR0",529,0)
|
||
;;<Source>
|
||
"RTN","GPLCCR0",530,0)
|
||
;;<Actor>
|
||
"RTN","GPLCCR0",531,0)
|
||
;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
|
||
"RTN","GPLCCR0",532,0)
|
||
;;</Actor>
|
||
"RTN","GPLCCR0",533,0)
|
||
;;</Source>
|
||
"RTN","GPLCCR0",534,0)
|
||
;;</Normal>
|
||
"RTN","GPLCCR0",535,0)
|
||
;;</NormalResult>
|
||
"RTN","GPLCCR0",536,0)
|
||
;;<Flag>
|
||
"RTN","GPLCCR0",537,0)
|
||
;;<Text>@@RESULTTESTFLAG@@</Text>
|
||
"RTN","GPLCCR0",538,0)
|
||
;;</Flag>
|
||
"RTN","GPLCCR0",539,0)
|
||
;;</Test>
|
||
"RTN","GPLCCR0",540,0)
|
||
;;</Result>
|
||
"RTN","GPLCCR0",541,0)
|
||
;;</Results>
|
||
"RTN","GPLCCR0",542,0)
|
||
;;<HealthCareProviders>
|
||
"RTN","GPLCCR0",543,0)
|
||
;;<Provider>
|
||
"RTN","GPLCCR0",544,0)
|
||
;;<ActorID>AA0005</ActorID>
|
||
"RTN","GPLCCR0",545,0)
|
||
;;<ActorRole>
|
||
"RTN","GPLCCR0",546,0)
|
||
;;<Text>Primary Provider</Text>
|
||
"RTN","GPLCCR0",547,0)
|
||
;;</ActorRole>
|
||
"RTN","GPLCCR0",548,0)
|
||
;;</Provider>
|
||
"RTN","GPLCCR0",549,0)
|
||
;;</HealthCareProviders>
|
||
"RTN","GPLCCR0",550,0)
|
||
;;</Body>
|
||
"RTN","GPLCCR0",551,0)
|
||
;;<Actors>
|
||
"RTN","GPLCCR0",552,0)
|
||
;;<ACTOR-PATIENT>
|
||
"RTN","GPLCCR0",553,0)
|
||
;;<Actor>
|
||
"RTN","GPLCCR0",554,0)
|
||
;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
|
||
"RTN","GPLCCR0",555,0)
|
||
;;<Person>
|
||
"RTN","GPLCCR0",556,0)
|
||
;;<Name>
|
||
"RTN","GPLCCR0",557,0)
|
||
;;<CurrentName>
|
||
"RTN","GPLCCR0",558,0)
|
||
;;<Given>@@ACTORGIVENNAME@@</Given>
|
||
"RTN","GPLCCR0",559,0)
|
||
;;<Middle>@@ACTORMIDDLENAME@@</Middle>
|
||
"RTN","GPLCCR0",560,0)
|
||
;;<Family>@@ACTORFAMILYNAME@@</Family>
|
||
"RTN","GPLCCR0",561,0)
|
||
;;</CurrentName>
|
||
"RTN","GPLCCR0",562,0)
|
||
;;</Name>
|
||
"RTN","GPLCCR0",563,0)
|
||
;;<DateOfBirth>
|
||
"RTN","GPLCCR0",564,0)
|
||
;;<ExactDateTime>@@ACTORDATEOFBIRTH@@</ExactDateTime>
|
||
"RTN","GPLCCR0",565,0)
|
||
;;</DateOfBirth>
|
||
"RTN","GPLCCR0",566,0)
|
||
;;<Gender>
|
||
"RTN","GPLCCR0",567,0)
|
||
;;<Text>@@ACTORGENDER@@</Text>
|
||
"RTN","GPLCCR0",568,0)
|
||
;;<Code>
|
||
"RTN","GPLCCR0",569,0)
|
||
;;<Value>@@ACTORGENDER@@</Value>
|
||
"RTN","GPLCCR0",570,0)
|
||
;;<CodingSystem>2.16.840.1.113883.5.1</CodingSystem>
|
||
"RTN","GPLCCR0",571,0)
|
||
;;</Code>
|
||
"RTN","GPLCCR0",572,0)
|
||
;;</Gender>
|
||
"RTN","GPLCCR0",573,0)
|
||
;;</Person>
|
||
"RTN","GPLCCR0",574,0)
|
||
;;<IDs>
|
||
"RTN","GPLCCR0",575,0)
|
||
;;<Type>
|
||
"RTN","GPLCCR0",576,0)
|
||
;;<Text>@@ACTORSSNTEXT@@</Text>
|
||
"RTN","GPLCCR0",577,0)
|
||
;;</Type>
|
||
"RTN","GPLCCR0",578,0)
|
||
;;<ID>@@ACTORSSN@@</ID>
|
||
"RTN","GPLCCR0",579,0)
|
||
;;<Source>
|
||
"RTN","GPLCCR0",580,0)
|
||
;;<Actor>
|
||
"RTN","GPLCCR0",581,0)
|
||
;;<ActorID>@@ACTORSSNSOURCEID@@</ActorID>
|
||
"RTN","GPLCCR0",582,0)
|
||
;;</Actor>
|
||
"RTN","GPLCCR0",583,0)
|
||
;;</Source>
|
||
"RTN","GPLCCR0",584,0)
|
||
;;</IDs>
|
||
"RTN","GPLCCR0",585,0)
|
||
;;<Address>
|
||
"RTN","GPLCCR0",586,0)
|
||
;;<Type>
|
||
"RTN","GPLCCR0",587,0)
|
||
;;<Text>@@ACTORADDRESSTYPE@@</Text>
|
||
"RTN","GPLCCR0",588,0)
|
||
;;</Type>
|
||
"RTN","GPLCCR0",589,0)
|
||
;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
|
||
"RTN","GPLCCR0",590,0)
|
||
;;<Line2>@@ACTORADDRESSLINE2@@</Line2>
|
||
"RTN","GPLCCR0",591,0)
|
||
;;<City>@@ACTORADDRESSCITY@@</City>
|
||
"RTN","GPLCCR0",592,0)
|
||
;;<State>@@ACTORADDRESSSTATE@@</State>
|
||
"RTN","GPLCCR0",593,0)
|
||
;;<PostalCode>@@ACTORADDRESSZIPCODE@@</PostalCode>
|
||
"RTN","GPLCCR0",594,0)
|
||
;;</Address>
|
||
"RTN","GPLCCR0",595,0)
|
||
;;<Telephone>
|
||
"RTN","GPLCCR0",596,0)
|
||
;;<Value>@@ACTORRESTEL@@</Value>
|
||
"RTN","GPLCCR0",597,0)
|
||
;;<Type>
|
||
"RTN","GPLCCR0",598,0)
|
||
;;<Text>@@ACTORRESTELTEXT@@</Text>
|
||
"RTN","GPLCCR0",599,0)
|
||
;;</Type>
|
||
"RTN","GPLCCR0",600,0)
|
||
;;</Telephone>
|
||
"RTN","GPLCCR0",601,0)
|
||
;;<Telephone>
|
||
"RTN","GPLCCR0",602,0)
|
||
;;<Value>@@ACTORWORKTEL@@</Value>
|
||
"RTN","GPLCCR0",603,0)
|
||
;;<Type>
|
||
"RTN","GPLCCR0",604,0)
|
||
;;<Text>@@ACTORWORKTELTEXT@@</Text>
|
||
"RTN","GPLCCR0",605,0)
|
||
;;</Type>
|
||
"RTN","GPLCCR0",606,0)
|
||
;;</Telephone>
|
||
"RTN","GPLCCR0",607,0)
|
||
;;<Telephone>
|
||
"RTN","GPLCCR0",608,0)
|
||
;;<Value>@@ACTORCELLTEL@@</Value>
|
||
"RTN","GPLCCR0",609,0)
|
||
;;<Type>
|
||
"RTN","GPLCCR0",610,0)
|
||
;;<Text>@@ACTORCELLTELTEXT@@</Text>
|
||
"RTN","GPLCCR0",611,0)
|
||
;;</Type>
|
||
"RTN","GPLCCR0",612,0)
|
||
;;</Telephone>
|
||
"RTN","GPLCCR0",613,0)
|
||
;;<EMail>
|
||
"RTN","GPLCCR0",614,0)
|
||
;;<Value>@@ACTOREMAIL@@</Value>
|
||
"RTN","GPLCCR0",615,0)
|
||
;;</EMail>
|
||
"RTN","GPLCCR0",616,0)
|
||
;;<Source>
|
||
"RTN","GPLCCR0",617,0)
|
||
;;<Actor>
|
||
"RTN","GPLCCR0",618,0)
|
||
;;<ActorID>@@ACTORADDRESSSOURCEID@@</ActorID>
|
||
"RTN","GPLCCR0",619,0)
|
||
;;</Actor>
|
||
"RTN","GPLCCR0",620,0)
|
||
;;</Source>
|
||
"RTN","GPLCCR0",621,0)
|
||
;;</Actor>
|
||
"RTN","GPLCCR0",622,0)
|
||
;;</ACTOR-PATIENT>
|
||
"RTN","GPLCCR0",623,0)
|
||
;;<ACTOR-SYSTEM>
|
||
"RTN","GPLCCR0",624,0)
|
||
;;<Actor>
|
||
"RTN","GPLCCR0",625,0)
|
||
;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
|
||
"RTN","GPLCCR0",626,0)
|
||
;;<InformationSystem>
|
||
"RTN","GPLCCR0",627,0)
|
||
;;<Name>@@ACTORINFOSYSNAME@@</Name>
|
||
"RTN","GPLCCR0",628,0)
|
||
;;<Version>@@ACTORINFOSYSVER@@</Version>
|
||
"RTN","GPLCCR0",629,0)
|
||
;;</InformationSystem>
|
||
"RTN","GPLCCR0",630,0)
|
||
;;<Source>
|
||
"RTN","GPLCCR0",631,0)
|
||
;;<Actor>
|
||
"RTN","GPLCCR0",632,0)
|
||
;;<ActorID>@@ACTORINFOSYSSOURCEID@@</ActorID>
|
||
"RTN","GPLCCR0",633,0)
|
||
;;</Actor>
|
||
"RTN","GPLCCR0",634,0)
|
||
;;</Source>
|
||
"RTN","GPLCCR0",635,0)
|
||
;;</Actor>
|
||
"RTN","GPLCCR0",636,0)
|
||
;;</ACTOR-SYSTEM>
|
||
"RTN","GPLCCR0",637,0)
|
||
;;<ACTOR-NOK>
|
||
"RTN","GPLCCR0",638,0)
|
||
;;<Actor>
|
||
"RTN","GPLCCR0",639,0)
|
||
;;<ActorObjectID>AA0003</ActorObjectID>
|
||
"RTN","GPLCCR0",640,0)
|
||
;;<Person>
|
||
"RTN","GPLCCR0",641,0)
|
||
;;<Name>
|
||
"RTN","GPLCCR0",642,0)
|
||
;;<DisplayName>@@ACTORDISPLAYNAME@@</DisplayName>
|
||
"RTN","GPLCCR0",643,0)
|
||
;;</Name>
|
||
"RTN","GPLCCR0",644,0)
|
||
;;</Person>
|
||
"RTN","GPLCCR0",645,0)
|
||
;;<Relation>
|
||
"RTN","GPLCCR0",646,0)
|
||
;;<Text>@@ACTORRELATION@@</Text>
|
||
"RTN","GPLCCR0",647,0)
|
||
;;</Relation>
|
||
"RTN","GPLCCR0",648,0)
|
||
;;<Source>
|
||
"RTN","GPLCCR0",649,0)
|
||
;;<Actor>
|
||
"RTN","GPLCCR0",650,0)
|
||
;;<ActorID>@@ACTORRELATIONSOURCEID@@</ActorID>
|
||
"RTN","GPLCCR0",651,0)
|
||
;;</Actor>
|
||
"RTN","GPLCCR0",652,0)
|
||
;;</Source>
|
||
"RTN","GPLCCR0",653,0)
|
||
;;</Actor>
|
||
"RTN","GPLCCR0",654,0)
|
||
;;</ACTOR-NOK>
|
||
"RTN","GPLCCR0",655,0)
|
||
;;<ACTOR-PROVIDER>
|
||
"RTN","GPLCCR0",656,0)
|
||
;;<Actor>
|
||
"RTN","GPLCCR0",657,0)
|
||
;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
|
||
"RTN","GPLCCR0",658,0)
|
||
;;<Person>
|
||
"RTN","GPLCCR0",659,0)
|
||
;;<Name>
|
||
"RTN","GPLCCR0",660,0)
|
||
;;<CurrentName>
|
||
"RTN","GPLCCR0",661,0)
|
||
;;<Given>@@ACTORGIVENNAME@@</Given>
|
||
"RTN","GPLCCR0",662,0)
|
||
;;<Middle>@@ACTORMIDDLENAME@@</Middle>
|
||
"RTN","GPLCCR0",663,0)
|
||
;;<Family>@@ACTORFAMILYNAME@@</Family>
|
||
"RTN","GPLCCR0",664,0)
|
||
;;<Title>@@ACTORTITLE@@</Title>
|
||
"RTN","GPLCCR0",665,0)
|
||
;;</CurrentName>
|
||
"RTN","GPLCCR0",666,0)
|
||
;;</Name>
|
||
"RTN","GPLCCR0",667,0)
|
||
;;</Person>
|
||
"RTN","GPLCCR0",668,0)
|
||
;;<IDs>
|
||
"RTN","GPLCCR0",669,0)
|
||
;;<Type>
|
||
"RTN","GPLCCR0",670,0)
|
||
;;<Text>@@IDTYPE@@</Text>
|
||
"RTN","GPLCCR0",671,0)
|
||
;;</Type>
|
||
"RTN","GPLCCR0",672,0)
|
||
;;<ID>@@ID@@</ID>
|
||
"RTN","GPLCCR0",673,0)
|
||
;;<IssuedBy>
|
||
"RTN","GPLCCR0",674,0)
|
||
;;<Description>
|
||
"RTN","GPLCCR0",675,0)
|
||
;;<Text>@@IDDESC@@</Text>
|
||
"RTN","GPLCCR0",676,0)
|
||
;;</Description>
|
||
"RTN","GPLCCR0",677,0)
|
||
;;</IssuedBy>
|
||
"RTN","GPLCCR0",678,0)
|
||
;;</IDs>
|
||
"RTN","GPLCCR0",679,0)
|
||
;;<Specialty>
|
||
"RTN","GPLCCR0",680,0)
|
||
;;<Text>@@ACTORSPECIALITY@@</Text>
|
||
"RTN","GPLCCR0",681,0)
|
||
;;</Specialty>
|
||
"RTN","GPLCCR0",682,0)
|
||
;;<Address>
|
||
"RTN","GPLCCR0",683,0)
|
||
;;<Type>
|
||
"RTN","GPLCCR0",684,0)
|
||
;;<Text>@@ACTORADDRESSTYPE@@</Text>
|
||
"RTN","GPLCCR0",685,0)
|
||
;;</Type>
|
||
"RTN","GPLCCR0",686,0)
|
||
;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
|
||
"RTN","GPLCCR0",687,0)
|
||
;;<City>@@ACTORADDRESSCITY@@</City>
|
||
"RTN","GPLCCR0",688,0)
|
||
;;<State>@@ACTORADDRESSSTATE@@</State>
|
||
"RTN","GPLCCR0",689,0)
|
||
;;<PostalCode>@@ACTORPOSTALCODE@@</PostalCode>
|
||
"RTN","GPLCCR0",690,0)
|
||
;;</Address>
|
||
"RTN","GPLCCR0",691,0)
|
||
;;<Telephone>
|
||
"RTN","GPLCCR0",692,0)
|
||
;;<Value>@@ACTORTELEPHONE@@</Value>
|
||
"RTN","GPLCCR0",693,0)
|
||
;;<Type>
|
||
"RTN","GPLCCR0",694,0)
|
||
;;<Text>@@ACTORTELEPHONETYPE@@</Text>
|
||
"RTN","GPLCCR0",695,0)
|
||
;;</Type>
|
||
"RTN","GPLCCR0",696,0)
|
||
;;</Telephone>
|
||
"RTN","GPLCCR0",697,0)
|
||
;;<Email>
|
||
"RTN","GPLCCR0",698,0)
|
||
;;<Value>@@ACTOREMAIL@@</Value>
|
||
"RTN","GPLCCR0",699,0)
|
||
;;</Email>
|
||
"RTN","GPLCCR0",700,0)
|
||
;;<Source>
|
||
"RTN","GPLCCR0",701,0)
|
||
;;<Actor>
|
||
"RTN","GPLCCR0",702,0)
|
||
;;<ActorID>@@ACTORSOURCEID@@</ActorID>
|
||
"RTN","GPLCCR0",703,0)
|
||
;;</Actor>
|
||
"RTN","GPLCCR0",704,0)
|
||
;;</Source>
|
||
"RTN","GPLCCR0",705,0)
|
||
;;</Actor>
|
||
"RTN","GPLCCR0",706,0)
|
||
;;</ACTOR-PROVIDER>
|
||
"RTN","GPLCCR0",707,0)
|
||
;;<ACTOR-ORG>
|
||
"RTN","GPLCCR0",708,0)
|
||
;;<Actor>
|
||
"RTN","GPLCCR0",709,0)
|
||
;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
|
||
"RTN","GPLCCR0",710,0)
|
||
;;<Organization>
|
||
"RTN","GPLCCR0",711,0)
|
||
;;<Name>@@ORGANIZATIONNAME@@</Name>
|
||
"RTN","GPLCCR0",712,0)
|
||
;;</Organization>
|
||
"RTN","GPLCCR0",713,0)
|
||
;;<Source>
|
||
"RTN","GPLCCR0",714,0)
|
||
;;<Actor>
|
||
"RTN","GPLCCR0",715,0)
|
||
;;<ActorID>@@ACTORSOURCEID@@</ActorID>
|
||
"RTN","GPLCCR0",716,0)
|
||
;;</Actor>
|
||
"RTN","GPLCCR0",717,0)
|
||
;;</Source>
|
||
"RTN","GPLCCR0",718,0)
|
||
;;</Actor>
|
||
"RTN","GPLCCR0",719,0)
|
||
;;</ACTOR-ORG>
|
||
"RTN","GPLCCR0",720,0)
|
||
;;</Actors>
|
||
"RTN","GPLCCR0",721,0)
|
||
;;<Signatures>
|
||
"RTN","GPLCCR0",722,0)
|
||
;;<CCRSignature>
|
||
"RTN","GPLCCR0",723,0)
|
||
;;<SignatureObjectID>S0001</SignatureObjectID>
|
||
"RTN","GPLCCR0",724,0)
|
||
;;<ExactDateTime>2008-03-18T23:10:58Z</ExactDateTime>
|
||
"RTN","GPLCCR0",725,0)
|
||
;;<Source>
|
||
"RTN","GPLCCR0",726,0)
|
||
;;<ActorID>AA0001</ActorID>
|
||
"RTN","GPLCCR0",727,0)
|
||
;;</Source>
|
||
"RTN","GPLCCR0",728,0)
|
||
;;<Signature>
|
||
"RTN","GPLCCR0",729,0)
|
||
;;<Signature xmlns="http://www.w3.org/2000/09/xmldsig#">
|
||
"RTN","GPLCCR0",730,0)
|
||
;;<SignedInfo>
|
||
"RTN","GPLCCR0",731,0)
|
||
;;<CanonicalizationMethod Algorithm="http://www.w3.org/TR/2001/REC-xml-c14n-20010315"/>
|
||
"RTN","GPLCCR0",732,0)
|
||
;;<SignatureMethod Algorithm="http://www.w3.org/2000/09/xmldsig#rsa-sha1"/>
|
||
"RTN","GPLCCR0",733,0)
|
||
;;<Reference URI="">
|
||
"RTN","GPLCCR0",734,0)
|
||
;;<Transforms>
|
||
"RTN","GPLCCR0",735,0)
|
||
;;<Transform Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature"/>
|
||
"RTN","GPLCCR0",736,0)
|
||
;;</Transforms>
|
||
"RTN","GPLCCR0",737,0)
|
||
;;<DigestMethod Algorithm="http://www.w3.org/2000/09/xmldsig#sha1"/>
|
||
"RTN","GPLCCR0",738,0)
|
||
;;<DigestValue>YFveLLyo+75P7rSciv0/m1O6Ot4=</DigestValue>
|
||
"RTN","GPLCCR0",739,0)
|
||
;;</Reference>
|
||
"RTN","GPLCCR0",740,0)
|
||
;;</SignedInfo>
|
||
"RTN","GPLCCR0",741,0)
|
||
;;<SignatureValue>Bj6sACXl74hrlbUYnu8HqnRab5VGy69BOYjOH7dETxgppXMEd7AoVYaePZvgJft78JR4oQY76hbFyGcIslYauPpJxx2hCd5d56xFeaQg01R6AQOvGnhjlq63TbpFdUq0B4tYsmiibJPbQJhTQe+TcWTBvWaQt8Fkk5blO571YvI=</SignatureValue>
|
||
"RTN","GPLCCR0",742,0)
|
||
;;<KeyInfo>
|
||
"RTN","GPLCCR0",743,0)
|
||
;;<KeyValue>
|
||
"RTN","GPLCCR0",744,0)
|
||
;;<RSAKeyValue>
|
||
"RTN","GPLCCR0",745,0)
|
||
;;<Modulus>meH817QYol+/uUEg6j8Mg89s7GTlaN9B+/CGlzrtnQH+swMigZRnEPxHVO8PhEymP/W9nlhAjTScV/CUzA9yJ9WiaOn17c+KReKhfBqL24DX9BpbJ+kLYVz7mBO5Qydk5AzUT2hFwW93irD8iRKP+/t+2Mi2CjNfj8VTjJpHpm0=</Modulus>
|
||
"RTN","GPLCCR0",746,0)
|
||
;;<Exponent>AQAB</Exponent>
|
||
"RTN","GPLCCR0",747,0)
|
||
;;</RSAKeyValue>
|
||
"RTN","GPLCCR0",748,0)
|
||
;;</KeyValue>
|
||
"RTN","GPLCCR0",749,0)
|
||
;;</KeyInfo>
|
||
"RTN","GPLCCR0",750,0)
|
||
;;</Signature>
|
||
"RTN","GPLCCR0",751,0)
|
||
;;</Signature>
|
||
"RTN","GPLCCR0",752,0)
|
||
;;</CCRSignature>
|
||
"RTN","GPLCCR0",753,0)
|
||
;;</Signatures>
|
||
"RTN","GPLCCR0",754,0)
|
||
;;</ContinuityOfCareRecord>
|
||
"RTN","GPLCCR0",755,0)
|
||
;</TEMPLATE>
|
||
"RTN","GPLLABS")
|
||
0^22^B221616742
|
||
"RTN","GPLLABS",1,0)
|
||
GPLALABS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR LAB RESULTS ; 10/01/08
|
||
"RTN","GPLLABS",2,0)
|
||
;;0.3;CCDCCR;nopatch;noreleasedate;Build 15
|
||
"RTN","GPLLABS",3,0)
|
||
;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
||
"RTN","GPLLABS",4,0)
|
||
;General Public License See attached copy of the License.
|
||
"RTN","GPLLABS",5,0)
|
||
;
|
||
"RTN","GPLLABS",6,0)
|
||
;This program is free software; you can redistribute it and/or modify
|
||
"RTN","GPLLABS",7,0)
|
||
;it under the terms of the GNU General Public License as published by
|
||
"RTN","GPLLABS",8,0)
|
||
;the Free Software Foundation; either version 2 of the License, or
|
||
"RTN","GPLLABS",9,0)
|
||
;(at your option) any later version.
|
||
"RTN","GPLLABS",10,0)
|
||
;
|
||
"RTN","GPLLABS",11,0)
|
||
;This program is distributed in the hope that it will be useful,
|
||
"RTN","GPLLABS",12,0)
|
||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
"RTN","GPLLABS",13,0)
|
||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
"RTN","GPLLABS",14,0)
|
||
;GNU General Public License for more details.
|
||
"RTN","GPLLABS",15,0)
|
||
;
|
||
"RTN","GPLLABS",16,0)
|
||
;You should have received a copy of the GNU General Public License along
|
||
"RTN","GPLLABS",17,0)
|
||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
||
"RTN","GPLLABS",18,0)
|
||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
||
"RTN","GPLLABS",19,0)
|
||
;
|
||
"RTN","GPLLABS",20,0)
|
||
;MAP(DFN,MOXML,MIVAR,MIXML) ; MAP RESULTS VARIABLES TO XML - GPL -TBD
|
||
"RTN","GPLLABS",21,0)
|
||
MAP(MIXML,DFN,MOXML) ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT
|
||
"RTN","GPLLABS",22,0)
|
||
; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR
|
||
"RTN","GPLLABS",23,0)
|
||
; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME
|
||
"RTN","GPLLABS",24,0)
|
||
; MIXML IS THE TEMPLATE TO USE
|
||
"RTN","GPLLABS",25,0)
|
||
; MOXML IS THE OUTPUT XML ARRAY
|
||
"RTN","GPLLABS",26,0)
|
||
; DFN IS THE PATIENT RECORD NUMBER
|
||
"RTN","GPLLABS",27,0)
|
||
N C0COXML,C0CO,C0CV,C0CIXML
|
||
"RTN","GPLLABS",28,0)
|
||
I '$D(MIVAR) S C0CV="" ;DEFAULT
|
||
"RTN","GPLLABS",29,0)
|
||
E S C0CV=MIVAR ;PASSED VARIABLE ARRAY
|
||
"RTN","GPLLABS",30,0)
|
||
I '$D(MIXML) S C0CIXML="" ;DEFAULT
|
||
"RTN","GPLLABS",31,0)
|
||
E S C0CIXML=MIXML ;PASSED INPUT XML
|
||
"RTN","GPLLABS",32,0)
|
||
D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK
|
||
"RTN","GPLLABS",33,0)
|
||
I '$D(MOXML) S C0CO=$NA(^TMP("GPLCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT
|
||
"RTN","GPLLABS",34,0)
|
||
E S C0CO=MOXML
|
||
"RTN","GPLLABS",35,0)
|
||
; ZWR C0COXML
|
||
"RTN","GPLLABS",36,0)
|
||
M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT
|
||
"RTN","GPLLABS",37,0)
|
||
Q
|
||
"RTN","GPLLABS",38,0)
|
||
;
|
||
"RTN","GPLLABS",39,0)
|
||
RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS
|
||
"RTN","GPLLABS",40,0)
|
||
; RTN IS PASSED BY REFERENCE
|
||
"RTN","GPLLABS",41,0)
|
||
;N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES
|
||
"RTN","GPLLABS",42,0)
|
||
;N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE
|
||
"RTN","GPLLABS",43,0)
|
||
I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING
|
||
"RTN","GPLLABS",44,0)
|
||
I RMIXML="" D ; INPUT XML NOT PASSED
|
||
"RTN","GPLLABS",45,0)
|
||
. D LOAD^GPLCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE
|
||
"RTN","GPLLABS",46,0)
|
||
. D QUERY^GPLXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R")
|
||
"RTN","GPLLABS",47,0)
|
||
. S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE
|
||
"RTN","GPLLABS",48,0)
|
||
E S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE
|
||
"RTN","GPLLABS",49,0)
|
||
I RMIVAR="" D ; LOCATION OF VARIABLES NOT PASSED
|
||
"RTN","GPLLABS",50,0)
|
||
. S C0CV=$NA(^TMP("GPLCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION
|
||
"RTN","GPLLABS",51,0)
|
||
E S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS
|
||
"RTN","GPLLABS",52,0)
|
||
D CP^GPLXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE
|
||
"RTN","GPLLABS",53,0)
|
||
D REPLACE^GPLXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ
|
||
"RTN","GPLLABS",54,0)
|
||
D QUERY^GPLXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE
|
||
"RTN","GPLLABS",55,0)
|
||
I '$D(C0CQT) S C0CQT=0 ; DEFAULT NOT SILENT
|
||
"RTN","GPLLABS",56,0)
|
||
I 'C0CQT D ; WE ARE DEBUGGING
|
||
"RTN","GPLLABS",57,0)
|
||
. W "I MAPPED",!
|
||
"RTN","GPLLABS",58,0)
|
||
. W "VARS:",C0CV,!
|
||
"RTN","GPLLABS",59,0)
|
||
. W "DFN:",DFN,!
|
||
"RTN","GPLLABS",60,0)
|
||
. ;D PARY^GPLXPATH("C0CT") ; SECTION TEMPLATE
|
||
"RTN","GPLLABS",61,0)
|
||
. ;D PARY^GPLXPATH("C0CRT") ;REQUEST TEMPLATE (OCR)
|
||
"RTN","GPLLABS",62,0)
|
||
. ;D PARY^GPLXPATH("C0CTT") ;TEST TEMPLATE (OCX)
|
||
"RTN","GPLLABS",63,0)
|
||
D EXTRACT("C0CT",DFN,) ; FIRST CALL EXTRACT
|
||
"RTN","GPLLABS",64,0)
|
||
I '$D(@C0CV@(0)) D Q ; NO VARS THERE
|
||
"RTN","GPLLABS",65,0)
|
||
. S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR
|
||
"RTN","GPLLABS",66,0)
|
||
I @C0CV@(0)=0 S RTN(0)=0 Q ; NO RESULTS
|
||
"RTN","GPLLABS",67,0)
|
||
S RIMVARS=$NA(^TMP("GPLRIM","VARS",DFN,"RESULTS"))
|
||
"RTN","GPLLABS",68,0)
|
||
K @RIMVARS
|
||
"RTN","GPLLABS",69,0)
|
||
M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH
|
||
"RTN","GPLLABS",70,0)
|
||
N C0CI,C0CJ,C0CMAP,C0CTMAP,C0CTMP
|
||
"RTN","GPLLABS",71,0)
|
||
S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR)
|
||
"RTN","GPLLABS",72,0)
|
||
N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT
|
||
"RTN","GPLLABS",73,0)
|
||
F C0CI=1:1:C0CIN D ; LOOP THROUGH VARIABLES
|
||
"RTN","GPLLABS",74,0)
|
||
. K C0CMAP,C0CTMP,C0CRTMP ;EMPTY OUT LAST BATCH OF VARIABLES
|
||
"RTN","GPLLABS",75,0)
|
||
. S C0CMAP=$NA(@C0CV@(C0CI)) ;
|
||
"RTN","GPLLABS",76,0)
|
||
. I 'C0CQT W "MAPOBR:",C0CMAP,!
|
||
"RTN","GPLLABS",77,0)
|
||
. ;MAPPING FOR TEST REQUEST GOES HERE
|
||
"RTN","GPLLABS",78,0)
|
||
. D MAP^GPLXPATH("C0CRT",C0CMAP,"C0CRTMP") ; MAP OBR DATA
|
||
"RTN","GPLLABS",79,0)
|
||
. I $D(@C0CMAP@("M","TESTS",0)) D ; TESTS EXIST
|
||
"RTN","GPLLABS",80,0)
|
||
. . S C0CJN=@C0CMAP@("M","TESTS",0) ; NUMBER OF TESTS
|
||
"RTN","GPLLABS",81,0)
|
||
. . K C0CTO ; CLEAR OUTPUT VARIABLE
|
||
"RTN","GPLLABS",82,0)
|
||
. . F C0CJ=1:1:C0CJN D ;FOR EACH TEST RESULT
|
||
"RTN","GPLLABS",83,0)
|
||
. . . K C0CTMAP,C0CTMP ; EMPTY MAPS FOR TEST RESULTS
|
||
"RTN","GPLLABS",84,0)
|
||
. . . S C0CTMAP=$NA(@C0CMAP@("M","TESTS",C0CJ)) ;
|
||
"RTN","GPLLABS",85,0)
|
||
. . . I 'C0CQT W "MAPOBX:",C0CTMAP,!
|
||
"RTN","GPLLABS",86,0)
|
||
. . . D MAP^GPLXPATH("C0CTT",C0CTMAP,"C0CTMP") ; MAP TO TMP
|
||
"RTN","GPLLABS",87,0)
|
||
. . . ;I C0CJ=1 D ; FIRST TIME, JUST COPY
|
||
"RTN","GPLLABS",88,0)
|
||
. . . ;. D CP^GPLXPATH("C0CTMP","C0CTO") ; START BUILDING TEST XML
|
||
"RTN","GPLLABS",89,0)
|
||
. . . ;E D INSINNER^GPLXPATH("C0CTO","C0CTMP")
|
||
"RTN","GPLLABS",90,0)
|
||
. . . ;
|
||
"RTN","GPLLABS",91,0)
|
||
. . . D PUSHA^GPLXPATH("C0CTO","C0CTMP") ;ADD THE TEST TO BUFFER
|
||
"RTN","GPLLABS",92,0)
|
||
. . ; I 'C0CQT D PARY^GPLXPATH("C0CTO")
|
||
"RTN","GPLLABS",93,0)
|
||
. . D INSINNER^GPLXPATH("C0CRTMP","C0CTO","//Results/Result/Test") ;INSERT TST
|
||
"RTN","GPLLABS",94,0)
|
||
. I C0CI=1 D ; FIRST TIME, COPY INSTEAD OF INSERT
|
||
"RTN","GPLLABS",95,0)
|
||
. . D CP^GPLXPATH("C0CRTMP","RTN") ;
|
||
"RTN","GPLLABS",96,0)
|
||
. E D INSINNER^GPLXPATH("RTN","C0CRTMP") ; INSERT THIS TEST REQUEST
|
||
"RTN","GPLLABS",97,0)
|
||
Q
|
||
"RTN","GPLLABS",98,0)
|
||
;
|
||
"RTN","GPLLABS",99,0)
|
||
EXTRACT(ILXML,DFN,OLXML) ; EXTRACT LABS INTO THE C0CLVAR GLOBAL
|
||
"RTN","GPLLABS",100,0)
|
||
;
|
||
"RTN","GPLLABS",101,0)
|
||
; LABXML AND LABOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
|
||
"RTN","GPLLABS",102,0)
|
||
;
|
||
"RTN","GPLLABS",103,0)
|
||
;
|
||
"RTN","GPLLABS",104,0)
|
||
;
|
||
"RTN","GPLLABS",105,0)
|
||
N C0CNSSN ; IS THERE AN SSN FLAG
|
||
"RTN","GPLLABS",106,0)
|
||
S C0CNSSN=0
|
||
"RTN","GPLLABS",107,0)
|
||
S C0CLB=$NA(^TMP("GPLCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
|
||
"RTN","GPLLABS",108,0)
|
||
D GHL7 ; GET HL7 MESSAGE FOR THIS PATIENT
|
||
"RTN","GPLLABS",109,0)
|
||
I C0CNSSN=1 D Q ; NO SSN, CAN'T GET HL7 FOR THIS PATIENT
|
||
"RTN","GPLLABS",110,0)
|
||
. S @C0CLB@(0)=0
|
||
"RTN","GPLLABS",111,0)
|
||
K @C0CLB ; CLEAR OUT OLD VARS IF ANY
|
||
"RTN","GPLLABS",112,0)
|
||
N QTSAV S QTSAV=C0CQT ;SAVE QUIET FLAG
|
||
"RTN","GPLLABS",113,0)
|
||
S C0CQT=1 ; SURPRESS LISTING
|
||
"RTN","GPLLABS",114,0)
|
||
D LIST ; EXTRACT THE VARIABLES
|
||
"RTN","GPLLABS",115,0)
|
||
S C0CQT=QTSAV ; RESET SILENT FLAG
|
||
"RTN","GPLLABS",116,0)
|
||
K ^TMP("HLS",$J) ; KILL HL7 MESSAGE OUTPUT
|
||
"RTN","GPLLABS",117,0)
|
||
I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^GPLLABS
|
||
"RTN","GPLLABS",118,0)
|
||
Q
|
||
"RTN","GPLLABS",119,0)
|
||
;
|
||
"RTN","GPLLABS",120,0)
|
||
GHL7 ; GET HL7 MESSAGE FOR LABS FOR THIS PATIENT
|
||
"RTN","GPLLABS",121,0)
|
||
; N C0CPTID,C0CSPC,C0CSDT,C0CEDT,C0CR
|
||
"RTN","GPLLABS",122,0)
|
||
; SET UP FOR LAB API CALL
|
||
"RTN","GPLLABS",123,0)
|
||
S C0CPTID=$$SSN^CCRDPT(DFN) ; GET THE SSN FOR THIS PATIENT
|
||
"RTN","GPLLABS",124,0)
|
||
I C0CPTID="" D Q ; NO SSN, COMPLAIN AND QUIT
|
||
"RTN","GPLLABS",125,0)
|
||
. W "LAB LOOKUP FAILED, NO SSN",!
|
||
"RTN","GPLLABS",126,0)
|
||
. S C0CNSSN=1 ; SET NO SSN FLAG
|
||
"RTN","GPLLABS",127,0)
|
||
S C0CSPC="*" ; LOOKING FOR ALL LABS
|
||
"RTN","GPLLABS",128,0)
|
||
D DT^DILF(,"T-5000",.C0CSDT) ; START DATE LONG AGO TO GET EVERYTHING
|
||
"RTN","GPLLABS",129,0)
|
||
D DT^DILF(,"T",.C0CEDT) ; END DATE TODAY TO GET EVERYTHING
|
||
"RTN","GPLLABS",130,0)
|
||
S C0CR=$$GCPR^LA7QRY(C0CPTID,C0CSDT,C0CEDT,C0CSPC,C0CSPC) ; CALL LAB LOOKUP
|
||
"RTN","GPLLABS",131,0)
|
||
Q
|
||
"RTN","GPLLABS",132,0)
|
||
;
|
||
"RTN","GPLLABS",133,0)
|
||
LIST ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB
|
||
"RTN","GPLLABS",134,0)
|
||
;
|
||
"RTN","GPLLABS",135,0)
|
||
; N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR
|
||
"RTN","GPLLABS",136,0)
|
||
I '$D(C0CLB) S C0CLB=$NA(^TMP("GPLCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
|
||
"RTN","GPLLABS",137,0)
|
||
I '$D(C0CQT) S C0CQT=0
|
||
"RTN","GPLLABS",138,0)
|
||
I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT
|
||
"RTN","GPLLABS",139,0)
|
||
I '$D(^KVAI(0)) D SETTBL ; INITIALIZE LAB TABLE
|
||
"RTN","GPLLABS",140,0)
|
||
I ^KBAI(0)'="V2" D SETTBL ; NEED NEWEST VERSION
|
||
"RTN","GPLLABS",141,0)
|
||
I '$D(^TMP("HLS",$J,1)) D GHL7 ; GET HL7 MGS IF NOT ALREADY DONE
|
||
"RTN","GPLLABS",142,0)
|
||
S C0CTAB=$NA(^KBAI) ; BASE OF OBX TABLE
|
||
"RTN","GPLLABS",143,0)
|
||
S C0CHB=$NA(^TMP("HLS",$J))
|
||
"RTN","GPLLABS",144,0)
|
||
S C0CI=""
|
||
"RTN","GPLLABS",145,0)
|
||
S @C0CLB@(0)=0 ; INITALIZE RESULTS VARS COUNT
|
||
"RTN","GPLLABS",146,0)
|
||
F S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI="" D ; FOR ALL RECORDS IN HL7 MSG
|
||
"RTN","GPLLABS",147,0)
|
||
. K C0CVAR,XV ; CLEAR OUT VARIABLE VALUES
|
||
"RTN","GPLLABS",148,0)
|
||
. S C0CTYP=$P(@C0CHB@(C0CI),"|",1)
|
||
"RTN","GPLLABS",149,0)
|
||
. D LTYP(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT)
|
||
"RTN","GPLLABS",150,0)
|
||
. M XV=C0CVAR ;
|
||
"RTN","GPLLABS",151,0)
|
||
. I C0CTYP="OBR" D ; BEGINNING OF NEW SECTION
|
||
"RTN","GPLLABS",152,0)
|
||
. . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT
|
||
"RTN","GPLLABS",153,0)
|
||
. . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT
|
||
"RTN","GPLLABS",154,0)
|
||
. . ;M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS
|
||
"RTN","GPLLABS",155,0)
|
||
. . S XV("RESULTOBJECTID")="RESULT_"_C0CLI
|
||
"RTN","GPLLABS",156,0)
|
||
. . S C0CX1=XV("RESULTSOURCEACTORID") ; SOURCE FROM OBR
|
||
"RTN","GPLLABS",157,0)
|
||
. . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1)
|
||
"RTN","GPLLABS",158,0)
|
||
. . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT
|
||
"RTN","GPLLABS",159,0)
|
||
. . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
|
||
"RTN","GPLLABS",160,0)
|
||
. . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^CCRUTIL(C0CX2,"DT") ;UTC TIME
|
||
"RTN","GPLLABS",161,0)
|
||
. . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS
|
||
"RTN","GPLLABS",162,0)
|
||
. . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION
|
||
"RTN","GPLLABS",163,0)
|
||
. I C0CTYP="OBX" D ; SPECIAL CASE FOR OBX3
|
||
"RTN","GPLLABS",164,0)
|
||
. . ; RESULTTESTCODEVALUE
|
||
"RTN","GPLLABS",165,0)
|
||
. . ; RESULTTESTDESCRIPTIONTEXT
|
||
"RTN","GPLLABS",166,0)
|
||
. . I C0CVAR("C3")="LN" D ; PRIMARY CODE IS LOINC
|
||
"RTN","GPLLABS",167,0)
|
||
. . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; THE LOINC CODE VALUE
|
||
"RTN","GPLLABS",168,0)
|
||
. . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC
|
||
"RTN","GPLLABS",169,0)
|
||
. . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; DESCRIPTION TEXT
|
||
"RTN","GPLLABS",170,0)
|
||
. . E I C0CVAR("C6")="LN" D ; SECONDARY CODE IS LOINC
|
||
"RTN","GPLLABS",171,0)
|
||
. . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; THE LOINC CODE VALUE
|
||
"RTN","GPLLABS",172,0)
|
||
. . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC
|
||
"RTN","GPLLABS",173,0)
|
||
. . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; DESCRIPTION TEXT
|
||
"RTN","GPLLABS",174,0)
|
||
. . E I C0CVAR("C6")'="" D ; NO LOINC CODES, USE SECONDARY IF PRESENT
|
||
"RTN","GPLLABS",175,0)
|
||
. . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; SECONDARY CODE VALUE
|
||
"RTN","GPLLABS",176,0)
|
||
. . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C6") ; SECONDARY CODE NAME
|
||
"RTN","GPLLABS",177,0)
|
||
. . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; SECONDARY TEXT
|
||
"RTN","GPLLABS",178,0)
|
||
. . E D ; NO SECONDARY, USE PRIMARY
|
||
"RTN","GPLLABS",179,0)
|
||
. . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE
|
||
"RTN","GPLLABS",180,0)
|
||
. . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME
|
||
"RTN","GPLLABS",181,0)
|
||
. . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT
|
||
"RTN","GPLLABS",182,0)
|
||
. I C0CTYP="OBX" D ; PROCESS TEST RESULTS
|
||
"RTN","GPLLABS",183,0)
|
||
. . I C0CLOBX=0 D ; FIRST TEST RESULT FOR THIS SECTION
|
||
"RTN","GPLLABS",184,0)
|
||
. . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TESTS")) ; INDENT FOR TEST RESULTS
|
||
"RTN","GPLLABS",185,0)
|
||
. . S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT
|
||
"RTN","GPLLABS",186,0)
|
||
. . S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT
|
||
"RTN","GPLLABS",187,0)
|
||
. . S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX
|
||
"RTN","GPLLABS",188,0)
|
||
. . S C0CX1=XV("RESULTTESTSOURCEACTORID") ; TEST SOURCE
|
||
"RTN","GPLLABS",189,0)
|
||
. . S C0CX2=$P($P(C0CX1,"^",1),"-",1) ; PULL OUT STATION NUMBER
|
||
"RTN","GPLLABS",190,0)
|
||
. . S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_C0CX2
|
||
"RTN","GPLLABS",191,0)
|
||
. . S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID")
|
||
"RTN","GPLLABS",192,0)
|
||
. . S C0CX1=XV("RESULTTESTDATETIME") ;DATE TIME IN HL7 FORMAT
|
||
"RTN","GPLLABS",193,0)
|
||
. . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
|
||
"RTN","GPLLABS",194,0)
|
||
. . S XV("RESULTTESTDATETIME")=$$FMDTOUTC^CCRUTIL(C0CX2,"DT") ;UTC TIME
|
||
"RTN","GPLLABS",195,0)
|
||
. . ; I 'C0CQT ZWR XV
|
||
"RTN","GPLLABS",196,0)
|
||
. . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES
|
||
"RTN","GPLLABS",197,0)
|
||
. I 'C0CQT D ;
|
||
"RTN","GPLLABS",198,0)
|
||
. . W C0CI," ",C0CTYP,!
|
||
"RTN","GPLLABS",199,0)
|
||
. ; S C0CI=$O(@C0CHB@(C0CI))
|
||
"RTN","GPLLABS",200,0)
|
||
;K ^TMP("GPLRIM","VARS",DFN,"RESULTS")
|
||
"RTN","GPLLABS",201,0)
|
||
;M ^TMP("GPLRIM","VARS",DFN,"RESULTS")=@C0CLB
|
||
"RTN","GPLLABS",202,0)
|
||
Q
|
||
"RTN","GPLLABS",203,0)
|
||
LTYP(OSEG,OTYP,OVARA,OC0CQT) ;
|
||
"RTN","GPLLABS",204,0)
|
||
S OTAB=$NA(@C0CTAB@(OTYP)) ; TABLE FOR SEGMENT TYPE
|
||
"RTN","GPLLABS",205,0)
|
||
I '$D(OC0CQT) S C0CQT=0 ; NOT C0CQT IS DEFAULT
|
||
"RTN","GPLLABS",206,0)
|
||
E S C0CQT=OC0CQT ; ACCEPT C0CQT FLAG
|
||
"RTN","GPLLABS",207,0)
|
||
I 1 D ; FOR HL7 SEGMENT TYPE
|
||
"RTN","GPLLABS",208,0)
|
||
. S OI="" ; INDEX INTO FIELDS IN SEG
|
||
"RTN","GPLLABS",209,0)
|
||
. F S OI=$O(@OTAB@(OI)) Q:OI="" D ; FOR EACH FIELD OF THE SEGMENT
|
||
"RTN","GPLLABS",210,0)
|
||
. . S OTI=$P(@OTAB@(OI),"^",1) ; TABLE INDEX
|
||
"RTN","GPLLABS",211,0)
|
||
. . S OVAR=$P(@OTAB@(OI),"^",4) ; CCR VARIABLE IF DEFINED
|
||
"RTN","GPLLABS",212,0)
|
||
. . S OV=$P(OSEG,"|",OTI+1) ; PULL OUT VALUE
|
||
"RTN","GPLLABS",213,0)
|
||
. . I $P(OI,";",2)'="" D ; THIS IS DEFINING A SUB-VALUE
|
||
"RTN","GPLLABS",214,0)
|
||
. . . S OI2=$P(OTI,";",2) ; THE SUB-INDEX
|
||
"RTN","GPLLABS",215,0)
|
||
. . . S OV=$P(OV,"^",OI2) ; PULL OUT SUB-VALUE
|
||
"RTN","GPLLABS",216,0)
|
||
. . I OVAR'="" S OVARA(OVAR)=OV ; PASS BACK VARIABLE AND VALUE
|
||
"RTN","GPLLABS",217,0)
|
||
. . I 'C0CQT D ; PRINT OUTPUT IF C0CQT IS FALSE
|
||
"RTN","GPLLABS",218,0)
|
||
. . . I OV'="" W OI_": "_$P(@OTAB@(OI),"^",3),": ",OVAR,": ",OV,!
|
||
"RTN","GPLLABS",219,0)
|
||
Q
|
||
"RTN","GPLLABS",220,0)
|
||
LOBX ;
|
||
"RTN","GPLLABS",221,0)
|
||
Q
|
||
"RTN","GPLLABS",222,0)
|
||
;
|
||
"RTN","GPLLABS",223,0)
|
||
SETTBL ;
|
||
"RTN","GPLLABS",224,0)
|
||
K X ; CLEAR X
|
||
"RTN","GPLLABS",225,0)
|
||
S X("PID","PID1")="1^00104^Set ID - Patient ID"
|
||
"RTN","GPLLABS",226,0)
|
||
S X("PID","PID2")="2^00105^Patient ID (External ID)"
|
||
"RTN","GPLLABS",227,0)
|
||
S X("PID","PID3")="3^00106^Patient ID (Internal ID)"
|
||
"RTN","GPLLABS",228,0)
|
||
S X("PID","PID4")="4^00107^Alternate Patient ID"
|
||
"RTN","GPLLABS",229,0)
|
||
S X("PID","PID5")="5^00108^Patient's Name"
|
||
"RTN","GPLLABS",230,0)
|
||
S X("PID","PID6")="6^00109^Mother's Maiden Name"
|
||
"RTN","GPLLABS",231,0)
|
||
S X("PID","PID7")="7^00110^Date of Birth"
|
||
"RTN","GPLLABS",232,0)
|
||
S X("PID","PID8")="8^00111^Sex"
|
||
"RTN","GPLLABS",233,0)
|
||
S X("PID","PID9")="9^00112^Patient Alias"
|
||
"RTN","GPLLABS",234,0)
|
||
S X("PID","PID10")="10^00113^Race"
|
||
"RTN","GPLLABS",235,0)
|
||
S X("PID","PID11")="11^00114^Patient Address"
|
||
"RTN","GPLLABS",236,0)
|
||
S X("PID","PID12")="12^00115^County Code"
|
||
"RTN","GPLLABS",237,0)
|
||
S X("PID","PID13")="13^00116^Phone Number - Home"
|
||
"RTN","GPLLABS",238,0)
|
||
S X("PID","PID14")="14^00117^Phone Number - Business"
|
||
"RTN","GPLLABS",239,0)
|
||
S X("PID","PID15")="15^00118^Language - Patient"
|
||
"RTN","GPLLABS",240,0)
|
||
S X("PID","PID16")="16^00119^Marital Status"
|
||
"RTN","GPLLABS",241,0)
|
||
S X("PID","PID17")="17^00120^Religion"
|
||
"RTN","GPLLABS",242,0)
|
||
S X("PID","PID18")="18^00121^Patient Account Number"
|
||
"RTN","GPLLABS",243,0)
|
||
S X("PID","PID19")="19^00122^SSN Number - Patient"
|
||
"RTN","GPLLABS",244,0)
|
||
S X("PID","PID20")="20^00123^Drivers License - Patient"
|
||
"RTN","GPLLABS",245,0)
|
||
S X("PID","PID21")="21^00124^Mother's Identifier"
|
||
"RTN","GPLLABS",246,0)
|
||
S X("PID","PID22")="22^00125^Ethnic Group"
|
||
"RTN","GPLLABS",247,0)
|
||
S X("PID","PID23")="23^00126^Birth Place"
|
||
"RTN","GPLLABS",248,0)
|
||
S X("PID","PID24")="24^00127^Multiple Birth Indicator"
|
||
"RTN","GPLLABS",249,0)
|
||
S X("PID","PID25")="25^00128^Birth Order"
|
||
"RTN","GPLLABS",250,0)
|
||
S X("PID","PID26")="26^00129^Citizenship"
|
||
"RTN","GPLLABS",251,0)
|
||
S X("PID","PID27")="27^00130^Veteran.s Military Status"
|
||
"RTN","GPLLABS",252,0)
|
||
S X("PID","PID28")="28^00739^Nationality"
|
||
"RTN","GPLLABS",253,0)
|
||
S X("PID","PID29")="29^00740^Patient Death Date/Time"
|
||
"RTN","GPLLABS",254,0)
|
||
S X("PID","PID30")="30^00741^Patient Death Indicator"
|
||
"RTN","GPLLABS",255,0)
|
||
S X("NTE","NTE1")="1^00573^Set ID - NTE"
|
||
"RTN","GPLLABS",256,0)
|
||
S X("NTE","NTE2")="2^00574^Source of Comment"
|
||
"RTN","GPLLABS",257,0)
|
||
S X("NTE","NTE3")="3^00575^Comment"
|
||
"RTN","GPLLABS",258,0)
|
||
S X("ORC","ORC1")="1^00215^Order Control"
|
||
"RTN","GPLLABS",259,0)
|
||
S X("ORC","ORC2")="2^00216^Placer Order Number"
|
||
"RTN","GPLLABS",260,0)
|
||
S X("ORC","ORC3")="3^00217^Filler Order Number"
|
||
"RTN","GPLLABS",261,0)
|
||
S X("ORC","ORC4")="4^00218^Placer Order Number"
|
||
"RTN","GPLLABS",262,0)
|
||
S X("ORC","ORC5")="5^00219^Order Status"
|
||
"RTN","GPLLABS",263,0)
|
||
S X("ORC","ORC6")="6^00220^Response Flag"
|
||
"RTN","GPLLABS",264,0)
|
||
S X("ORC","ORC7")="7^00221^Quantity/Timing"
|
||
"RTN","GPLLABS",265,0)
|
||
S X("ORC","ORC8")="8^00222^Parent"
|
||
"RTN","GPLLABS",266,0)
|
||
S X("ORC","ORC9")="9^00223^Date/Time of Transaction"
|
||
"RTN","GPLLABS",267,0)
|
||
S X("ORC","ORC10")="10^00224^Entered By"
|
||
"RTN","GPLLABS",268,0)
|
||
S X("ORC","ORC11")="11^00225^Verified By"
|
||
"RTN","GPLLABS",269,0)
|
||
S X("ORC","ORC12")="12^00226^Ordering Provider"
|
||
"RTN","GPLLABS",270,0)
|
||
S X("ORC","ORC13")="13^00227^Enterer's Location"
|
||
"RTN","GPLLABS",271,0)
|
||
S X("ORC","ORC14")="14^00228^Call Back Phone Number"
|
||
"RTN","GPLLABS",272,0)
|
||
S X("ORC","ORC15")="15^00229^Order Effective Date/Time"
|
||
"RTN","GPLLABS",273,0)
|
||
S X("ORC","ORC16")="16^00230^Order Control Code Reason"
|
||
"RTN","GPLLABS",274,0)
|
||
S X("ORC","ORC17")="17^00231^Entering Organization"
|
||
"RTN","GPLLABS",275,0)
|
||
S X("ORC","ORC18")="18^00232^Entering Device"
|
||
"RTN","GPLLABS",276,0)
|
||
S X("ORC","ORC19")="19^00233^Action By"
|
||
"RTN","GPLLABS",277,0)
|
||
S X("OBR","OBR1")="1^00237^Set ID - Observation Request"
|
||
"RTN","GPLLABS",278,0)
|
||
S X("OBR","OBR2")="2^00216^Placer Order Number"
|
||
"RTN","GPLLABS",279,0)
|
||
S X("OBR","OBR3")="3^00217^Filler Order Number"
|
||
"RTN","GPLLABS",280,0)
|
||
S X("OBR","OBR4")="4^00238^Universal Service ID"
|
||
"RTN","GPLLABS",281,0)
|
||
S X("OBR","OBR4;LOINC")="4;1^00238^Universal Service ID - LOINC^RESULTCODE"
|
||
"RTN","GPLLABS",282,0)
|
||
S X("OBR","OBR4;DESC")="4;2^00238^Universal Service ID - DESC^RESULTDESCRIPTIONTEXT"
|
||
"RTN","GPLLABS",283,0)
|
||
S X("OBR","OBR4;VACODE")="4;3^00238^Universal Service ID - VACODE^RESULTCODINGSYSTEM"
|
||
"RTN","GPLLABS",284,0)
|
||
S X("OBR","OBR5")="5^00239^Priority"
|
||
"RTN","GPLLABS",285,0)
|
||
S X("OBR","OBR6")="6^00240^Requested Date/Time"
|
||
"RTN","GPLLABS",286,0)
|
||
S X("OBR","OBR7")="7^00241^Observation Date/Time^RESULTASSESSMENTDATETIME"
|
||
"RTN","GPLLABS",287,0)
|
||
S X("OBR","OBR8")="8^00242^Observation End Date/Time"
|
||
"RTN","GPLLABS",288,0)
|
||
S X("OBR","OBR9")="9^00243^Collection Volume"
|
||
"RTN","GPLLABS",289,0)
|
||
S X("OBR","OBR10")="10^00244^Collector Identifier"
|
||
"RTN","GPLLABS",290,0)
|
||
S X("OBR","OBR11")="11^00245^Specimen Action Code"
|
||
"RTN","GPLLABS",291,0)
|
||
S X("OBR","OBR12")="12^00246^Danger Code"
|
||
"RTN","GPLLABS",292,0)
|
||
S X("OBR","OBR13")="13^00247^Relevant Clinical Info."
|
||
"RTN","GPLLABS",293,0)
|
||
S X("OBR","OBR14")="14^00248^Specimen Rcv'd. Date/Time"
|
||
"RTN","GPLLABS",294,0)
|
||
S X("OBR","OBR15")="15^00249^Specimen Source"
|
||
"RTN","GPLLABS",295,0)
|
||
S X("OBR","OBR16")="16^00226^Ordering Provider XCN^RESULTSOURCEACTORID"
|
||
"RTN","GPLLABS",296,0)
|
||
S X("OBR","OBR17")="17^00250^Order Callback Phone Number"
|
||
"RTN","GPLLABS",297,0)
|
||
S X("OBR","OBR18")="18^00251^Placers Field 1"
|
||
"RTN","GPLLABS",298,0)
|
||
S X("OBR","OBR19")="19^00252^Placers Field 2"
|
||
"RTN","GPLLABS",299,0)
|
||
S X("OBR","OBR20")="20^00253^Filler Field 1"
|
||
"RTN","GPLLABS",300,0)
|
||
S X("OBR","OBR21")="21^00254^Filler Field 2"
|
||
"RTN","GPLLABS",301,0)
|
||
S X("OBR","OBR22")="22^00255^Results Rpt./Status Change"
|
||
"RTN","GPLLABS",302,0)
|
||
S X("OBR","OBR23")="23^00256^Charge to Practice"
|
||
"RTN","GPLLABS",303,0)
|
||
S X("OBR","OBR24")="24^00257^Diagnostic Service Sect"
|
||
"RTN","GPLLABS",304,0)
|
||
S X("OBR","OBR25")="25^00258^Result Status^RESULTSTATUS"
|
||
"RTN","GPLLABS",305,0)
|
||
S X("OBR","OBR26")="26^00259^Parent Result"
|
||
"RTN","GPLLABS",306,0)
|
||
S X("OBR","OBR27")="27^00221^Quantity/Timing"
|
||
"RTN","GPLLABS",307,0)
|
||
S X("OBR","OBR28")="28^00260^Result Copies to"
|
||
"RTN","GPLLABS",308,0)
|
||
S X("OBR","OBR29")="29^00261^Parent Number"
|
||
"RTN","GPLLABS",309,0)
|
||
S X("OBR","OBR30")="30^00262^Transportation Mode"
|
||
"RTN","GPLLABS",310,0)
|
||
S X("OBR","OBR31")="31^00263^Reason for Study"
|
||
"RTN","GPLLABS",311,0)
|
||
S X("OBR","OBR32")="32^00264^Principal Result Interpreter"
|
||
"RTN","GPLLABS",312,0)
|
||
S X("OBR","OBR33")="33^00265^Assistant Result Interpreter"
|
||
"RTN","GPLLABS",313,0)
|
||
S X("OBR","OBR34")="34^00266^Technician"
|
||
"RTN","GPLLABS",314,0)
|
||
S X("OBR","OBR35")="35^00267^Transcriptionist"
|
||
"RTN","GPLLABS",315,0)
|
||
S X("OBR","OBR36")="36^00268^Scheduled Date/Time"
|
||
"RTN","GPLLABS",316,0)
|
||
S X("OBR","OBR37")="37^01028^Number of Sample Containers"
|
||
"RTN","GPLLABS",317,0)
|
||
S X("OBR","OBR38")="38^38^01029 Transport Logistics of Collected Sample"
|
||
"RTN","GPLLABS",318,0)
|
||
S X("OBR","OBR39")="39^01030^Collector.s Comment"
|
||
"RTN","GPLLABS",319,0)
|
||
S X("OBR","OBR40")="40^01031^Transport Arrangement Responsibility"
|
||
"RTN","GPLLABS",320,0)
|
||
S X("OBR","OBR41")="41^01032^Transport Arranged"
|
||
"RTN","GPLLABS",321,0)
|
||
S X("OBR","OBR42")="42^01033^Escort Required"
|
||
"RTN","GPLLABS",322,0)
|
||
S X("OBR","OBR43")="43^01034^Planned Patient Transport Comment"
|
||
"RTN","GPLLABS",323,0)
|
||
S X("OBX","OBX1")="1^00559^Set ID - OBX"
|
||
"RTN","GPLLABS",324,0)
|
||
S X("OBX","OBX2")="2^00676^Value Type"
|
||
"RTN","GPLLABS",325,0)
|
||
S X("OBX","OBX3")="3^00560^Observation Identifier"
|
||
"RTN","GPLLABS",326,0)
|
||
S X("OBX","OBX3;C1")="3;1^00560^Observation Identifier^C1"
|
||
"RTN","GPLLABS",327,0)
|
||
S X("OBX","OBX3;C2")="3;2^00560^Observation Identifier^C2"
|
||
"RTN","GPLLABS",328,0)
|
||
S X("OBX","OBX3;C3")="3;3^00560^Observation Identifier^C3"
|
||
"RTN","GPLLABS",329,0)
|
||
S X("OBX","OBX3;C4")="3;4^00560^Observation Identifier^C4"
|
||
"RTN","GPLLABS",330,0)
|
||
S X("OBX","OBX3;C5")="3;5^00560^Observation Identifier^C5"
|
||
"RTN","GPLLABS",331,0)
|
||
S X("OBX","OBX3;C6")="3;6^00560^Observation Identifier^C6"
|
||
"RTN","GPLLABS",332,0)
|
||
S X("OBX","OBX4")="4^00769^Observation Sub-Id"
|
||
"RTN","GPLLABS",333,0)
|
||
S X("OBX","OBX5")="5^00561^Observation Results^RESULTTESTVALUE"
|
||
"RTN","GPLLABS",334,0)
|
||
S X("OBX","OBX6")="6^00562^Units^RESULTTESTUNITS"
|
||
"RTN","GPLLABS",335,0)
|
||
S X("OBX","OBX7")="7^00563^Reference Range^RESULTTESTNORMALDESCRIPTIONTEXT"
|
||
"RTN","GPLLABS",336,0)
|
||
S X("OBX","OBX8")="8^00564^Abnormal Flags^RESULTTESTFLAG"
|
||
"RTN","GPLLABS",337,0)
|
||
S X("OBX","OBX9")="9^00639^Probability"
|
||
"RTN","GPLLABS",338,0)
|
||
S X("OBX","OBX10")="10^00565^Nature of Abnormal Test"
|
||
"RTN","GPLLABS",339,0)
|
||
S X("OBX","OBX11")="11^00566^Observ. Result Status^RESULTTESTSTATUSTEXT"
|
||
"RTN","GPLLABS",340,0)
|
||
S X("OBX","OBX12")="12^00567^Date Last Normal Value"
|
||
"RTN","GPLLABS",341,0)
|
||
S X("OBX","OBX13")="13^00581^User Defined Access Checks"
|
||
"RTN","GPLLABS",342,0)
|
||
S X("OBX","OBX14")="14^00582^Date/Time of Observation^RESULTTESTDATETIME"
|
||
"RTN","GPLLABS",343,0)
|
||
S X("OBX","OBX15")="15^00583^Producer.s ID^RESULTTESTSOURCEACTORID"
|
||
"RTN","GPLLABS",344,0)
|
||
S X("OBX","OBX16")="16^00584^Responsible Observer"
|
||
"RTN","GPLLABS",345,0)
|
||
S X("OBX","OBX17")="17^00936^Observation Method"
|
||
"RTN","GPLLABS",346,0)
|
||
M ^KBAI=X ; SET VALUES IN ^KBAI
|
||
"RTN","GPLLABS",347,0)
|
||
S ^KBAI(0)="V2"
|
||
"RTN","GPLLABS",348,0)
|
||
Q
|
||
"RTN","GPLLABS",349,0)
|
||
;
|
||
"RTN","GPLPROBS")
|
||
0^20^B25875394
|
||
"RTN","GPLPROBS",1,0)
|
||
GPLPROBS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR PROBLEMS ; 6/6/08
|
||
"RTN","GPLPROBS",2,0)
|
||
;;0.1;CCDCCR;nopatch;noreleasedate;Build 15
|
||
"RTN","GPLPROBS",3,0)
|
||
;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
||
"RTN","GPLPROBS",4,0)
|
||
;General Public License See attached copy of the License.
|
||
"RTN","GPLPROBS",5,0)
|
||
;
|
||
"RTN","GPLPROBS",6,0)
|
||
;This program is free software; you can redistribute it and/or modify
|
||
"RTN","GPLPROBS",7,0)
|
||
;it under the terms of the GNU General Public License as published by
|
||
"RTN","GPLPROBS",8,0)
|
||
;the Free Software Foundation; either version 2 of the License, or
|
||
"RTN","GPLPROBS",9,0)
|
||
;(at your option) any later version.
|
||
"RTN","GPLPROBS",10,0)
|
||
;
|
||
"RTN","GPLPROBS",11,0)
|
||
;This program is distributed in the hope that it will be useful,
|
||
"RTN","GPLPROBS",12,0)
|
||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
"RTN","GPLPROBS",13,0)
|
||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
"RTN","GPLPROBS",14,0)
|
||
;GNU General Public License for more details.
|
||
"RTN","GPLPROBS",15,0)
|
||
;
|
||
"RTN","GPLPROBS",16,0)
|
||
;You should have received a copy of the GNU General Public License along
|
||
"RTN","GPLPROBS",17,0)
|
||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
||
"RTN","GPLPROBS",18,0)
|
||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
||
"RTN","GPLPROBS",19,0)
|
||
;
|
||
"RTN","GPLPROBS",20,0)
|
||
;
|
||
"RTN","GPLPROBS",21,0)
|
||
; PROCESS THE PROBLEMS SECTION OF THE CCR
|
||
"RTN","GPLPROBS",22,0)
|
||
;
|
||
"RTN","GPLPROBS",23,0)
|
||
EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
|
||
"RTN","GPLPROBS",24,0)
|
||
;
|
||
"RTN","GPLPROBS",25,0)
|
||
; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
|
||
"RTN","GPLPROBS",26,0)
|
||
; INXML WILL CONTAIN ONLY THE PROBLEM SECTION OF THE OVERALL TEMPLATE
|
||
"RTN","GPLPROBS",27,0)
|
||
; ONLY THE XML FOR ONE PROBLEM WILL BE PASSED. THIS ROUTINE WILL MAKE
|
||
"RTN","GPLPROBS",28,0)
|
||
; COPIES AS NECESSARY TO REPRESENT MULTIPLE PROBLEMS
|
||
"RTN","GPLPROBS",29,0)
|
||
; INSERT^GPLXPATH IS USED TO APPEND THE PROBLEMS TO THE OUTPUT
|
||
"RTN","GPLPROBS",30,0)
|
||
;
|
||
"RTN","GPLPROBS",31,0)
|
||
N RPCRSLT,J,K,PTMP,X,VMAP,TBU
|
||
"RTN","GPLPROBS",32,0)
|
||
S TVMAP=$NA(^TMP("GPLCCR",$J,"PROBVALS"))
|
||
"RTN","GPLPROBS",33,0)
|
||
S TARYTMP=$NA(^TMP("GPLCCR",$J,"PROBARYTMP"))
|
||
"RTN","GPLPROBS",34,0)
|
||
K @TVMAP,@TARYTMP ; KILL OLD ARRAY VALUES
|
||
"RTN","GPLPROBS",35,0)
|
||
D LIST^ORQQPL3(.RPCRSLT,DFN,"") ; CALL THE PROBLEM LIST RPC
|
||
"RTN","GPLPROBS",36,0)
|
||
I '$D(RPCRSLT(1)) D Q ; RPC RETURNS NULL
|
||
"RTN","GPLPROBS",37,0)
|
||
. W "NULL RESULT FROM LIST^ORQQPL3 ",!
|
||
"RTN","GPLPROBS",38,0)
|
||
. S @OUTXML@(0)=0
|
||
"RTN","GPLPROBS",39,0)
|
||
. ; Q
|
||
"RTN","GPLPROBS",40,0)
|
||
; I DEBUG ZWR RPCRSLT
|
||
"RTN","GPLPROBS",41,0)
|
||
S @TVMAP@(0)=RPCRSLT(0) ; SAVE NUMBER OF PROBLEMS
|
||
"RTN","GPLPROBS",42,0)
|
||
F J=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM IN THE LIST
|
||
"RTN","GPLPROBS",43,0)
|
||
. S VMAP=$NA(@TVMAP@(J))
|
||
"RTN","GPLPROBS",44,0)
|
||
. K @VMAP
|
||
"RTN","GPLPROBS",45,0)
|
||
. I DEBUG W "VMAP= ",VMAP,!
|
||
"RTN","GPLPROBS",46,0)
|
||
. S PTMP=RPCRSLT(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY
|
||
"RTN","GPLPROBS",47,0)
|
||
. S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM
|
||
"RTN","GPLPROBS",48,0)
|
||
. S @VMAP@("PROBLEMIEN")=$P(PTMP,U,1)
|
||
"RTN","GPLPROBS",49,0)
|
||
. S @VMAP@("PROBLEMSTATUS")=$P(PTMP,U,2)
|
||
"RTN","GPLPROBS",50,0)
|
||
. S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,3)
|
||
"RTN","GPLPROBS",51,0)
|
||
. S @VMAP@("PROBLEMCODINGVERSION")=""
|
||
"RTN","GPLPROBS",52,0)
|
||
. S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4)
|
||
"RTN","GPLPROBS",53,0)
|
||
. S @VMAP@("PROBLEMDATEOFONSET")=$P(PTMP,U,5)
|
||
"RTN","GPLPROBS",54,0)
|
||
. S @VMAP@("PROBLEMDATEMOD")=$P(PTMP,U,6)
|
||
"RTN","GPLPROBS",55,0)
|
||
. S @VMAP@("PROBLEMSC")=$P(PTMP,U,7)
|
||
"RTN","GPLPROBS",56,0)
|
||
. S @VMAP@("PROBLEMSE")=$P(PTMP,U,8)
|
||
"RTN","GPLPROBS",57,0)
|
||
. S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9)
|
||
"RTN","GPLPROBS",58,0)
|
||
. S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10)
|
||
"RTN","GPLPROBS",59,0)
|
||
. S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11)
|
||
"RTN","GPLPROBS",60,0)
|
||
. S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12)
|
||
"RTN","GPLPROBS",61,0)
|
||
. S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER
|
||
"RTN","GPLPROBS",62,0)
|
||
. S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$P(X,";",1)
|
||
"RTN","GPLPROBS",63,0)
|
||
. S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13)
|
||
"RTN","GPLPROBS",64,0)
|
||
. S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14)
|
||
"RTN","GPLPROBS",65,0)
|
||
. S @VMAP@("PROBLEMDTREC")=$P(PTMP,U,15)
|
||
"RTN","GPLPROBS",66,0)
|
||
. S @VMAP@("PROBLEMINACT")=$P(PTMP,U,16)
|
||
"RTN","GPLPROBS",67,0)
|
||
. S ARYTMP=$NA(@TARYTMP@(J))
|
||
"RTN","GPLPROBS",68,0)
|
||
. ; W "ARYTMP= ",ARYTMP,!
|
||
"RTN","GPLPROBS",69,0)
|
||
. K @ARYTMP
|
||
"RTN","GPLPROBS",70,0)
|
||
. D MAP^GPLXPATH(IPXML,VMAP,ARYTMP) ;
|
||
"RTN","GPLPROBS",71,0)
|
||
. I J=1 D ; FIRST ONE IS JUST A COPY
|
||
"RTN","GPLPROBS",72,0)
|
||
. . ; W "FIRST ONE",!
|
||
"RTN","GPLPROBS",73,0)
|
||
. . D CP^GPLXPATH(ARYTMP,OUTXML)
|
||
"RTN","GPLPROBS",74,0)
|
||
. . ; W "OUTXML ",OUTXML,!
|
||
"RTN","GPLPROBS",75,0)
|
||
. I J>1 D ; AFTER THE FIRST, INSERT INNER XML
|
||
"RTN","GPLPROBS",76,0)
|
||
. . D INSINNER^GPLXPATH(OUTXML,ARYTMP)
|
||
"RTN","GPLPROBS",77,0)
|
||
; ZWR ^TMP("GPLCCR",$J,"PROBVALS",*)
|
||
"RTN","GPLPROBS",78,0)
|
||
; ZWR ^TMP("GPLCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS
|
||
"RTN","GPLPROBS",79,0)
|
||
; ZWR @OUTXML
|
||
"RTN","GPLPROBS",80,0)
|
||
; $$HTML^DILF(
|
||
"RTN","GPLPROBS",81,0)
|
||
; GENERATE THE NARITIVE HTML FOR THE CCD
|
||
"RTN","GPLPROBS",82,0)
|
||
I CCD D ; IF THIS IS FOR A CCD
|
||
"RTN","GPLPROBS",83,0)
|
||
. N HTMP,HOUT,HTMLO,GPLPROBI,ZX
|
||
"RTN","GPLPROBS",84,0)
|
||
. F GPLPROBI=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM
|
||
"RTN","GPLPROBS",85,0)
|
||
. . S VMAP=$NA(@TVMAP@(GPLPROBI))
|
||
"RTN","GPLPROBS",86,0)
|
||
. . I DEBUG W "VMAP =",VMAP,!
|
||
"RTN","GPLPROBS",87,0)
|
||
. . D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Body/PROBLEMS-HTML","HTMP") ; GET THE HTML FROM THE TEMPLATE
|
||
"RTN","GPLPROBS",88,0)
|
||
. . D UNMARK^GPLXPATH("HTMP") ; REMOVE <PROBLEMS-HTML> MARKUP
|
||
"RTN","GPLPROBS",89,0)
|
||
. . ; D PARY^GPLXPATH("HTMP") ; PRINT IT
|
||
"RTN","GPLPROBS",90,0)
|
||
. . D MAP^GPLXPATH("HTMP",VMAP,"HOUT") ; MAP THE VARIABLES
|
||
"RTN","GPLPROBS",91,0)
|
||
. . ; D PARY^GPLXPATH("HOUT") ; PRINT IT AGAIN
|
||
"RTN","GPLPROBS",92,0)
|
||
. . I GPLPROBI=1 D ; FIRST ONE IS JUST A COPY
|
||
"RTN","GPLPROBS",93,0)
|
||
. . . D CP^GPLXPATH("HOUT","HTMLO")
|
||
"RTN","GPLPROBS",94,0)
|
||
. . I GPLPROBI>1 D ; AFTER THE FIRST, INSERT INNER HTML
|
||
"RTN","GPLPROBS",95,0)
|
||
. . . I DEBUG W "DOING INNER",!
|
||
"RTN","GPLPROBS",96,0)
|
||
. . . N HTMLBLD,HTMLTMP
|
||
"RTN","GPLPROBS",97,0)
|
||
. . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",1,HTMLO(0)-1)
|
||
"RTN","GPLPROBS",98,0)
|
||
. . . D QUEUE^GPLXPATH("HTMLBLD","HOUT",2,HOUT(0)-1)
|
||
"RTN","GPLPROBS",99,0)
|
||
. . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",HTMLO(0),HTMLO(0))
|
||
"RTN","GPLPROBS",100,0)
|
||
. . . D BUILD^GPLXPATH("HTMLBLD","HTMLTMP")
|
||
"RTN","GPLPROBS",101,0)
|
||
. . . D CP^GPLXPATH("HTMLTMP","HTMLO")
|
||
"RTN","GPLPROBS",102,0)
|
||
. . . ; D INSINNER^GPLXPATH("HOUT","HTMLO","//")
|
||
"RTN","GPLPROBS",103,0)
|
||
. I DEBUG D PARY^GPLXPATH("HTMLO")
|
||
"RTN","GPLPROBS",104,0)
|
||
. D INSB4^GPLXPATH(OUTXML,"HTMLO") ; INSERT AT TOP OF SECTION
|
||
"RTN","GPLPROBS",105,0)
|
||
N PROBSTMP,I
|
||
"RTN","GPLPROBS",106,0)
|
||
D MISSING^GPLXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS
|
||
"RTN","GPLPROBS",107,0)
|
||
I PROBSTMP(0)>0 D ; IF THERE ARE MISSING VARS -
|
||
"RTN","GPLPROBS",108,0)
|
||
. ; STRINGS MARKED AS @@X@@
|
||
"RTN","GPLPROBS",109,0)
|
||
. W !,"PROBLEMS Missing list: ",!
|
||
"RTN","GPLPROBS",110,0)
|
||
. F I=1:1:PROBSTMP(0) W PROBSTMP(I),!
|
||
"RTN","GPLPROBS",111,0)
|
||
Q
|
||
"RTN","GPLPROBS",112,0)
|
||
;
|
||
"RTN","GPLRIMA")
|
||
0^18^B244980714
|
||
"RTN","GPLRIMA",1,0)
|
||
GPLRIMA ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08
|
||
"RTN","GPLRIMA",2,0)
|
||
;;0.1;CCDCCR;nopatch;noreleasedate;Build 15
|
||
"RTN","GPLRIMA",3,0)
|
||
;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
||
"RTN","GPLRIMA",4,0)
|
||
;General Public License See attached copy of the License.
|
||
"RTN","GPLRIMA",5,0)
|
||
;
|
||
"RTN","GPLRIMA",6,0)
|
||
;This program is free software; you can redistribute it and/or modify
|
||
"RTN","GPLRIMA",7,0)
|
||
;it under the terms of the GNU General Public License as published by
|
||
"RTN","GPLRIMA",8,0)
|
||
;the Free Software Foundation; either version 2 of the License, or
|
||
"RTN","GPLRIMA",9,0)
|
||
;(at your option) any later version.
|
||
"RTN","GPLRIMA",10,0)
|
||
;
|
||
"RTN","GPLRIMA",11,0)
|
||
;This program is distributed in the hope that it will be useful,
|
||
"RTN","GPLRIMA",12,0)
|
||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
"RTN","GPLRIMA",13,0)
|
||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
"RTN","GPLRIMA",14,0)
|
||
;GNU General Public License for more details.
|
||
"RTN","GPLRIMA",15,0)
|
||
;
|
||
"RTN","GPLRIMA",16,0)
|
||
;You should have received a copy of the GNU General Public License along
|
||
"RTN","GPLRIMA",17,0)
|
||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
||
"RTN","GPLRIMA",18,0)
|
||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
||
"RTN","GPLRIMA",19,0)
|
||
;
|
||
"RTN","GPLRIMA",20,0)
|
||
; THESE ROUTINES EXAMINE ONE OR MORE, UP TO ALL, OF THE PATIENTS ON THE
|
||
"RTN","GPLRIMA",21,0)
|
||
; SYSTEM TO DETERMINE HOW COMPLETE THE RESULTING CCR OR CCD WOULD BE FOR
|
||
"RTN","GPLRIMA",22,0)
|
||
; THESE PATIENTS. IT BEGINS TO MEASURE "HL7 RIM COHERENCE" WHICH IS HOW USEFUL
|
||
"RTN","GPLRIMA",23,0)
|
||
; THE VARIABLES WILL BE TO A RIM-MODELED APPLICATION AFTER THEY ARE
|
||
"RTN","GPLRIMA",24,0)
|
||
; CONVEYED VIA THE CCR OR CCD.
|
||
"RTN","GPLRIMA",25,0)
|
||
; FACTORS THAT AFFECT RIM COHERENCE INCLUDE:
|
||
"RTN","GPLRIMA",26,0)
|
||
; 1. THE PRESENSE OF CLINICAL DATA IN A SECTION
|
||
"RTN","GPLRIMA",27,0)
|
||
; 2. ARE THE DATA ELEMENTS TIME-BOUND
|
||
"RTN","GPLRIMA",28,0)
|
||
; 3. ARE THE DATA ELEMENTS CODED WITH SNOMED OR LOINC ETC
|
||
"RTN","GPLRIMA",29,0)
|
||
; 4. ARE SOURCE ACTORS ASSOCIATED WITH THE DATA ELEMENTS
|
||
"RTN","GPLRIMA",30,0)
|
||
; 5. ARE ACTORS IDENTIFIED REGARDING THEIR ROLE
|
||
"RTN","GPLRIMA",31,0)
|
||
; .. AND OTHER FACTORS YET TO BE DETERMINED
|
||
"RTN","GPLRIMA",32,0)
|
||
;
|
||
"RTN","GPLRIMA",33,0)
|
||
; SINCE THESE MEASUREMENTS ARE DONE AT THE VARIABLE LEVEL, THEY
|
||
"RTN","GPLRIMA",34,0)
|
||
; REFLECT ON RIM COHERENCE WHETHER THE CCR OR THE CCD IS USED FOR
|
||
"RTN","GPLRIMA",35,0)
|
||
; CONVEYANCE TO THE RIM APPLICATION.
|
||
"RTN","GPLRIMA",36,0)
|
||
;
|
||
"RTN","GPLRIMA",37,0)
|
||
;
|
||
"RTN","GPLRIMA",38,0)
|
||
ANALYZE(BEGDFN,DFNCNT) ; RIM COHERANCE ANALYSIS ROUTINE
|
||
"RTN","GPLRIMA",39,0)
|
||
; BEGINS AT BEGDFN AND GOES FOR DFNCNT PATIENTS
|
||
"RTN","GPLRIMA",40,0)
|
||
; TO RESUME AT NEXT PATIENT, USE BEGDFN=""
|
||
"RTN","GPLRIMA",41,0)
|
||
; USE RESET^GPLRIMA TO RESET TO TOP OF PATIENT LIST
|
||
"RTN","GPLRIMA",42,0)
|
||
;
|
||
"RTN","GPLRIMA",43,0)
|
||
N RIMARY,RIMTMP,RIMI,RIMDFN,RATTR
|
||
"RTN","GPLRIMA",44,0)
|
||
N CCRGLO
|
||
"RTN","GPLRIMA",45,0)
|
||
D ASETUP ; SET UP VARIABLES AND GLOBALS
|
||
"RTN","GPLRIMA",46,0)
|
||
D AINIT ; INITIALIZE ATTRIBUTE VALUE TABLE
|
||
"RTN","GPLRIMA",47,0)
|
||
I '$D(@RIMBASE@("RESUME")) S @RIMBASE@("RESUME")=$O(^DPT(0)) ; FIRST TIME
|
||
"RTN","GPLRIMA",48,0)
|
||
S RESUME=@RIMBASE@("RESUME") ; WHERE WE LEFT OFF LAST RUN
|
||
"RTN","GPLRIMA",49,0)
|
||
S RIMDFN=BEGDFN ; BEGIN WITH THE BEGDFN PATIENT
|
||
"RTN","GPLRIMA",50,0)
|
||
I RIMDFN="" S RIMDFN=RESUME
|
||
"RTN","GPLRIMA",51,0)
|
||
I +RIMDFN=0 D Q ; AT THE END OF THE PATIENTS
|
||
"RTN","GPLRIMA",52,0)
|
||
. W "END OF PATIENT LIST, CALL RESET^GPLRIMA",!
|
||
"RTN","GPLRIMA",53,0)
|
||
F RIMI=1:1:DFNCNT D Q:+RIMDFN=0 ; FOR DFNCNT NUMBER OF PATIENTS OR END
|
||
"RTN","GPLRIMA",54,0)
|
||
. D CCRRPC^GPLCCR(.CCRGLO,RIMDFN,"CCR","","","") ;PROCESS THE CCR
|
||
"RTN","GPLRIMA",55,0)
|
||
. W RIMDFN,!
|
||
"RTN","GPLRIMA",56,0)
|
||
. K @RIMBASE@("VARS",RIMDFN) ; CLEAR OUT OLD VARS
|
||
"RTN","GPLRIMA",57,0)
|
||
. ;
|
||
"RTN","GPLRIMA",58,0)
|
||
. ; COPY ALL THE VARIABLES TO THE RIM MAP AREA INDEXED BY PATIENT
|
||
"RTN","GPLRIMA",59,0)
|
||
. ;
|
||
"RTN","GPLRIMA",60,0)
|
||
. I $D(^TMP("GPLCCR",$J,"PROBVALS",1)) D ; PROBLEM VARS EXISTS
|
||
"RTN","GPLRIMA",61,0)
|
||
. . M @RIMBASE@("VARS",RIMDFN,"PROBLEMS")=^TMP("GPLCCR",$J,"PROBVALS")
|
||
"RTN","GPLRIMA",62,0)
|
||
. . S @RIMBASE@("VARS",RIMDFN,"PROBLEMS",0)=^TMP("GPLCCR",$J,"PROBVALS",0)
|
||
"RTN","GPLRIMA",63,0)
|
||
. I $D(^TMP("GPLCCR",$J,"VITALS",1)) D ; VITALS VARS EXISTS
|
||
"RTN","GPLRIMA",64,0)
|
||
. . M @RIMBASE@("VARS",RIMDFN,"VITALS")=^TMP("GPLCCR",$J,"VITALS")
|
||
"RTN","GPLRIMA",65,0)
|
||
. I $D(^TMP("GPLCCR",$J,"MEDMAP",1)) D ; MEDS VARS EXISTS
|
||
"RTN","GPLRIMA",66,0)
|
||
. . M @RIMBASE@("VARS",RIMDFN,"MEDS")=^TMP("GPLCCR",$J,"MEDMAP")
|
||
"RTN","GPLRIMA",67,0)
|
||
. I $D(^TMP("GPLCCR",$J,"ALERTS",1,"ALERTOBJECTID")) D ; ALERTS EXIST
|
||
"RTN","GPLRIMA",68,0)
|
||
. . W "FOUND ALERT VARS",!
|
||
"RTN","GPLRIMA",69,0)
|
||
. . M @RIMBASE@("VARS",RIMDFN,"ALERTS")=^TMP("GPLCCR",$J,"ALERTS")
|
||
"RTN","GPLRIMA",70,0)
|
||
. I $D(^TMP("GPLCCR",$J,"RESULTS",0)) D ; RESULTS EXIST
|
||
"RTN","GPLRIMA",71,0)
|
||
. . W "FOUND RESULTS VARS",!
|
||
"RTN","GPLRIMA",72,0)
|
||
. . M @RIMBASE@("VARS",RIMDFN,"RESULTS")=^TMP("GPLCCR",$J,"RESULTS")
|
||
"RTN","GPLRIMA",73,0)
|
||
. K ^TMP("GPLCCR",$J) ; KILL WORK AREA FOR CCR BUILDING
|
||
"RTN","GPLRIMA",74,0)
|
||
. ;
|
||
"RTN","GPLRIMA",75,0)
|
||
. ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP
|
||
"RTN","GPLRIMA",76,0)
|
||
. ;
|
||
"RTN","GPLRIMA",77,0)
|
||
. S RATTR=$$SETATTR(RIMDFN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS
|
||
"RTN","GPLRIMA",78,0)
|
||
. S @RIMBASE@("ATTR",RIMDFN)=RATTR ; SAVE THE ATRIBUTES FOR THIS PAT
|
||
"RTN","GPLRIMA",79,0)
|
||
. ;
|
||
"RTN","GPLRIMA",80,0)
|
||
. ; INCREMENT THE COUNT OF PATIENTS WITH THESE ATTRIBUTES IN ATTRTBL
|
||
"RTN","GPLRIMA",81,0)
|
||
. ;
|
||
"RTN","GPLRIMA",82,0)
|
||
. ; I '$D(@RIMBASE@("ATTRTBL",RATTR)) D ; IF FIRST PAT WITH THESE ATTRS
|
||
"RTN","GPLRIMA",83,0)
|
||
. ; . S @RIMBASE@("ATTRTBL",RATTR)=0 ; DEFAULT VALUE TO BE INCREMENTED
|
||
"RTN","GPLRIMA",84,0)
|
||
. ; S @RIMBASE@("ATTRTBL",RATTR)=@RIMBASE@("ATTRTBL",RATTR)+1 ; INCREMENT
|
||
"RTN","GPLRIMA",85,0)
|
||
. ;
|
||
"RTN","GPLRIMA",86,0)
|
||
. N CATNAME,CATTBL
|
||
"RTN","GPLRIMA",87,0)
|
||
. ; S CATBASE=$NA(@RIMBASE@("ANALYSIS"))
|
||
"RTN","GPLRIMA",88,0)
|
||
. S CATNAME=""
|
||
"RTN","GPLRIMA",89,0)
|
||
. D CPUSH(.CATNAME,RIMBASE,"RIMTBL",RIMDFN,RATTR) ; ADD TO CATEGORY
|
||
"RTN","GPLRIMA",90,0)
|
||
. W "CATEGORY NAME: ",CATNAME,!
|
||
"RTN","GPLRIMA",91,0)
|
||
. ;
|
||
"RTN","GPLRIMA",92,0)
|
||
. F S RIMDFN=$O(^DPT(RIMDFN)) Q:'$$PTST^CCRSYS(RIMDFN) ; NEXT PATIENT
|
||
"RTN","GPLRIMA",93,0)
|
||
. ; PTST TESTS TO SEE IF PATIENT WAS MERGED
|
||
"RTN","GPLRIMA",94,0)
|
||
. ; IF CCRTEST=0, PTST WILL CHECK TO SEE IF THIS IS A TEST PATIENT
|
||
"RTN","GPLRIMA",95,0)
|
||
. ; AND WE SKIP IT
|
||
"RTN","GPLRIMA",96,0)
|
||
. S @RIMBASE@("RESUME")=RIMDFN ; WHERE WE ARE LEAVING OFF THIS RUN
|
||
"RTN","GPLRIMA",97,0)
|
||
; D PARY^GPLXPATH(@RIMBASE@("ATTRTBL"))
|
||
"RTN","GPLRIMA",98,0)
|
||
Q
|
||
"RTN","GPLRIMA",99,0)
|
||
;
|
||
"RTN","GPLRIMA",100,0)
|
||
SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS
|
||
"RTN","GPLRIMA",101,0)
|
||
N SBASE,SATTR
|
||
"RTN","GPLRIMA",102,0)
|
||
S SBASE=$NA(@RIMBASE@("VARS",SDFN))
|
||
"RTN","GPLRIMA",103,0)
|
||
D APOST("SATTR","RIMTBL","HEADER")
|
||
"RTN","GPLRIMA",104,0)
|
||
I $D(@SBASE@("PROBLEMS",1)) D ;
|
||
"RTN","GPLRIMA",105,0)
|
||
. D APOST("SATTR","RIMTBL","PROBLEMS")
|
||
"RTN","GPLRIMA",106,0)
|
||
. ; W "POSTING PROBLEMS",!
|
||
"RTN","GPLRIMA",107,0)
|
||
I $D(@SBASE@("VITALS",1)) D APOST("SATTR","RIMTBL","VITALS")
|
||
"RTN","GPLRIMA",108,0)
|
||
I $D(@SBASE@("MEDS",1)) D ; IF THE PATIENT HAS MEDS VARIABLES
|
||
"RTN","GPLRIMA",109,0)
|
||
. D APOST("SATTR","RIMTBL","MEDS")
|
||
"RTN","GPLRIMA",110,0)
|
||
. N ZR,ZI
|
||
"RTN","GPLRIMA",111,0)
|
||
. D GETPA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES
|
||
"RTN","GPLRIMA",112,0)
|
||
. I ZR(0)>0 D ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
|
||
"RTN","GPLRIMA",113,0)
|
||
. . F ZI=1:1:ZR(0) D ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
|
||
"RTN","GPLRIMA",114,0)
|
||
. . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","RIMTBL","MEDSCODE") ;CODES
|
||
"RTN","GPLRIMA",115,0)
|
||
. ; D PATD^GPLRIMA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES
|
||
"RTN","GPLRIMA",116,0)
|
||
I $D(@SBASE@("ALERTS",1)) D ; IF THE PATIENT HAS ALERTS
|
||
"RTN","GPLRIMA",117,0)
|
||
. D APOST("SATTR","RIMTBL","ALERTS")
|
||
"RTN","GPLRIMA",118,0)
|
||
. N ZR,ZI
|
||
"RTN","GPLRIMA",119,0)
|
||
. D GETPA(.ZR,SDFN,"ALERTS","ALERTAGENTPRODUCTCODEVALUE") ;REACTANT CODES
|
||
"RTN","GPLRIMA",120,0)
|
||
. I ZR(0)>0 D ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
|
||
"RTN","GPLRIMA",121,0)
|
||
. . F ZI=1:1:ZR(0) D ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
|
||
"RTN","GPLRIMA",122,0)
|
||
. . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","RIMTBL","ALERTSCODE") ;CODES
|
||
"RTN","GPLRIMA",123,0)
|
||
I $D(@SBASE@("RESULTS",1)) D ; IF THE PATIENT HAS LABS VARIABLES
|
||
"RTN","GPLRIMA",124,0)
|
||
. D APOST("SATTR","RIMTBL","RESULTS")
|
||
"RTN","GPLRIMA",125,0)
|
||
. N ZR,ZI
|
||
"RTN","GPLRIMA",126,0)
|
||
. S ZR(0)=0 ; INITIALIZE TO NONE
|
||
"RTN","GPLRIMA",127,0)
|
||
. D RPCGV(.ZR,SDFN,"RESULTS") ;CHECK FOR LABS CODES
|
||
"RTN","GPLRIMA",128,0)
|
||
. ; D PARY^GPLXPATH("ZR") ;
|
||
"RTN","GPLRIMA",129,0)
|
||
. I ZR(0)>0 D ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
|
||
"RTN","GPLRIMA",130,0)
|
||
. . F ZI=1:1:ZR(0) D ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
|
||
"RTN","GPLRIMA",131,0)
|
||
. . . I $P(ZR(ZI),"^",2)="RESULTTESTCODINGSYSTEM" D ; LOINC CODE CHECK
|
||
"RTN","GPLRIMA",132,0)
|
||
. . . . I $P(ZR(ZI),"^",3)="LOINC" D APOST("SATTR","RIMTBL","RESULTSLN") ;
|
||
"RTN","GPLRIMA",133,0)
|
||
; D APOST("SATTR","RIMTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
|
||
"RTN","GPLRIMA",134,0)
|
||
W "ATTRIBUTES: ",SATTR,!
|
||
"RTN","GPLRIMA",135,0)
|
||
Q SATTR
|
||
"RTN","GPLRIMA",136,0)
|
||
;
|
||
"RTN","GPLRIMA",137,0)
|
||
RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL RIM TMP VALUES
|
||
"RTN","GPLRIMA",138,0)
|
||
K ^TMP("GPLRIM","RESUME")
|
||
"RTN","GPLRIMA",139,0)
|
||
K ^TMP("GPLRIM")
|
||
"RTN","GPLRIMA",140,0)
|
||
Q
|
||
"RTN","GPLRIMA",141,0)
|
||
;
|
||
"RTN","GPLRIMA",142,0)
|
||
CLIST ; LIST THE CATEGORIES
|
||
"RTN","GPLRIMA",143,0)
|
||
;
|
||
"RTN","GPLRIMA",144,0)
|
||
I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
|
||
"RTN","GPLRIMA",145,0)
|
||
N CLBASE,CLNUM,ZI,CLIDX
|
||
"RTN","GPLRIMA",146,0)
|
||
S CLBASE=$NA(@RIMBASE@("RIMTBL","CATS"))
|
||
"RTN","GPLRIMA",147,0)
|
||
S CLNUM=@CLBASE@(0)
|
||
"RTN","GPLRIMA",148,0)
|
||
F ZI=1:1:CLNUM D ; LOOP THROUGH THE CATEGORIES
|
||
"RTN","GPLRIMA",149,0)
|
||
. S CLIDX=@CLBASE@(ZI)
|
||
"RTN","GPLRIMA",150,0)
|
||
. W "(",$P(@CLBASE@(CLIDX),"^",1)
|
||
"RTN","GPLRIMA",151,0)
|
||
. W ":",$P(@CLBASE@(CLIDX),"^",2),") "
|
||
"RTN","GPLRIMA",152,0)
|
||
. W CLIDX,!
|
||
"RTN","GPLRIMA",153,0)
|
||
; D PARY^GPLXPATH(CLBASE)
|
||
"RTN","GPLRIMA",154,0)
|
||
Q
|
||
"RTN","GPLRIMA",155,0)
|
||
;
|
||
"RTN","GPLRIMA",156,0)
|
||
CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES
|
||
"RTN","GPLRIMA",157,0)
|
||
; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT
|
||
"RTN","GPLRIMA",158,0)
|
||
; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE
|
||
"RTN","GPLRIMA",159,0)
|
||
; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME
|
||
"RTN","GPLRIMA",160,0)
|
||
; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES,
|
||
"RTN","GPLRIMA",161,0)
|
||
; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X"
|
||
"RTN","GPLRIMA",162,0)
|
||
; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES
|
||
"RTN","GPLRIMA",163,0)
|
||
; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY
|
||
"RTN","GPLRIMA",164,0)
|
||
; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING
|
||
"RTN","GPLRIMA",165,0)
|
||
; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY
|
||
"RTN","GPLRIMA",166,0)
|
||
; NUMBER IE CTBL_X(CDFN)=""
|
||
"RTN","GPLRIMA",167,0)
|
||
;
|
||
"RTN","GPLRIMA",168,0)
|
||
; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST
|
||
"RTN","GPLRIMA",169,0)
|
||
S CCTBL=$NA(@CBASE@(CTBL,"CATS"))
|
||
"RTN","GPLRIMA",170,0)
|
||
W "CBASE: ",CCTBL,!
|
||
"RTN","GPLRIMA",171,0)
|
||
;
|
||
"RTN","GPLRIMA",172,0)
|
||
I '$D(@CCTBL@(CATTR)) D ; FIRST PATIENT IN THIS CATEGORY
|
||
"RTN","GPLRIMA",173,0)
|
||
. D PUSH^GPLXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY
|
||
"RTN","GPLRIMA",174,0)
|
||
. S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY
|
||
"RTN","GPLRIMA",175,0)
|
||
. S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT
|
||
"RTN","GPLRIMA",176,0)
|
||
. S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY
|
||
"RTN","GPLRIMA",177,0)
|
||
. ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME
|
||
"RTN","GPLRIMA",178,0)
|
||
. ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0
|
||
"RTN","GPLRIMA",179,0)
|
||
;
|
||
"RTN","GPLRIMA",180,0)
|
||
S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY
|
||
"RTN","GPLRIMA",181,0)
|
||
S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT
|
||
"RTN","GPLRIMA",182,0)
|
||
S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK
|
||
"RTN","GPLRIMA",183,0)
|
||
;
|
||
"RTN","GPLRIMA",184,0)
|
||
S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED
|
||
"RTN","GPLRIMA",185,0)
|
||
;
|
||
"RTN","GPLRIMA",186,0)
|
||
S CPATLIST=$NA(@CBASE@(CTBL,"PATS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT
|
||
"RTN","GPLRIMA",187,0)
|
||
W "PATS BASE: ",CPATLIST,!
|
||
"RTN","GPLRIMA",188,0)
|
||
S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST
|
||
"RTN","GPLRIMA",189,0)
|
||
;
|
||
"RTN","GPLRIMA",190,0)
|
||
Q
|
||
"RTN","GPLRIMA",191,0)
|
||
;
|
||
"RTN","GPLRIMA",192,0)
|
||
CCOUNT ; RECOUNT THE CATEGORIES.. USE IN CASE OF RESTART OF ANALYZE
|
||
"RTN","GPLRIMA",193,0)
|
||
;
|
||
"RTN","GPLRIMA",194,0)
|
||
I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
|
||
"RTN","GPLRIMA",195,0)
|
||
N ZI,ZJ,ZCNT,ZIDX,ZCAT,ZATR,ZTOT
|
||
"RTN","GPLRIMA",196,0)
|
||
S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
|
||
"RTN","GPLRIMA",197,0)
|
||
S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
|
||
"RTN","GPLRIMA",198,0)
|
||
S ZTOT=0 ; INITIALIZE OVERALL TOTAL
|
||
"RTN","GPLRIMA",199,0)
|
||
F ZI=1:1:@ZCBASE@(0) D ; FOR ALL CATS
|
||
"RTN","GPLRIMA",200,0)
|
||
. S ZCNT=0
|
||
"RTN","GPLRIMA",201,0)
|
||
. S ZATR=@ZCBASE@(ZI) ; THE ATTRIBUTE OF THE CATEGORY
|
||
"RTN","GPLRIMA",202,0)
|
||
. S ZCAT=$P(@ZCBASE@(ZATR),"^",1) ; USE IT TO LOOK UP THE CATEGORY NAME
|
||
"RTN","GPLRIMA",203,0)
|
||
. ; S ZIDX=$O(@ZPBASE@(ZCAT,"")) ; FIRST PATIENT IN LIST
|
||
"RTN","GPLRIMA",204,0)
|
||
. ; F ZJ=0:0 D Q:$O(@ZPBASE@(ZCAT,ZIDX))="" ; ALL PATIENTS IN THE LISTS
|
||
"RTN","GPLRIMA",205,0)
|
||
. ; . S ZCNT=ZCNT+1 ; INCREMENT THE COUNT
|
||
"RTN","GPLRIMA",206,0)
|
||
. ; . W ZCAT," DFN:",ZIDX," COUNT:",ZCNT,!
|
||
"RTN","GPLRIMA",207,0)
|
||
. ; . S ZIDX=$O(@ZPBASE@(ZCAT,ZIDX))
|
||
"RTN","GPLRIMA",208,0)
|
||
. S ZCNT=$$CNTLST($NA(@ZPBASE@(ZCAT)))
|
||
"RTN","GPLRIMA",209,0)
|
||
. S $P(@ZCBASE@(ZATR),"^",2)=ZCNT ; UPDATE THE COUNT IN THE CAT RECORD
|
||
"RTN","GPLRIMA",210,0)
|
||
. S ZTOT=ZTOT+ZCNT
|
||
"RTN","GPLRIMA",211,0)
|
||
W "TOTAL: ",ZTOT,!
|
||
"RTN","GPLRIMA",212,0)
|
||
Q
|
||
"RTN","GPLRIMA",213,0)
|
||
;
|
||
"RTN","GPLRIMA",214,0)
|
||
CNTLST(INLST) ; RETURNS THE NUMBER OF ELEMENTS IN THE LIST
|
||
"RTN","GPLRIMA",215,0)
|
||
; INLST IS PASSED BY NAME
|
||
"RTN","GPLRIMA",216,0)
|
||
N ZI,ZDX,ZCOUNT
|
||
"RTN","GPLRIMA",217,0)
|
||
W INLST,!
|
||
"RTN","GPLRIMA",218,0)
|
||
S ZCOUNT=0
|
||
"RTN","GPLRIMA",219,0)
|
||
S ZDX=""
|
||
"RTN","GPLRIMA",220,0)
|
||
F ZI=$O(@INLST@(ZDX)):0 D Q:$O(@INLST@(ZDX))="" ; LOOP UNTIL THE END
|
||
"RTN","GPLRIMA",221,0)
|
||
. S ZCOUNT=ZCOUNT+1
|
||
"RTN","GPLRIMA",222,0)
|
||
. S ZDX=$O(@INLST@(ZDX))
|
||
"RTN","GPLRIMA",223,0)
|
||
. W "ZDX:",ZDX," ZCNT:",ZCOUNT,!
|
||
"RTN","GPLRIMA",224,0)
|
||
Q ZCOUNT
|
||
"RTN","GPLRIMA",225,0)
|
||
;
|
||
"RTN","GPLRIMA",226,0)
|
||
XCPAT(CPATCAT) ; EXPORT TO FILE ALL PATIENTS IN CATEGORY CPATCAT
|
||
"RTN","GPLRIMA",227,0)
|
||
;
|
||
"RTN","GPLRIMA",228,0)
|
||
I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
|
||
"RTN","GPLRIMA",229,0)
|
||
N ZI,ZJ,ZC,ZPATBASE
|
||
"RTN","GPLRIMA",230,0)
|
||
S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
|
||
"RTN","GPLRIMA",231,0)
|
||
S ZI=""
|
||
"RTN","GPLRIMA",232,0)
|
||
F ZJ=0:0 D Q:$O(@ZPATBASE@(ZI))="" ; TIL END
|
||
"RTN","GPLRIMA",233,0)
|
||
. S ZI=$O(@ZPATBASE@(ZI))
|
||
"RTN","GPLRIMA",234,0)
|
||
. D XPAT^GPLCCR(ZI,"","") ; EXPORT THE PATIENT TO A FILE
|
||
"RTN","GPLRIMA",235,0)
|
||
Q
|
||
"RTN","GPLRIMA",236,0)
|
||
;
|
||
"RTN","GPLRIMA",237,0)
|
||
CPAT(CPATCAT) ; SHOW PATIENT DFNS FOR A CATEGORY CPATCAT
|
||
"RTN","GPLRIMA",238,0)
|
||
;
|
||
"RTN","GPLRIMA",239,0)
|
||
I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
|
||
"RTN","GPLRIMA",240,0)
|
||
N ZI,ZJ,ZC,ZPATBASE
|
||
"RTN","GPLRIMA",241,0)
|
||
S ZC=0 ; COUNT FOR SPACING THE PRINTOUT
|
||
"RTN","GPLRIMA",242,0)
|
||
S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
|
||
"RTN","GPLRIMA",243,0)
|
||
S ZI=""
|
||
"RTN","GPLRIMA",244,0)
|
||
F ZJ=0:0 D Q:$O(@ZPATBASE@(ZI))="" ; TIL END
|
||
"RTN","GPLRIMA",245,0)
|
||
. S ZI=$O(@ZPATBASE@(ZI))
|
||
"RTN","GPLRIMA",246,0)
|
||
. S ZC=ZC+1 ; INCREMENT OUTPUT PER LINE COUNT
|
||
"RTN","GPLRIMA",247,0)
|
||
. W ZI," "
|
||
"RTN","GPLRIMA",248,0)
|
||
. I ZC=10 D ; NEW LINE
|
||
"RTN","GPLRIMA",249,0)
|
||
. . S ZC=0
|
||
"RTN","GPLRIMA",250,0)
|
||
. . W !
|
||
"RTN","GPLRIMA",251,0)
|
||
Q
|
||
"RTN","GPLRIMA",252,0)
|
||
;
|
||
"RTN","GPLRIMA",253,0)
|
||
PATC(DFN) ; DISPLAY THE CATEGORY FOR THIS PATIENT
|
||
"RTN","GPLRIMA",254,0)
|
||
;
|
||
"RTN","GPLRIMA",255,0)
|
||
N ATTR S ATTR=""
|
||
"RTN","GPLRIMA",256,0)
|
||
I '$D(^TMP("GPLRIM","ATTR",DFN)) D ; RIM VARS NOT PRESENT
|
||
"RTN","GPLRIMA",257,0)
|
||
. D ANALYZE(DFN,1) ; EXTRACT THE RIM VARIABLE FOR THIS PATIENT
|
||
"RTN","GPLRIMA",258,0)
|
||
S ATTR=^TMP("GPLRIM","ATTR",DFN)
|
||
"RTN","GPLRIMA",259,0)
|
||
I ATTR="" W "THIS PATIENT NOT ANALYZED.",! Q ;NO ATTRIBUTES FOUND
|
||
"RTN","GPLRIMA",260,0)
|
||
I $D(^TMP("GPLRIM","RIMTBL","CATS",ATTR)) D ; FOUND A CAT
|
||
"RTN","GPLRIMA",261,0)
|
||
. N CAT
|
||
"RTN","GPLRIMA",262,0)
|
||
. S CAT=$P(^TMP("GPLRIM","RIMTBL","CATS",ATTR),U,1) ; LOOK UP THE CAT
|
||
"RTN","GPLRIMA",263,0)
|
||
. W CAT,": ",ATTR,!
|
||
"RTN","GPLRIMA",264,0)
|
||
Q
|
||
"RTN","GPLRIMA",265,0)
|
||
;
|
||
"RTN","GPLRIMA",266,0)
|
||
APUSH(AMAP,AVAL) ; ADD AVAL TO ATTRIBUTE MAP AMAP (AMAP PASSED BY NAME)
|
||
"RTN","GPLRIMA",267,0)
|
||
; AMAP IS FORMED FOR ARRAY ACCESS: AMAP(0) IS THE COUNT
|
||
"RTN","GPLRIMA",268,0)
|
||
; AND AMAP(N)=AVAL IS THE NTH AVAL
|
||
"RTN","GPLRIMA",269,0)
|
||
; ALSO HASH ACCESS AMAP(AVAL)=N WHERE N IS THE ASSIGNED ORDER OF THE
|
||
"RTN","GPLRIMA",270,0)
|
||
; MAP VALUE. INSTANCES OF THE MAP WILL USE $P(X,U,N)=AVAL TO PLACE
|
||
"RTN","GPLRIMA",271,0)
|
||
; THE ATTRIBUTE IN ITS RIGHT PLACE. THE ATTRIBUTE VALUE IS STORED
|
||
"RTN","GPLRIMA",272,0)
|
||
; SO THAT DIFFERENT MAPS CAN BE AUTOMATICALLY CROSSWALKED
|
||
"RTN","GPLRIMA",273,0)
|
||
;
|
||
"RTN","GPLRIMA",274,0)
|
||
I '$D(@AMAP) D ; IF THE MAP DOES NOT EXIST
|
||
"RTN","GPLRIMA",275,0)
|
||
. S @AMAP@(0)=0 ; HAS ZERO ELEMENTS
|
||
"RTN","GPLRIMA",276,0)
|
||
S @AMAP@(0)=@AMAP@(0)+1 ;INCREMENT ELEMENT COUNT
|
||
"RTN","GPLRIMA",277,0)
|
||
S @AMAP@(@AMAP@(0))=AVAL ; ADD THE VALUE TO THE ARRAY
|
||
"RTN","GPLRIMA",278,0)
|
||
S @AMAP@(AVAL)=@AMAP@(0) ; ADD THE VALUE TO THE HASH WITH ARRAY REF
|
||
"RTN","GPLRIMA",279,0)
|
||
Q
|
||
"RTN","GPLRIMA",280,0)
|
||
;
|
||
"RTN","GPLRIMA",281,0)
|
||
ASETUP ; SET UP GLOBALS AND VARS RIMBASE AND RIMTBL
|
||
"RTN","GPLRIMA",282,0)
|
||
I '$D(RIMBASE) S RIMBASE=$NA(^TMP("GPLRIM"))
|
||
"RTN","GPLRIMA",283,0)
|
||
I '$D(@RIMBASE) S @RIMBASE=""
|
||
"RTN","GPLRIMA",284,0)
|
||
I '$D(RIMTBL) S RIMTBL=$NA(^TMP("GPLRIM","RIMTBL","TABLE")) ; ATTR TABLE
|
||
"RTN","GPLRIMA",285,0)
|
||
S ^TMP("GPLRIM","TABLES","RIMTBL")=RIMTBL ; TABLE OF TABLES
|
||
"RTN","GPLRIMA",286,0)
|
||
Q
|
||
"RTN","GPLRIMA",287,0)
|
||
;
|
||
"RTN","GPLRIMA",288,0)
|
||
AINIT ; INITIALIZE ATTRIBUTE TABLE
|
||
"RTN","GPLRIMA",289,0)
|
||
I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
|
||
"RTN","GPLRIMA",290,0)
|
||
K @RIMTBL
|
||
"RTN","GPLRIMA",291,0)
|
||
D APUSH(RIMTBL,"EXTRACTED")
|
||
"RTN","GPLRIMA",292,0)
|
||
D APUSH(RIMTBL,"NOTEXTRACTED")
|
||
"RTN","GPLRIMA",293,0)
|
||
D APUSH(RIMTBL,"HEADER")
|
||
"RTN","GPLRIMA",294,0)
|
||
D APUSH(RIMTBL,"NOPCP")
|
||
"RTN","GPLRIMA",295,0)
|
||
D APUSH(RIMTBL,"PCP")
|
||
"RTN","GPLRIMA",296,0)
|
||
D APUSH(RIMTBL,"PROBLEMS")
|
||
"RTN","GPLRIMA",297,0)
|
||
D APUSH(RIMTBL,"PROBCODE")
|
||
"RTN","GPLRIMA",298,0)
|
||
D APUSH(RIMTBL,"PROBNOCODE")
|
||
"RTN","GPLRIMA",299,0)
|
||
D APUSH(RIMTBL,"PROBDATE")
|
||
"RTN","GPLRIMA",300,0)
|
||
D APUSH(RIMTBL,"PROBNODATE")
|
||
"RTN","GPLRIMA",301,0)
|
||
D APUSH(RIMTBL,"VITALS")
|
||
"RTN","GPLRIMA",302,0)
|
||
D APUSH(RIMTBL,"VITALSCODE")
|
||
"RTN","GPLRIMA",303,0)
|
||
D APUSH(RIMTBL,"VITALSNOCODE")
|
||
"RTN","GPLRIMA",304,0)
|
||
D APUSH(RIMTBL,"VITALSDATE")
|
||
"RTN","GPLRIMA",305,0)
|
||
D APUSH(RIMTBL,"VITALSNODATE")
|
||
"RTN","GPLRIMA",306,0)
|
||
D APUSH(RIMTBL,"MEDS")
|
||
"RTN","GPLRIMA",307,0)
|
||
D APUSH(RIMTBL,"MEDSCODE")
|
||
"RTN","GPLRIMA",308,0)
|
||
D APUSH(RIMTBL,"MEDSNOCODE")
|
||
"RTN","GPLRIMA",309,0)
|
||
D APUSH(RIMTBL,"MEDSDATE")
|
||
"RTN","GPLRIMA",310,0)
|
||
D APUSH(RIMTBL,"MEDSNODATE")
|
||
"RTN","GPLRIMA",311,0)
|
||
D APUSH(RIMTBL,"ALERTS")
|
||
"RTN","GPLRIMA",312,0)
|
||
D APUSH(RIMTBL,"ALERTSCODE")
|
||
"RTN","GPLRIMA",313,0)
|
||
D APUSH(RIMTBL,"RESULTS")
|
||
"RTN","GPLRIMA",314,0)
|
||
D APUSH(RIMTBL,"RESULTSLN")
|
||
"RTN","GPLRIMA",315,0)
|
||
Q
|
||
"RTN","GPLRIMA",316,0)
|
||
;
|
||
"RTN","GPLRIMA",317,0)
|
||
APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL
|
||
"RTN","GPLRIMA",318,0)
|
||
; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING
|
||
"RTN","GPLRIMA",319,0)
|
||
; PTBL IS THE NAME OF A TABLE IN @RIMBASE@("TABLES") - "RIMTBL"=ALL VALUES
|
||
"RTN","GPLRIMA",320,0)
|
||
; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))
|
||
"RTN","GPLRIMA",321,0)
|
||
I '$D(RIMBASE) D ASETUP ; FOR COMMANDLINE PROCESSING
|
||
"RTN","GPLRIMA",322,0)
|
||
N USETBL
|
||
"RTN","GPLRIMA",323,0)
|
||
I '$D(@RIMBASE@("TABLES",PTBL)) D Q ; NO TABLE
|
||
"RTN","GPLRIMA",324,0)
|
||
. W "ERROR NO SUCH TABLE",!
|
||
"RTN","GPLRIMA",325,0)
|
||
S USETBL=@RIMBASE@("TABLES",PTBL)
|
||
"RTN","GPLRIMA",326,0)
|
||
S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL
|
||
"RTN","GPLRIMA",327,0)
|
||
Q
|
||
"RTN","GPLRIMA",328,0)
|
||
GETPA(RTN,DFN,ISEC,IVAR) ; RETURNS ARRAY OF RIM VARIABLES FOR PATIENT DFN
|
||
"RTN","GPLRIMA",329,0)
|
||
; EXAMPLE: D GETPA(.RT,2,"MEDS","MEDSSTATUSTEXT")
|
||
"RTN","GPLRIMA",330,0)
|
||
; RETURNS AN ARRAY RT OF VALUES OF MEDSTATUSTEXT FOR PATIENT 2 IN P2
|
||
"RTN","GPLRIMA",331,0)
|
||
; IN SECTION "MEDS"
|
||
"RTN","GPLRIMA",332,0)
|
||
; P1 IS THE IEN OF THE MED WITH THE VALUE IE 2^PENDING WOULD BE STATUS
|
||
"RTN","GPLRIMA",333,0)
|
||
; PENDING FOR MED 2 FOR PATIENT 2
|
||
"RTN","GPLRIMA",334,0)
|
||
; RT(0) IS THE COUNT OF HOW MANY IN THE ARRAY. NULL VALUES ARE
|
||
"RTN","GPLRIMA",335,0)
|
||
; RETURNED. RTN IS PASSED BY REFERENCE
|
||
"RTN","GPLRIMA",336,0)
|
||
;
|
||
"RTN","GPLRIMA",337,0)
|
||
S RTN(0)=0 ; SET NULL DEFAULT RETURN VALUE
|
||
"RTN","GPLRIMA",338,0)
|
||
I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
|
||
"RTN","GPLRIMA",339,0)
|
||
S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
|
||
"RTN","GPLRIMA",340,0)
|
||
I '$D(@ZVBASE@(DFN,ISEC,0)) D Q ; NO VARIABLES IN SECTION
|
||
"RTN","GPLRIMA",341,0)
|
||
. W "NO VARIABLES IN THIS SECTION FOR PATIENT ",DFN,!
|
||
"RTN","GPLRIMA",342,0)
|
||
N ZZI,ZZS
|
||
"RTN","GPLRIMA",343,0)
|
||
S ZZS=$NA(@ZVBASE@(DFN,ISEC)) ; SECTION VARIABLE ARRAY FOR THIS PATIENT
|
||
"RTN","GPLRIMA",344,0)
|
||
; ZWR @ZZS@(1)
|
||
"RTN","GPLRIMA",345,0)
|
||
S RTN(0)=@ZZS@(0)
|
||
"RTN","GPLRIMA",346,0)
|
||
F ZZI=1:1:RTN(0) D ; FOR ALL PARTS OF THIS SECTION ( IE FOR ALL MEDS)
|
||
"RTN","GPLRIMA",347,0)
|
||
. S $P(RTN(ZZI),"^",1)=ZZI ; INDEX FOR VARIABLE
|
||
"RTN","GPLRIMA",348,0)
|
||
. S $P(RTN(ZZI),"^",2)=@ZZS@(ZZI,IVAR) ; THE VALUE OF THE VARIABLE
|
||
"RTN","GPLRIMA",349,0)
|
||
Q
|
||
"RTN","GPLRIMA",350,0)
|
||
;
|
||
"RTN","GPLRIMA",351,0)
|
||
PATD(DFN,ISEC,IVAR) ; DISPLAY FOR PATIENT DFN THE VARIABLE IVAR
|
||
"RTN","GPLRIMA",352,0)
|
||
;
|
||
"RTN","GPLRIMA",353,0)
|
||
N ZR
|
||
"RTN","GPLRIMA",354,0)
|
||
D GETPA(.ZR,DFN,ISEC,IVAR)
|
||
"RTN","GPLRIMA",355,0)
|
||
I $D(ZR(0)) D PARY^GPLXPATH("ZR")
|
||
"RTN","GPLRIMA",356,0)
|
||
E W "NOTHING RETURNED",!
|
||
"RTN","GPLRIMA",357,0)
|
||
Q
|
||
"RTN","GPLRIMA",358,0)
|
||
;
|
||
"RTN","GPLRIMA",359,0)
|
||
CAGET(RTN,IATTR) ;
|
||
"RTN","GPLRIMA",360,0)
|
||
; GETPA LOOKS AT RIMTBL TO FIND PATIENTS WITH ATTRIBUTE IATTR
|
||
"RTN","GPLRIMA",361,0)
|
||
; IT DOES NOT SEARCH ALL PATIENTS, ONLY THE ONES WITH THE ATTRIBUTE
|
||
"RTN","GPLRIMA",362,0)
|
||
; IT RETURNS AN ARRAY OF THE VALUES OF VARIABLE IVAR IN SECTION ISEC
|
||
"RTN","GPLRIMA",363,0)
|
||
Q
|
||
"RTN","GPLRIMA",364,0)
|
||
;
|
||
"RTN","GPLRIMA",365,0)
|
||
PCLST(LSTRTN,IATTR) ; RETURNS ARRAY OF PATIENTS WITH ATTRIBUTE IATTR
|
||
"RTN","GPLRIMA",366,0)
|
||
;
|
||
"RTN","GPLRIMA",367,0)
|
||
I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
|
||
"RTN","GPLRIMA",368,0)
|
||
N ZLST
|
||
"RTN","GPLRIMA",369,0)
|
||
S LSTRTN(0)=0 ; DEFAULT RETURN NONE
|
||
"RTN","GPLRIMA",370,0)
|
||
S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
|
||
"RTN","GPLRIMA",371,0)
|
||
S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
|
||
"RTN","GPLRIMA",372,0)
|
||
N ZNC ; ZNC IS NUMBER OF CATEGORIES
|
||
"RTN","GPLRIMA",373,0)
|
||
S ZNC=@ZCBASE@(0)
|
||
"RTN","GPLRIMA",374,0)
|
||
I ZNC=0 Q ; NO CATEGORIES TO SEARCH
|
||
"RTN","GPLRIMA",375,0)
|
||
N ZAP ; ZAP IS THE PIECE INDEX OF THE ATTRIBUTE IN THE RIM ATTR TABLE
|
||
"RTN","GPLRIMA",376,0)
|
||
S ZAP=@RIMBASE@("RIMTBL","TABLE",IATTR)
|
||
"RTN","GPLRIMA",377,0)
|
||
N ZI,ZCATTBL,ZATBL,ZCNT,ZPAT
|
||
"RTN","GPLRIMA",378,0)
|
||
F ZI=1:1:ZNC D ; FOR ALL CATEGORIES
|
||
"RTN","GPLRIMA",379,0)
|
||
. S ZATBL=@ZCBASE@(ZI) ; PULL OUT ATTR TBL FOR CAT
|
||
"RTN","GPLRIMA",380,0)
|
||
. I $P(ZATBL,"^",ZAP)'="" D ; CAT HAS ATTR
|
||
"RTN","GPLRIMA",381,0)
|
||
. . S ZCATTBL=$P(@ZCBASE@(ZATBL),"^",1) ; NAME OF TBL
|
||
"RTN","GPLRIMA",382,0)
|
||
. . M LSTRTN=@ZPBASE@(ZCATTBL) ; MERGE PATS FROM CAT
|
||
"RTN","GPLRIMA",383,0)
|
||
S ZCNT=0 ; INITIALIZE COUNT OF PATIENTS
|
||
"RTN","GPLRIMA",384,0)
|
||
S ZPAT=0 ; START AT FIRST PATIENT IN LIST
|
||
"RTN","GPLRIMA",385,0)
|
||
F S ZPAT=$O(LSTRTN(ZPAT)) Q:ZPAT="" D ;
|
||
"RTN","GPLRIMA",386,0)
|
||
. S ZCNT=ZCNT+1
|
||
"RTN","GPLRIMA",387,0)
|
||
S LSTRTN(0)=ZCNT ; COUNT OF PATIENTS IN ARRAY
|
||
"RTN","GPLRIMA",388,0)
|
||
Q
|
||
"RTN","GPLRIMA",389,0)
|
||
;
|
||
"RTN","GPLRIMA",390,0)
|
||
DCPAT(CATTR) ; DISPLAY LIST OF PATIENTS WITH ATTRIBUTE CATTR
|
||
"RTN","GPLRIMA",391,0)
|
||
;
|
||
"RTN","GPLRIMA",392,0)
|
||
N ZR
|
||
"RTN","GPLRIMA",393,0)
|
||
D PCLST(.ZR,CATTR)
|
||
"RTN","GPLRIMA",394,0)
|
||
I ZR(0)=0 D Q ;
|
||
"RTN","GPLRIMA",395,0)
|
||
. W "NO PATIENTS RETURNED",!
|
||
"RTN","GPLRIMA",396,0)
|
||
E D ;
|
||
"RTN","GPLRIMA",397,0)
|
||
. D PARY^GPLXPATH("ZR") ; PRINT ARRAY
|
||
"RTN","GPLRIMA",398,0)
|
||
. W "COUNT=",ZR(0),!
|
||
"RTN","GPLRIMA",399,0)
|
||
Q
|
||
"RTN","GPLRIMA",400,0)
|
||
;
|
||
"RTN","GPLRIMA",401,0)
|
||
RPCGV(RTN,DFN,WHICH) ; RPC GET VARS
|
||
"RTN","GPLRIMA",402,0)
|
||
; RETURNS IN RTN (PASSED BY REFERENCE) THE VARS AND VALUES
|
||
"RTN","GPLRIMA",403,0)
|
||
; FOUND AT INARY RTN(X)="VAR^VALUE" RTN(0) IS THE COUNT
|
||
"RTN","GPLRIMA",404,0)
|
||
; DFN IS THE PATIENT NUMBER.
|
||
"RTN","GPLRIMA",405,0)
|
||
; WHICH IS "ALL","MEDS","VITALS","PROBLEMS","ALERTS","RESULTS"
|
||
"RTN","GPLRIMA",406,0)
|
||
; OR OTHER SECTIONS AS THEY ARE ADDED
|
||
"RTN","GPLRIMA",407,0)
|
||
; THIS IS MEANT TO BE AVAILABLE AS AN RPC
|
||
"RTN","GPLRIMA",408,0)
|
||
I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
|
||
"RTN","GPLRIMA",409,0)
|
||
S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
|
||
"RTN","GPLRIMA",410,0)
|
||
S RTN(0)=0 ; DEFAULT NOTHING IS RETURNED
|
||
"RTN","GPLRIMA",411,0)
|
||
N ZZGI
|
||
"RTN","GPLRIMA",412,0)
|
||
I WHICH="ALL" D ; VARIABLES FROM ALL SECTIONS
|
||
"RTN","GPLRIMA",413,0)
|
||
. F ZZGI="PROBLEMS","VITALS","MEDS","ALERTS","RESULTS" D ; EACH SECTION
|
||
"RTN","GPLRIMA",414,0)
|
||
. . D ZGVWRK(ZZGI) ; DO EACH SECTION
|
||
"RTN","GPLRIMA",415,0)
|
||
E D ZGVWRK(WHICH) ; ONLY ONE SECTION ASKED FOR
|
||
"RTN","GPLRIMA",416,0)
|
||
Q
|
||
"RTN","GPLRIMA",417,0)
|
||
;
|
||
"RTN","GPLRIMA",418,0)
|
||
ZGVWRK(ZWHICH) ; DO ONE SECTION FOR RPCGV
|
||
"RTN","GPLRIMA",419,0)
|
||
;
|
||
"RTN","GPLRIMA",420,0)
|
||
N ZZGN ; NAME FOR SECTION VARIABLES
|
||
"RTN","GPLRIMA",421,0)
|
||
S ZZGN=$NA(@ZVBASE@(DFN,ZWHICH)) ; BASE OF VARS FOR SECTION
|
||
"RTN","GPLRIMA",422,0)
|
||
I '$D(@ZZGN@(0)) Q ; NO VARS FOR THIS SECTION
|
||
"RTN","GPLRIMA",423,0)
|
||
E D ; VARS EXIST
|
||
"RTN","GPLRIMA",424,0)
|
||
. N ZGVI
|
||
"RTN","GPLRIMA",425,0)
|
||
. F ZGVI=1:1:@ZZGN@(0) D ; FOR EACH MULTIPLE IN SECTION
|
||
"RTN","GPLRIMA",426,0)
|
||
. . K ZZGA N ZZGA ; TEMP ARRAY FOR SECTION VARS
|
||
"RTN","GPLRIMA",427,0)
|
||
. . K ZZGN2 N ZZGN2 ; NAME FOR MULTIPLE
|
||
"RTN","GPLRIMA",428,0)
|
||
. . S ZZGN2=$NA(@ZZGN@(ZGVI))
|
||
"RTN","GPLRIMA",429,0)
|
||
. . ; W ZZGN2,!,$O(@ZZGN2@("")),!
|
||
"RTN","GPLRIMA",430,0)
|
||
. . D H2ARY^GPLXPATH("ZZGA",ZZGN2,ZGVI) ; CONVERT HASH TO ARRAY
|
||
"RTN","GPLRIMA",431,0)
|
||
. . ; D PARY^GPLXPATH("ZZGA")
|
||
"RTN","GPLRIMA",432,0)
|
||
. . D PUSHA^GPLXPATH("RTN","ZZGA") ; PUSH ARRAY INTO RETURN
|
||
"RTN","GPLRIMA",433,0)
|
||
Q
|
||
"RTN","GPLRIMA",434,0)
|
||
;
|
||
"RTN","GPLRIMA",435,0)
|
||
DPATV(DFN,IWHICH) ; DISPLAY VARS FOR PATIENT DFN THAT ARE MAINTAINED IN GPLRIM
|
||
"RTN","GPLRIMA",436,0)
|
||
; ALONG WITH SAMPLE VALUES.
|
||
"RTN","GPLRIMA",437,0)
|
||
; IWHICH IS "ALL","MEDS","VITALS","PROBLEMS","ALERTS","RESULTS"
|
||
"RTN","GPLRIMA",438,0)
|
||
N GTMP
|
||
"RTN","GPLRIMA",439,0)
|
||
I '$D(^TMP("GPLRIM","ATTR",DFN)) D ; RIM VARS NOT PRESENT
|
||
"RTN","GPLRIMA",440,0)
|
||
. D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES
|
||
"RTN","GPLRIMA",441,0)
|
||
I '$D(IWHICH) S IWHICH="ALL"
|
||
"RTN","GPLRIMA",442,0)
|
||
D RPCGV(.GTMP,DFN,IWHICH)
|
||
"RTN","GPLRIMA",443,0)
|
||
D PARY^GPLXPATH("GTMP")
|
||
"RTN","GPLRIMA",444,0)
|
||
Q
|
||
"RTN","GPLRIMA",445,0)
|
||
;
|
||
"RTN","GPLUNIT")
|
||
0^12^B31452964
|
||
"RTN","GPLUNIT",1,0)
|
||
GPLUNIT ; CCDCCR/GPL - Unit Testing Library; 5/07/08
|
||
"RTN","GPLUNIT",2,0)
|
||
;;0.1;CCDCCR;nopatch;noreleasedate;Build 15
|
||
"RTN","GPLUNIT",3,0)
|
||
;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
||
"RTN","GPLUNIT",4,0)
|
||
;General Public License See attached copy of the License.
|
||
"RTN","GPLUNIT",5,0)
|
||
;
|
||
"RTN","GPLUNIT",6,0)
|
||
;This program is free software; you can redistribute it and/or modify
|
||
"RTN","GPLUNIT",7,0)
|
||
;it under the terms of the GNU General Public License as published by
|
||
"RTN","GPLUNIT",8,0)
|
||
;the Free Software Foundation; either version 2 of the License, or
|
||
"RTN","GPLUNIT",9,0)
|
||
;(at your option) any later version.
|
||
"RTN","GPLUNIT",10,0)
|
||
;
|
||
"RTN","GPLUNIT",11,0)
|
||
;This program is distributed in the hope that it will be useful,
|
||
"RTN","GPLUNIT",12,0)
|
||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
"RTN","GPLUNIT",13,0)
|
||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
"RTN","GPLUNIT",14,0)
|
||
;GNU General Public License for more details.
|
||
"RTN","GPLUNIT",15,0)
|
||
;
|
||
"RTN","GPLUNIT",16,0)
|
||
;You should have received a copy of the GNU General Public License along
|
||
"RTN","GPLUNIT",17,0)
|
||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
||
"RTN","GPLUNIT",18,0)
|
||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
||
"RTN","GPLUNIT",19,0)
|
||
;
|
||
"RTN","GPLUNIT",20,0)
|
||
W "This is a unit testing library",!
|
||
"RTN","GPLUNIT",21,0)
|
||
W !
|
||
"RTN","GPLUNIT",22,0)
|
||
Q
|
||
"RTN","GPLUNIT",23,0)
|
||
;
|
||
"RTN","GPLUNIT",24,0)
|
||
ZT(ZARY,BAT,TST) ; private routine to add a test case to the ZARY array
|
||
"RTN","GPLUNIT",25,0)
|
||
; ZARY IS PASSED BY REFERENCE
|
||
"RTN","GPLUNIT",26,0)
|
||
; BAT is a string identifying the test battery
|
||
"RTN","GPLUNIT",27,0)
|
||
; TST is a test which will evaluate to true or false
|
||
"RTN","GPLUNIT",28,0)
|
||
; I '$G(ZARY) D
|
||
"RTN","GPLUNIT",29,0)
|
||
; . S ZARY(0)=0 ; initially there are no elements
|
||
"RTN","GPLUNIT",30,0)
|
||
; W "GOT HERE LOADING "_TST,!
|
||
"RTN","GPLUNIT",31,0)
|
||
N CNT ; count of array elements
|
||
"RTN","GPLUNIT",32,0)
|
||
S CNT=ZARY(0) ; contains array count
|
||
"RTN","GPLUNIT",33,0)
|
||
S CNT=CNT+1 ; increment count
|
||
"RTN","GPLUNIT",34,0)
|
||
S ZARY(CNT)=TST ; put the test in the array
|
||
"RTN","GPLUNIT",35,0)
|
||
I $D(ZARY(BAT)) D ; NOT THE FIRST TEST IN BATTERY
|
||
"RTN","GPLUNIT",36,0)
|
||
. N II,TN ; TEMP FOR ENDING TEST IN BATTERY
|
||
"RTN","GPLUNIT",37,0)
|
||
. S II=$P(ZARY(BAT),"^",2)
|
||
"RTN","GPLUNIT",38,0)
|
||
. S $P(ZARY(BAT),"^",2)=II+1
|
||
"RTN","GPLUNIT",39,0)
|
||
I '$D(ZARY(BAT)) D ; FIRST TEST IN THIS BATTERY
|
||
"RTN","GPLUNIT",40,0)
|
||
. S ZARY(BAT)=CNT_"^"_CNT ; FIRST AND LAST TESTS IN BATTERY
|
||
"RTN","GPLUNIT",41,0)
|
||
. S ZARY("TESTS",BAT)="" ; PUT THE BATTERY IN THE TESTS INDEX
|
||
"RTN","GPLUNIT",42,0)
|
||
. ; S TN=$NA(ZARY("TESTS"))
|
||
"RTN","GPLUNIT",43,0)
|
||
. ; D PUSH^GPLXPATH(TN,BAT)
|
||
"RTN","GPLUNIT",44,0)
|
||
S ZARY(0)=CNT ; update the array counter
|
||
"RTN","GPLUNIT",45,0)
|
||
Q
|
||
"RTN","GPLUNIT",46,0)
|
||
;
|
||
"RTN","GPLUNIT",47,0)
|
||
ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference
|
||
"RTN","GPLUNIT",48,0)
|
||
; ZARY IS PASSED BY NAME
|
||
"RTN","GPLUNIT",49,0)
|
||
; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
|
||
"RTN","GPLUNIT",50,0)
|
||
; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
|
||
"RTN","GPLUNIT",51,0)
|
||
K @ZARY
|
||
"RTN","GPLUNIT",52,0)
|
||
S @ZARY@(0)=0 ; initialize array count
|
||
"RTN","GPLUNIT",53,0)
|
||
N LINE,LABEL,BODY
|
||
"RTN","GPLUNIT",54,0)
|
||
N INTEST S INTEST=0 ; switch for in the test case section
|
||
"RTN","GPLUNIT",55,0)
|
||
N SECTION S SECTION="[anonymous]" ; test case section
|
||
"RTN","GPLUNIT",56,0)
|
||
;
|
||
"RTN","GPLUNIT",57,0)
|
||
N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D
|
||
"RTN","GPLUNIT",58,0)
|
||
. I LINE?." "1";;><TEST>".E S INTEST=1 ; entering test section
|
||
"RTN","GPLUNIT",59,0)
|
||
. I LINE?." "1";;><TEMPLATE>".E S INTEST=1 ; entering TEMPLATE section
|
||
"RTN","GPLUNIT",60,0)
|
||
. I LINE?." "1";;></TEST>".E S INTEST=0 ; leaving test section
|
||
"RTN","GPLUNIT",61,0)
|
||
. I LINE?." "1";;></TEMPLATE>".E S INTEST=0 ; leaving TEMPLATE section
|
||
"RTN","GPLUNIT",62,0)
|
||
. I INTEST D ; within the testing section
|
||
"RTN","GPLUNIT",63,0)
|
||
. . I LINE?." "1";;><".E D ; section name found
|
||
"RTN","GPLUNIT",64,0)
|
||
. . . S SECTION=$P($P(LINE,";;><",2),">",1) ; pull out name
|
||
"RTN","GPLUNIT",65,0)
|
||
. . I LINE?." "1";;>>".E D ; test case found
|
||
"RTN","GPLUNIT",66,0)
|
||
. . . D ZT(.@ZARY,SECTION,$P(LINE,";;>>",2)) ; put the test in the array
|
||
"RTN","GPLUNIT",67,0)
|
||
S @ZARY@("ALL")="1"_"^"_@ZARY@(0) ; MAKE A BATTERY FOR ALL
|
||
"RTN","GPLUNIT",68,0)
|
||
Q
|
||
"RTN","GPLUNIT",69,0)
|
||
;
|
||
"RTN","GPLUNIT",70,0)
|
||
ZTEST(ZARY,WHICH) ; try out the tests using a passed array ZTEST
|
||
"RTN","GPLUNIT",71,0)
|
||
N ZI,ZX,ZR,ZP
|
||
"RTN","GPLUNIT",72,0)
|
||
S DEBUG=0
|
||
"RTN","GPLUNIT",73,0)
|
||
; I WHICH="ALL" D Q ; RUN ALL THE TESTS
|
||
"RTN","GPLUNIT",74,0)
|
||
; . W "DOING ALL",!
|
||
"RTN","GPLUNIT",75,0)
|
||
; . N J,NT
|
||
"RTN","GPLUNIT",76,0)
|
||
; . S NT=$NA(ZARY("TESTS"))
|
||
"RTN","GPLUNIT",77,0)
|
||
; . W NT,@NT@(0),!
|
||
"RTN","GPLUNIT",78,0)
|
||
; . F J=1:1:@NT@(0) D ;
|
||
"RTN","GPLUNIT",79,0)
|
||
; . . W @NT@(J),!
|
||
"RTN","GPLUNIT",80,0)
|
||
; . . D ZTEST^GPLUNIT(@ZARY,@NT@(J))
|
||
"RTN","GPLUNIT",81,0)
|
||
I '$D(ZARY(WHICH)) D Q ; TEST SECTION DOESN'T EXIST
|
||
"RTN","GPLUNIT",82,0)
|
||
. W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,!
|
||
"RTN","GPLUNIT",83,0)
|
||
N FIRST,LAST
|
||
"RTN","GPLUNIT",84,0)
|
||
S FIRST=$P(ZARY(WHICH),"^",1)
|
||
"RTN","GPLUNIT",85,0)
|
||
S LAST=$P(ZARY(WHICH),"^",2)
|
||
"RTN","GPLUNIT",86,0)
|
||
F ZI=FIRST:1:LAST D
|
||
"RTN","GPLUNIT",87,0)
|
||
. I ZARY(ZI)?1">"1.E D ; NOT A TEST, JUST RUN THE STATEMENT
|
||
"RTN","GPLUNIT",88,0)
|
||
. . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
|
||
"RTN","GPLUNIT",89,0)
|
||
. . ; W ZP,!
|
||
"RTN","GPLUNIT",90,0)
|
||
. . S ZX=ZP
|
||
"RTN","GPLUNIT",91,0)
|
||
. . W "RUNNING: "_ZP
|
||
"RTN","GPLUNIT",92,0)
|
||
. . X ZX
|
||
"RTN","GPLUNIT",93,0)
|
||
. . W "..SUCCESS: ",WHICH,!
|
||
"RTN","GPLUNIT",94,0)
|
||
. I ZARY(ZI)?1"?"1.E D ; THIS IS A TEST
|
||
"RTN","GPLUNIT",95,0)
|
||
. . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
|
||
"RTN","GPLUNIT",96,0)
|
||
. . S ZX="S ZR="_ZP
|
||
"RTN","GPLUNIT",97,0)
|
||
. . W "TRYING: "_ZP
|
||
"RTN","GPLUNIT",98,0)
|
||
. . X ZX
|
||
"RTN","GPLUNIT",99,0)
|
||
. . W $S(ZR=1:"..PASSED ",1:"..FAILED "),!
|
||
"RTN","GPLUNIT",100,0)
|
||
. . I '$D(TPASSED) D ; NOT INITIALIZED YET
|
||
"RTN","GPLUNIT",101,0)
|
||
. . . S TPASSED=0 S TFAILED=0
|
||
"RTN","GPLUNIT",102,0)
|
||
. . I ZR S TPASSED=TPASSED+1
|
||
"RTN","GPLUNIT",103,0)
|
||
. . I 'ZR S TFAILED=TFAILED+1
|
||
"RTN","GPLUNIT",104,0)
|
||
Q
|
||
"RTN","GPLUNIT",105,0)
|
||
;
|
||
"RTN","GPLUNIT",106,0)
|
||
TEST ; RUN ALL THE TEST CASES
|
||
"RTN","GPLUNIT",107,0)
|
||
N ZTMP
|
||
"RTN","GPLUNIT",108,0)
|
||
D ZLOAD(.ZTMP)
|
||
"RTN","GPLUNIT",109,0)
|
||
D ZTEST(.ZTMP,"ALL")
|
||
"RTN","GPLUNIT",110,0)
|
||
W "PASSED: ",TPASSED,!
|
||
"RTN","GPLUNIT",111,0)
|
||
W "FAILED: ",TFAILED,!
|
||
"RTN","GPLUNIT",112,0)
|
||
W !
|
||
"RTN","GPLUNIT",113,0)
|
||
W "THE TESTS!",!
|
||
"RTN","GPLUNIT",114,0)
|
||
; I DEBUG ZWR ZTMP
|
||
"RTN","GPLUNIT",115,0)
|
||
Q
|
||
"RTN","GPLUNIT",116,0)
|
||
;
|
||
"RTN","GPLUNIT",117,0)
|
||
GTSTS(GTZARY,RTN) ; return an array of test names
|
||
"RTN","GPLUNIT",118,0)
|
||
N I,J S I="" S I=$O(GTZARY("TESTS",I))
|
||
"RTN","GPLUNIT",119,0)
|
||
F J=0:0 Q:I="" D
|
||
"RTN","GPLUNIT",120,0)
|
||
. D PUSH^GPLXPATH(RTN,I)
|
||
"RTN","GPLUNIT",121,0)
|
||
. S I=$O(GTZARY("TESTS",I))
|
||
"RTN","GPLUNIT",122,0)
|
||
Q
|
||
"RTN","GPLUNIT",123,0)
|
||
;
|
||
"RTN","GPLUNIT",124,0)
|
||
TESTALL(RNM) ; RUN ALL THE TESTS
|
||
"RTN","GPLUNIT",125,0)
|
||
N ZI,J,TZTMP,TSTS,TOTP,TOTF
|
||
"RTN","GPLUNIT",126,0)
|
||
S TOTP=0 S TOTF=0
|
||
"RTN","GPLUNIT",127,0)
|
||
D ZLOAD^GPLUNIT("TZTMP",RNM)
|
||
"RTN","GPLUNIT",128,0)
|
||
D GTSTS(.TZTMP,"TSTS")
|
||
"RTN","GPLUNIT",129,0)
|
||
F ZI=1:1:TSTS(0) D ;
|
||
"RTN","GPLUNIT",130,0)
|
||
. S TPASSED=0 S TFAILED=0
|
||
"RTN","GPLUNIT",131,0)
|
||
. D ZTEST^GPLUNIT(.TZTMP,TSTS(ZI))
|
||
"RTN","GPLUNIT",132,0)
|
||
. S TOTP=TOTP+TPASSED
|
||
"RTN","GPLUNIT",133,0)
|
||
. S TOTF=TOTF+TFAILED
|
||
"RTN","GPLUNIT",134,0)
|
||
. S $P(TSTS(ZI),"^",2)=TPASSED
|
||
"RTN","GPLUNIT",135,0)
|
||
. S $P(TSTS(ZI),"^",3)=TFAILED
|
||
"RTN","GPLUNIT",136,0)
|
||
F ZI=1:1:TSTS(0) D ;
|
||
"RTN","GPLUNIT",137,0)
|
||
. W "TEST=> ",$P(TSTS(ZI),"^",1)
|
||
"RTN","GPLUNIT",138,0)
|
||
. W " PASSED=>",$P(TSTS(ZI),"^",2)
|
||
"RTN","GPLUNIT",139,0)
|
||
. W " FAILED=>",$P(TSTS(ZI),"^",3),!
|
||
"RTN","GPLUNIT",140,0)
|
||
W "TOTAL=> PASSED:",TOTP," FAILED:",TOTF,!
|
||
"RTN","GPLUNIT",141,0)
|
||
Q
|
||
"RTN","GPLUNIT",142,0)
|
||
;
|
||
"RTN","GPLUNIT",143,0)
|
||
TLIST(ZARY) ; LIST ALL THE TESTS
|
||
"RTN","GPLUNIT",144,0)
|
||
; THEY ARE MARKED AS ;;><TESTNAME> IN THE TEST CASES
|
||
"RTN","GPLUNIT",145,0)
|
||
; ZARY IS PASSED BY REFERENCE
|
||
"RTN","GPLUNIT",146,0)
|
||
N I,J,K S I="" S I=$O(ZARY("TESTS",I))
|
||
"RTN","GPLUNIT",147,0)
|
||
S K=1
|
||
"RTN","GPLUNIT",148,0)
|
||
F J=0:0 Q:I="" D
|
||
"RTN","GPLUNIT",149,0)
|
||
. ; W "I IS NOW=",I,!
|
||
"RTN","GPLUNIT",150,0)
|
||
. W I," "
|
||
"RTN","GPLUNIT",151,0)
|
||
. S I=$O(ZARY("TESTS",I))
|
||
"RTN","GPLUNIT",152,0)
|
||
. S K=K+1 I K=6 D
|
||
"RTN","GPLUNIT",153,0)
|
||
. . W !
|
||
"RTN","GPLUNIT",154,0)
|
||
. . S K=1
|
||
"RTN","GPLUNIT",155,0)
|
||
Q
|
||
"RTN","GPLUNIT",156,0)
|
||
;
|
||
"RTN","GPLVITAL")
|
||
0^17^B82628966
|
||
"RTN","GPLVITAL",1,0)
|
||
GPLVITAL ; CCDCCR/CJE - CCR/CCD PROCESSING FOR VITALS ; 07/16/08
|
||
"RTN","GPLVITAL",2,0)
|
||
;;0.1;CCDCCR;;JUL 16,2008;Build 15
|
||
"RTN","GPLVITAL",3,0)
|
||
;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
||
"RTN","GPLVITAL",4,0)
|
||
;General Public License See attached copy of the License.
|
||
"RTN","GPLVITAL",5,0)
|
||
;
|
||
"RTN","GPLVITAL",6,0)
|
||
;This program is free software; you can redistribute it and/or modify
|
||
"RTN","GPLVITAL",7,0)
|
||
;it under the terms of the GNU General Public License as published by
|
||
"RTN","GPLVITAL",8,0)
|
||
;the Free Software Foundation; either version 2 of the License, or
|
||
"RTN","GPLVITAL",9,0)
|
||
;(at your option) any later version.
|
||
"RTN","GPLVITAL",10,0)
|
||
;
|
||
"RTN","GPLVITAL",11,0)
|
||
;This program is distributed in the hope that it will be useful,
|
||
"RTN","GPLVITAL",12,0)
|
||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
"RTN","GPLVITAL",13,0)
|
||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
"RTN","GPLVITAL",14,0)
|
||
;GNU General Public License for more details.
|
||
"RTN","GPLVITAL",15,0)
|
||
;
|
||
"RTN","GPLVITAL",16,0)
|
||
;You should have received a copy of the GNU General Public License along
|
||
"RTN","GPLVITAL",17,0)
|
||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
||
"RTN","GPLVITAL",18,0)
|
||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
||
"RTN","GPLVITAL",19,0)
|
||
;
|
||
"RTN","GPLVITAL",20,0)
|
||
W "NO ENTRY FROM TOP",!
|
||
"RTN","GPLVITAL",21,0)
|
||
Q
|
||
"RTN","GPLVITAL",22,0)
|
||
;
|
||
"RTN","GPLVITAL",23,0)
|
||
EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT VITALS INTO PROVIDED XML TEMPLATE
|
||
"RTN","GPLVITAL",24,0)
|
||
;
|
||
"RTN","GPLVITAL",25,0)
|
||
; VITXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
|
||
"RTN","GPLVITAL",26,0)
|
||
; IVITXML CONTAINS ONLY THE VITALS SECTION OF THE OVERALL TEMPLATE
|
||
"RTN","GPLVITAL",27,0)
|
||
;
|
||
"RTN","GPLVITAL",28,0)
|
||
N VITRSLT,J,K,VITPTMP,X,VITVMAP,TBUF,VORDR
|
||
"RTN","GPLVITAL",29,0)
|
||
D VITALS^ORQQVI(.VITRSLT,DFN,"","")
|
||
"RTN","GPLVITAL",30,0)
|
||
I '$D(VITRSLT(1)) S @VITOUTXML@(0)=0 Q ; RETURN NOT FOUND AND QUIT
|
||
"RTN","GPLVITAL",31,0)
|
||
I $P(VITRSLT(1),U,2)="No vitals found." D Q ; NULL RESULT FROM RPC
|
||
"RTN","GPLVITAL",32,0)
|
||
. I DEBUG W "NO VITALS FOUND FROM VITALS RPC",!
|
||
"RTN","GPLVITAL",33,0)
|
||
. S @VITOUTXML@(0)=0
|
||
"RTN","GPLVITAL",34,0)
|
||
I $P(VITRSLT(1),U,2)="No vitals found." Q ; QUIT
|
||
"RTN","GPLVITAL",35,0)
|
||
; ZWR RPCRSLT
|
||
"RTN","GPLVITAL",36,0)
|
||
S VITTVMAP=$NA(^TMP("GPLCCR",$J,"VITALS"))
|
||
"RTN","GPLVITAL",37,0)
|
||
S VITTARYTMP=$NA(^TMP("GPLCCR",$J,"VITALARYTMP"))
|
||
"RTN","GPLVITAL",38,0)
|
||
K @VITTVMAP,@VITTARYTMP ; KILL OLD ARRAY VALUES
|
||
"RTN","GPLVITAL",39,0)
|
||
N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX
|
||
"RTN","GPLVITAL",40,0)
|
||
D VITDATES(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
|
||
"RTN","GPLVITAL",41,0)
|
||
; I DEBUG ZWR VDATES ;DEBUG
|
||
"RTN","GPLVITAL",42,0)
|
||
S VCNT=$$SORTDT^CCRUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE
|
||
"RTN","GPLVITAL",43,0)
|
||
; DATE ORDER AND COUNT THEM. VSORT CONTAINS INDIRECT INDEXES ONLY
|
||
"RTN","GPLVITAL",44,0)
|
||
S @VITTVMAP@(0)=VCNT ; SAVE NUMBER OF VITALS
|
||
"RTN","GPLVITAL",45,0)
|
||
F J=1:1:VCNT D ; FOR EACH VITAL IN THE LIST
|
||
"RTN","GPLVITAL",46,0)
|
||
. I $D(VITRSLT(VSORT(J))) D
|
||
"RTN","GPLVITAL",47,0)
|
||
. . S VITVMAP=$NA(@VITTVMAP@(J))
|
||
"RTN","GPLVITAL",48,0)
|
||
. . K @VITVMAP
|
||
"RTN","GPLVITAL",49,0)
|
||
. . I DEBUG W "VMAP= ",VITVMAP,!
|
||
"RTN","GPLVITAL",50,0)
|
||
. . S VITPTMP=VITRSLT(VSORT(J)) ; DATE SORTED VITAL FROM RETURN ARRAY
|
||
"RTN","GPLVITAL",51,0)
|
||
. . I DEBUG W "VITAL ",VSORT(J),!
|
||
"RTN","GPLVITAL",52,0)
|
||
. . I DEBUG W VITRSLT(VSORT(J))," ",$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT"),!
|
||
"RTN","GPLVITAL",53,0)
|
||
. . I DEBUG W $P(VITPTMP,U,4),!
|
||
"RTN","GPLVITAL",54,0)
|
||
. . S @VITVMAP@("VITALSIGNSDATAOBJECTID")="VITAL"_J ; UNIQUE OBJID
|
||
"RTN","GPLVITAL",55,0)
|
||
. . I $P(VITPTMP,U,2)="HT" D
|
||
"RTN","GPLVITAL",56,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||
"RTN","GPLVITAL",57,0)
|
||
. . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
|
||
"RTN","GPLVITAL",58,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
|
||
"RTN","GPLVITAL",59,0)
|
||
. . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||
"RTN","GPLVITAL",60,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
|
||
"RTN","GPLVITAL",61,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||
"RTN","GPLVITAL",62,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
|
||
"RTN","GPLVITAL",63,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="248327008"
|
||
"RTN","GPLVITAL",64,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
|
||
"RTN","GPLVITAL",65,0)
|
||
. . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
|
||
"RTN","GPLVITAL",66,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
|
||
"RTN","GPLVITAL",67,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
|
||
"RTN","GPLVITAL",68,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="in"
|
||
"RTN","GPLVITAL",69,0)
|
||
. . E I $P(VITPTMP,U,2)="WT" D
|
||
"RTN","GPLVITAL",70,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||
"RTN","GPLVITAL",71,0)
|
||
. . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
|
||
"RTN","GPLVITAL",72,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
|
||
"RTN","GPLVITAL",73,0)
|
||
. . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||
"RTN","GPLVITAL",74,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
|
||
"RTN","GPLVITAL",75,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||
"RTN","GPLVITAL",76,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
|
||
"RTN","GPLVITAL",77,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="107647005"
|
||
"RTN","GPLVITAL",78,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
|
||
"RTN","GPLVITAL",79,0)
|
||
. . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
|
||
"RTN","GPLVITAL",80,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
|
||
"RTN","GPLVITAL",81,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
|
||
"RTN","GPLVITAL",82,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="lbs"
|
||
"RTN","GPLVITAL",83,0)
|
||
. . E I $P(VITPTMP,U,2)="BP" D
|
||
"RTN","GPLVITAL",84,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||
"RTN","GPLVITAL",85,0)
|
||
. . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
|
||
"RTN","GPLVITAL",86,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
|
||
"RTN","GPLVITAL",87,0)
|
||
. . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||
"RTN","GPLVITAL",88,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
|
||
"RTN","GPLVITAL",89,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||
"RTN","GPLVITAL",90,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
|
||
"RTN","GPLVITAL",91,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="392570002"
|
||
"RTN","GPLVITAL",92,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
|
||
"RTN","GPLVITAL",93,0)
|
||
. . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
|
||
"RTN","GPLVITAL",94,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
|
||
"RTN","GPLVITAL",95,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
|
||
"RTN","GPLVITAL",96,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
|
||
"RTN","GPLVITAL",97,0)
|
||
. . E I $P(VITPTMP,U,2)="T" D
|
||
"RTN","GPLVITAL",98,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||
"RTN","GPLVITAL",99,0)
|
||
. . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
|
||
"RTN","GPLVITAL",100,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
|
||
"RTN","GPLVITAL",101,0)
|
||
. . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||
"RTN","GPLVITAL",102,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
|
||
"RTN","GPLVITAL",103,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||
"RTN","GPLVITAL",104,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
|
||
"RTN","GPLVITAL",105,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="309646008"
|
||
"RTN","GPLVITAL",106,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
|
||
"RTN","GPLVITAL",107,0)
|
||
. . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
|
||
"RTN","GPLVITAL",108,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
|
||
"RTN","GPLVITAL",109,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
|
||
"RTN","GPLVITAL",110,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="F"
|
||
"RTN","GPLVITAL",111,0)
|
||
. . E I $P(VITPTMP,U,2)="R" D
|
||
"RTN","GPLVITAL",112,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||
"RTN","GPLVITAL",113,0)
|
||
. . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
|
||
"RTN","GPLVITAL",114,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
|
||
"RTN","GPLVITAL",115,0)
|
||
. . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||
"RTN","GPLVITAL",116,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
|
||
"RTN","GPLVITAL",117,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||
"RTN","GPLVITAL",118,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
|
||
"RTN","GPLVITAL",119,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="366147009"
|
||
"RTN","GPLVITAL",120,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
|
||
"RTN","GPLVITAL",121,0)
|
||
. . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
|
||
"RTN","GPLVITAL",122,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
|
||
"RTN","GPLVITAL",123,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
|
||
"RTN","GPLVITAL",124,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
|
||
"RTN","GPLVITAL",125,0)
|
||
. . E I $P(VITPTMP,U,2)="P" D
|
||
"RTN","GPLVITAL",126,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||
"RTN","GPLVITAL",127,0)
|
||
. . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
|
||
"RTN","GPLVITAL",128,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
|
||
"RTN","GPLVITAL",129,0)
|
||
. . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||
"RTN","GPLVITAL",130,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
|
||
"RTN","GPLVITAL",131,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||
"RTN","GPLVITAL",132,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
|
||
"RTN","GPLVITAL",133,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="366199006"
|
||
"RTN","GPLVITAL",134,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
|
||
"RTN","GPLVITAL",135,0)
|
||
. . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
|
||
"RTN","GPLVITAL",136,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
|
||
"RTN","GPLVITAL",137,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
|
||
"RTN","GPLVITAL",138,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
|
||
"RTN","GPLVITAL",139,0)
|
||
. . E I $P(VITPTMP,U,2)="PN" D
|
||
"RTN","GPLVITAL",140,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||
"RTN","GPLVITAL",141,0)
|
||
. . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
|
||
"RTN","GPLVITAL",142,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
|
||
"RTN","GPLVITAL",143,0)
|
||
. . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||
"RTN","GPLVITAL",144,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
|
||
"RTN","GPLVITAL",145,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||
"RTN","GPLVITAL",146,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
|
||
"RTN","GPLVITAL",147,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="22253000"
|
||
"RTN","GPLVITAL",148,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
|
||
"RTN","GPLVITAL",149,0)
|
||
. . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
|
||
"RTN","GPLVITAL",150,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
|
||
"RTN","GPLVITAL",151,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
|
||
"RTN","GPLVITAL",152,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
|
||
"RTN","GPLVITAL",153,0)
|
||
. . E D
|
||
"RTN","GPLVITAL",154,0)
|
||
. . . ;W "IN VITAL: OTHER",!
|
||
"RTN","GPLVITAL",155,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||
"RTN","GPLVITAL",156,0)
|
||
. . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
|
||
"RTN","GPLVITAL",157,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER VITAL"
|
||
"RTN","GPLVITAL",158,0)
|
||
. . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||
"RTN","GPLVITAL",159,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
|
||
"RTN","GPLVITAL",160,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="UNKNOWN"
|
||
"RTN","GPLVITAL",161,0)
|
||
. . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER"
|
||
"RTN","GPLVITAL",162,0)
|
||
. . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")=""
|
||
"RTN","GPLVITAL",163,0)
|
||
. . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")=""
|
||
"RTN","GPLVITAL",164,0)
|
||
. . . ;S @VITVMAP@("VITALSIGNSCODEVERSION")=""
|
||
"RTN","GPLVITAL",165,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
|
||
"RTN","GPLVITAL",166,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
|
||
"RTN","GPLVITAL",167,0)
|
||
. . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="UNKNOWN"
|
||
"RTN","GPLVITAL",168,0)
|
||
. . S VITARYTMP=$NA(@VITTARYTMP@(J))
|
||
"RTN","GPLVITAL",169,0)
|
||
. . K @VITARYTMP
|
||
"RTN","GPLVITAL",170,0)
|
||
. . D MAP^GPLXPATH(VITXML,VITVMAP,VITARYTMP)
|
||
"RTN","GPLVITAL",171,0)
|
||
. . I J=1 D ; FIRST ONE IS JUST A COPY
|
||
"RTN","GPLVITAL",172,0)
|
||
. . . ; W "FIRST ONE",!
|
||
"RTN","GPLVITAL",173,0)
|
||
. . . D CP^GPLXPATH(VITARYTMP,VITOUTXML)
|
||
"RTN","GPLVITAL",174,0)
|
||
. . . I DEBUG W "VITOUTXML ",VITOUTXML,!
|
||
"RTN","GPLVITAL",175,0)
|
||
. . I J>1 D ; AFTER THE FIRST, INSERT INNER XML
|
||
"RTN","GPLVITAL",176,0)
|
||
. . . D INSINNER^GPLXPATH(VITOUTXML,VITARYTMP)
|
||
"RTN","GPLVITAL",177,0)
|
||
; ZWR ^TMP($J,"VITALS",*)
|
||
"RTN","GPLVITAL",178,0)
|
||
; ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS
|
||
"RTN","GPLVITAL",179,0)
|
||
I DEBUG D PARY^GPLXPATH(VITOUTXML)
|
||
"RTN","GPLVITAL",180,0)
|
||
N VITTMP,I
|
||
"RTN","GPLVITAL",181,0)
|
||
D MISSING^GPLXPATH(VITOUTXML,"VITTMP") ; SEARCH XML FOR MISSING VARS
|
||
"RTN","GPLVITAL",182,0)
|
||
I VITTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
|
||
"RTN","GPLVITAL",183,0)
|
||
. W "VITALS MISSING ",!
|
||
"RTN","GPLVITAL",184,0)
|
||
. F I=1:1:VITTMP(0) W VITTMP(I),!
|
||
"RTN","GPLVITAL",185,0)
|
||
Q
|
||
"RTN","GPLVITAL",186,0)
|
||
;
|
||
"RTN","GPLVITAL",187,0)
|
||
VITDATES(VDT) ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
|
||
"RTN","GPLVITAL",188,0)
|
||
; OF DATES IN THE VITALS RESULTS
|
||
"RTN","GPLVITAL",189,0)
|
||
N VDTI,VDTJ,VTDCNT
|
||
"RTN","GPLVITAL",190,0)
|
||
S VTDCNT=0 ; COUNT TO BUILD ARRAY
|
||
"RTN","GPLVITAL",191,0)
|
||
S VDTJ="" ; USED TO VISIT THE RESULTS
|
||
"RTN","GPLVITAL",192,0)
|
||
F VDTI=0:0 D Q:$O(VITRSLT(VDTJ))="" ; VISIT ALL RESULTS
|
||
"RTN","GPLVITAL",193,0)
|
||
. S VDTJ=$O(VITRSLT(VDTJ)) ; NEXT RESULT
|
||
"RTN","GPLVITAL",194,0)
|
||
. S VTDCNT=VTDCNT+1 ; INCREMENT COUNTER
|
||
"RTN","GPLVITAL",195,0)
|
||
. S VDT(VTDCNT)=$P(VITRSLT(VDTJ),U,4) ; PULL OUT THE DATE
|
||
"RTN","GPLVITAL",196,0)
|
||
S VDT(0)=VTDCNT
|
||
"RTN","GPLVITAL",197,0)
|
||
Q
|
||
"RTN","GPLVITAL",198,0)
|
||
;
|
||
"RTN","GPLXPAT0")
|
||
0^21^B51026779
|
||
"RTN","GPLXPAT0",1,0)
|
||
GPLXPAT0 ; CCDCCR/GPL - XPATH TEST CASES ; 6/1/08
|
||
"RTN","GPLXPAT0",2,0)
|
||
;;0.2;CCDCCR;nopatch;noreleasedate;Build 15
|
||
"RTN","GPLXPAT0",3,0)
|
||
;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
||
"RTN","GPLXPAT0",4,0)
|
||
;General Public License See attached copy of the License.
|
||
"RTN","GPLXPAT0",5,0)
|
||
;
|
||
"RTN","GPLXPAT0",6,0)
|
||
;This program is free software; you can redistribute it and/or modify
|
||
"RTN","GPLXPAT0",7,0)
|
||
;it under the terms of the GNU General Public License as published by
|
||
"RTN","GPLXPAT0",8,0)
|
||
;the Free Software Foundation; either version 2 of the License, or
|
||
"RTN","GPLXPAT0",9,0)
|
||
;(at your option) any later version.
|
||
"RTN","GPLXPAT0",10,0)
|
||
;
|
||
"RTN","GPLXPAT0",11,0)
|
||
;This program is distributed in the hope that it will be useful,
|
||
"RTN","GPLXPAT0",12,0)
|
||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
"RTN","GPLXPAT0",13,0)
|
||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
"RTN","GPLXPAT0",14,0)
|
||
;GNU General Public License for more details.
|
||
"RTN","GPLXPAT0",15,0)
|
||
;
|
||
"RTN","GPLXPAT0",16,0)
|
||
;You should have received a copy of the GNU General Public License along
|
||
"RTN","GPLXPAT0",17,0)
|
||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
||
"RTN","GPLXPAT0",18,0)
|
||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
||
"RTN","GPLXPAT0",19,0)
|
||
;
|
||
"RTN","GPLXPAT0",20,0)
|
||
W "NO ENTRY",!
|
||
"RTN","GPLXPAT0",21,0)
|
||
Q
|
||
"RTN","GPLXPAT0",22,0)
|
||
;
|
||
"RTN","GPLXPAT0",23,0)
|
||
;;><TEST>
|
||
"RTN","GPLXPAT0",24,0)
|
||
;;><INIT>
|
||
"RTN","GPLXPAT0",25,0)
|
||
;;>>>K GPL S GPL=""
|
||
"RTN","GPLXPAT0",26,0)
|
||
;;>>>D PUSH^GPLXPATH("GPL","FIRST")
|
||
"RTN","GPLXPAT0",27,0)
|
||
;;>>>D PUSH^GPLXPATH("GPL","SECOND")
|
||
"RTN","GPLXPAT0",28,0)
|
||
;;>>>D PUSH^GPLXPATH("GPL","THIRD")
|
||
"RTN","GPLXPAT0",29,0)
|
||
;;>>>D PUSH^GPLXPATH("GPL","FOURTH")
|
||
"RTN","GPLXPAT0",30,0)
|
||
;;>>?GPL(0)=4
|
||
"RTN","GPLXPAT0",31,0)
|
||
;;><INITXML>
|
||
"RTN","GPLXPAT0",32,0)
|
||
;;>>>K GXML S GXML=""
|
||
"RTN","GPLXPAT0",33,0)
|
||
;;>>>D PUSH^GPLXPATH("GXML","<FIRST>")
|
||
"RTN","GPLXPAT0",34,0)
|
||
;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
|
||
"RTN","GPLXPAT0",35,0)
|
||
;;>>>D PUSH^GPLXPATH("GXML","<THIRD>")
|
||
"RTN","GPLXPAT0",36,0)
|
||
;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>@@DATA1@@</FOURTH>")
|
||
"RTN","GPLXPAT0",37,0)
|
||
;;>>>D PUSH^GPLXPATH("GXML","<FIFTH>")
|
||
"RTN","GPLXPAT0",38,0)
|
||
;;>>>D PUSH^GPLXPATH("GXML","@@DATA2@@")
|
||
"RTN","GPLXPAT0",39,0)
|
||
;;>>>D PUSH^GPLXPATH("GXML","</FIFTH>")
|
||
"RTN","GPLXPAT0",40,0)
|
||
;;>>>D PUSH^GPLXPATH("GXML","<SIXTH ID=""SELF"" />")
|
||
"RTN","GPLXPAT0",41,0)
|
||
;;>>>D PUSH^GPLXPATH("GXML","</THIRD>")
|
||
"RTN","GPLXPAT0",42,0)
|
||
;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
|
||
"RTN","GPLXPAT0",43,0)
|
||
;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
|
||
"RTN","GPLXPAT0",44,0)
|
||
;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
|
||
"RTN","GPLXPAT0",45,0)
|
||
;;>>>D PUSH^GPLXPATH("GXML","</FIRST>")
|
||
"RTN","GPLXPAT0",46,0)
|
||
;;><INITXML2>
|
||
"RTN","GPLXPAT0",47,0)
|
||
;;>>>K GXML S GXML=""
|
||
"RTN","GPLXPAT0",48,0)
|
||
;;>>>D PUSH^GPLXPATH("GXML","<FIRST>")
|
||
"RTN","GPLXPAT0",49,0)
|
||
;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
|
||
"RTN","GPLXPAT0",50,0)
|
||
;;>>>D PUSH^GPLXPATH("GXML","<THIRD>")
|
||
"RTN","GPLXPAT0",51,0)
|
||
;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>DATA1</FOURTH>")
|
||
"RTN","GPLXPAT0",52,0)
|
||
;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>")
|
||
"RTN","GPLXPAT0",53,0)
|
||
;;>>>D PUSH^GPLXPATH("GXML","DATA2")
|
||
"RTN","GPLXPAT0",54,0)
|
||
;;>>>D PUSH^GPLXPATH("GXML","</FOURTH>")
|
||
"RTN","GPLXPAT0",55,0)
|
||
;;>>>D PUSH^GPLXPATH("GXML","</THIRD>")
|
||
"RTN","GPLXPAT0",56,0)
|
||
;;>>>D PUSH^GPLXPATH("GXML","<_SECOND>")
|
||
"RTN","GPLXPAT0",57,0)
|
||
;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>DATA3</FOURTH>")
|
||
"RTN","GPLXPAT0",58,0)
|
||
;;>>>D PUSH^GPLXPATH("GXML","</_SECOND>")
|
||
"RTN","GPLXPAT0",59,0)
|
||
;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
|
||
"RTN","GPLXPAT0",60,0)
|
||
;;>>>D PUSH^GPLXPATH("GXML","</FIRST>")
|
||
"RTN","GPLXPAT0",61,0)
|
||
;;><PUSHPOP>
|
||
"RTN","GPLXPAT0",62,0)
|
||
;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
|
||
"RTN","GPLXPAT0",63,0)
|
||
;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT")
|
||
"RTN","GPLXPAT0",64,0)
|
||
;;>>?GPL(GPL(0))="FOURTH"
|
||
"RTN","GPLXPAT0",65,0)
|
||
;;>>>D POP^GPLXPATH("GPL",.GX)
|
||
"RTN","GPLXPAT0",66,0)
|
||
;;>>?GX="FOURTH"
|
||
"RTN","GPLXPAT0",67,0)
|
||
;;>>?GPL(GPL(0))="THIRD"
|
||
"RTN","GPLXPAT0",68,0)
|
||
;;>>>D POP^GPLXPATH("GPL",.GX)
|
||
"RTN","GPLXPAT0",69,0)
|
||
;;>>?GX="THIRD"
|
||
"RTN","GPLXPAT0",70,0)
|
||
;;>>?GPL(GPL(0))="SECOND"
|
||
"RTN","GPLXPAT0",71,0)
|
||
;;><MKMDX>
|
||
"RTN","GPLXPAT0",72,0)
|
||
;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
|
||
"RTN","GPLXPAT0",73,0)
|
||
;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT")
|
||
"RTN","GPLXPAT0",74,0)
|
||
;;>>>S GX=""
|
||
"RTN","GPLXPAT0",75,0)
|
||
;;>>>D MKMDX^GPLXPATH("GPL",.GX)
|
||
"RTN","GPLXPAT0",76,0)
|
||
;;>>?GX="//FIRST/SECOND/THIRD/FOURTH"
|
||
"RTN","GPLXPAT0",77,0)
|
||
;;><XNAME>
|
||
"RTN","GPLXPAT0",78,0)
|
||
;;>>?$$XNAME^GPLXPATH("<FOURTH>DATA1</FOURTH>")="FOURTH"
|
||
"RTN","GPLXPAT0",79,0)
|
||
;;>>?$$XNAME^GPLXPATH("<SIXTH ID=""SELF"" />")="SIXTH"
|
||
"RTN","GPLXPAT0",80,0)
|
||
;;>>?$$XNAME^GPLXPATH("</THIRD>")="THIRD"
|
||
"RTN","GPLXPAT0",81,0)
|
||
;;><INDEX>
|
||
"RTN","GPLXPAT0",82,0)
|
||
;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
|
||
"RTN","GPLXPAT0",83,0)
|
||
;;>>>D ZTEST^GPLUNIT(.ZTMP,"INITXML")
|
||
"RTN","GPLXPAT0",84,0)
|
||
;;>>>D INDEX^GPLXPATH("GXML")
|
||
"RTN","GPLXPAT0",85,0)
|
||
;;>>?GXML("//FIRST/SECOND")="2^12"
|
||
"RTN","GPLXPAT0",86,0)
|
||
;;>>?GXML("//FIRST/SECOND/THIRD")="3^9"
|
||
"RTN","GPLXPAT0",87,0)
|
||
;;>>?GXML("//FIRST/SECOND/THIRD/FIFTH")="5^7"
|
||
"RTN","GPLXPAT0",88,0)
|
||
;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^4"
|
||
"RTN","GPLXPAT0",89,0)
|
||
;;>>?GXML("//FIRST/SECOND/THIRD/SIXTH")="8^8"
|
||
"RTN","GPLXPAT0",90,0)
|
||
;;>>?GXML("//FIRST/SECOND")="2^12"
|
||
"RTN","GPLXPAT0",91,0)
|
||
;;>>?GXML("//FIRST")="1^13"
|
||
"RTN","GPLXPAT0",92,0)
|
||
;;><INDEX2>
|
||
"RTN","GPLXPAT0",93,0)
|
||
;;>>>D ZTEST^GPLXPATH("INITXML2")
|
||
"RTN","GPLXPAT0",94,0)
|
||
;;>>>D INDEX^GPLXPATH("GXML")
|
||
"RTN","GPLXPAT0",95,0)
|
||
;;>>?GXML("//FIRST/SECOND")="2^12"
|
||
"RTN","GPLXPAT0",96,0)
|
||
;;>>?GXML("//FIRST/SECOND/_SECOND")="9^11"
|
||
"RTN","GPLXPAT0",97,0)
|
||
;;>>?GXML("//FIRST/SECOND/_SECOND/FOURTH")="10^10"
|
||
"RTN","GPLXPAT0",98,0)
|
||
;;>>?GXML("//FIRST/SECOND/THIRD")="3^8"
|
||
"RTN","GPLXPAT0",99,0)
|
||
;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^7"
|
||
"RTN","GPLXPAT0",100,0)
|
||
;;>>?GXML("//FIRST")="1^13"
|
||
"RTN","GPLXPAT0",101,0)
|
||
;;><MISSING>
|
||
"RTN","GPLXPAT0",102,0)
|
||
;;>>>D ZTEST^GPLXPATH("INITXML")
|
||
"RTN","GPLXPAT0",103,0)
|
||
;;>>>S OUTARY="^TMP($J,""MISSINGTEST"")"
|
||
"RTN","GPLXPAT0",104,0)
|
||
;;>>>D MISSING^GPLXPATH("GXML",OUTARY)
|
||
"RTN","GPLXPAT0",105,0)
|
||
;;>>?@OUTARY@(1)="DATA1"
|
||
"RTN","GPLXPAT0",106,0)
|
||
;;>>?@OUTARY@(2)="DATA2"
|
||
"RTN","GPLXPAT0",107,0)
|
||
;;><MAP>
|
||
"RTN","GPLXPAT0",108,0)
|
||
;;>>>D ZTEST^GPLXPATH("INITXML")
|
||
"RTN","GPLXPAT0",109,0)
|
||
;;>>>S MAPARY="^TMP($J,""MAPVALUES"")"
|
||
"RTN","GPLXPAT0",110,0)
|
||
;;>>>S OUTARY="^TMP($J,""MAPTEST"")"
|
||
"RTN","GPLXPAT0",111,0)
|
||
;;>>>S @MAPARY@("DATA2")="VALUE2"
|
||
"RTN","GPLXPAT0",112,0)
|
||
;;>>>D MAP^GPLXPATH("GXML",MAPARY,OUTARY)
|
||
"RTN","GPLXPAT0",113,0)
|
||
;;>>?@OUTARY@(6)="VALUE2"
|
||
"RTN","GPLXPAT0",114,0)
|
||
;;><MAP2>
|
||
"RTN","GPLXPAT0",115,0)
|
||
;;>>>D ZTEST^GPLXPATH("INITXML")
|
||
"RTN","GPLXPAT0",116,0)
|
||
;;>>>S MAPARY="^TMP($J,""MAPVALUES"")"
|
||
"RTN","GPLXPAT0",117,0)
|
||
;;>>>S OUTARY="^TMP($J,""MAPTEST"")"
|
||
"RTN","GPLXPAT0",118,0)
|
||
;;>>>S @MAPARY@("DATA1")="VALUE1"
|
||
"RTN","GPLXPAT0",119,0)
|
||
;;>>>S @MAPARY@("DATA2")="VALUE2"
|
||
"RTN","GPLXPAT0",120,0)
|
||
;;>>>S @MAPARY@("DATA3")="VALUE3"
|
||
"RTN","GPLXPAT0",121,0)
|
||
;;>>>S GXML(4)="<FOURTH>@@DATA1@@ AND @@DATA3@@</FOURTH>"
|
||
"RTN","GPLXPAT0",122,0)
|
||
;;>>>D MAP^GPLXPATH("GXML",MAPARY,OUTARY)
|
||
"RTN","GPLXPAT0",123,0)
|
||
;;>>>D PARY^GPLXPATH(OUTARY)
|
||
"RTN","GPLXPAT0",124,0)
|
||
;;>>?@OUTARY@(4)="<FOURTH>VALUE1 AND VALUE3</FOURTH>"
|
||
"RTN","GPLXPAT0",125,0)
|
||
;;><QUEUE>
|
||
"RTN","GPLXPAT0",126,0)
|
||
;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",2,3)
|
||
"RTN","GPLXPAT0",127,0)
|
||
;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",4,5)
|
||
"RTN","GPLXPAT0",128,0)
|
||
;;>>?$P(BTLIST(2),";",2)=4
|
||
"RTN","GPLXPAT0",129,0)
|
||
;;><BUILD>
|
||
"RTN","GPLXPAT0",130,0)
|
||
;;>>>D ZTEST^GPLXPATH("INITXML")
|
||
"RTN","GPLXPAT0",131,0)
|
||
;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FOURTH","G2")
|
||
"RTN","GPLXPAT0",132,0)
|
||
;;>>>D ZTEST^GPLXPATH("QUEUE")
|
||
"RTN","GPLXPAT0",133,0)
|
||
;;>>>D BUILD^GPLXPATH("BTLIST","G3")
|
||
"RTN","GPLXPAT0",134,0)
|
||
;;><CP>
|
||
"RTN","GPLXPAT0",135,0)
|
||
;;>>>D ZTEST^GPLXPATH("INITXML")
|
||
"RTN","GPLXPAT0",136,0)
|
||
;;>>>D CP^GPLXPATH("GXML","G2")
|
||
"RTN","GPLXPAT0",137,0)
|
||
;;>>?G2(0)=13
|
||
"RTN","GPLXPAT0",138,0)
|
||
;;><QOPEN>
|
||
"RTN","GPLXPAT0",139,0)
|
||
;;>>>K G2,GBL
|
||
"RTN","GPLXPAT0",140,0)
|
||
;;>>>D ZTEST^GPLXPATH("INITXML")
|
||
"RTN","GPLXPAT0",141,0)
|
||
;;>>>D QOPEN^GPLXPATH("GBL","GXML")
|
||
"RTN","GPLXPAT0",142,0)
|
||
;;>>?$P(GBL(1),";",3)=12
|
||
"RTN","GPLXPAT0",143,0)
|
||
;;>>>D BUILD^GPLXPATH("GBL","G2")
|
||
"RTN","GPLXPAT0",144,0)
|
||
;;>>?G2(G2(0))="</SECOND>"
|
||
"RTN","GPLXPAT0",145,0)
|
||
;;><QOPEN2>
|
||
"RTN","GPLXPAT0",146,0)
|
||
;;>>>K G2,GBL
|
||
"RTN","GPLXPAT0",147,0)
|
||
;;>>>D ZTEST^GPLXPATH("INITXML")
|
||
"RTN","GPLXPAT0",148,0)
|
||
;;>>>D QOPEN^GPLXPATH("GBL","GXML","//FIRST/SECOND")
|
||
"RTN","GPLXPAT0",149,0)
|
||
;;>>?$P(GBL(1),";",3)=11
|
||
"RTN","GPLXPAT0",150,0)
|
||
;;>>>D BUILD^GPLXPATH("GBL","G2")
|
||
"RTN","GPLXPAT0",151,0)
|
||
;;>>?G2(G2(0))="</SECOND>"
|
||
"RTN","GPLXPAT0",152,0)
|
||
;;><QCLOSE>
|
||
"RTN","GPLXPAT0",153,0)
|
||
;;>>>K G2,GBL
|
||
"RTN","GPLXPAT0",154,0)
|
||
;;>>>D ZTEST^GPLXPATH("INITXML")
|
||
"RTN","GPLXPAT0",155,0)
|
||
;;>>>D QCLOSE^GPLXPATH("GBL","GXML")
|
||
"RTN","GPLXPAT0",156,0)
|
||
;;>>?$P(GBL(1),";",3)=13
|
||
"RTN","GPLXPAT0",157,0)
|
||
;;>>>D BUILD^GPLXPATH("GBL","G2")
|
||
"RTN","GPLXPAT0",158,0)
|
||
;;>>?G2(G2(0))="</FIRST>"
|
||
"RTN","GPLXPAT0",159,0)
|
||
;;><QCLOSE2>
|
||
"RTN","GPLXPAT0",160,0)
|
||
;;>>>K G2,GBL
|
||
"RTN","GPLXPAT0",161,0)
|
||
;;>>>D ZTEST^GPLXPATH("INITXML")
|
||
"RTN","GPLXPAT0",162,0)
|
||
;;>>>D QCLOSE^GPLXPATH("GBL","GXML","//FIRST/SECOND/THIRD")
|
||
"RTN","GPLXPAT0",163,0)
|
||
;;>>?$P(GBL(1),";",3)=13
|
||
"RTN","GPLXPAT0",164,0)
|
||
;;>>>D BUILD^GPLXPATH("GBL","G2")
|
||
"RTN","GPLXPAT0",165,0)
|
||
;;>>?G2(G2(0))="</FIRST>"
|
||
"RTN","GPLXPAT0",166,0)
|
||
;;>>?G2(1)="</THIRD>"
|
||
"RTN","GPLXPAT0",167,0)
|
||
;;><INSERT>
|
||
"RTN","GPLXPAT0",168,0)
|
||
;;>>>K G2,GBL,G3,G4
|
||
"RTN","GPLXPAT0",169,0)
|
||
;;>>>D ZTEST^GPLXPATH("INITXML")
|
||
"RTN","GPLXPAT0",170,0)
|
||
;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
|
||
"RTN","GPLXPAT0",171,0)
|
||
;;>>>D INSERT^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD")
|
||
"RTN","GPLXPAT0",172,0)
|
||
;;>>>D INSERT^GPLXPATH("G3","G2","//")
|
||
"RTN","GPLXPAT0",173,0)
|
||
;;>>?G2(1)=GXML(9)
|
||
"RTN","GPLXPAT0",174,0)
|
||
;;><REPLACE>
|
||
"RTN","GPLXPAT0",175,0)
|
||
;;>>>K G2,GBL,G3
|
||
"RTN","GPLXPAT0",176,0)
|
||
;;>>>D ZTEST^GPLXPATH("INITXML")
|
||
"RTN","GPLXPAT0",177,0)
|
||
;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
|
||
"RTN","GPLXPAT0",178,0)
|
||
;;>>>D REPLACE^GPLXPATH("GXML","G2","//FIRST/SECOND")
|
||
"RTN","GPLXPAT0",179,0)
|
||
;;>>?GXML(2)="<FIFTH>"
|
||
"RTN","GPLXPAT0",180,0)
|
||
;;><INSINNER>
|
||
"RTN","GPLXPAT0",181,0)
|
||
;;>>>K GXML,G2,GBL,G3
|
||
"RTN","GPLXPAT0",182,0)
|
||
;;>>>D ZTEST^GPLXPATH("INITXML")
|
||
"RTN","GPLXPAT0",183,0)
|
||
;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2")
|
||
"RTN","GPLXPAT0",184,0)
|
||
;;>>>D INSINNER^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD")
|
||
"RTN","GPLXPAT0",185,0)
|
||
;;>>?GXML(10)="<FIFTH>"
|
||
"RTN","GPLXPAT0",186,0)
|
||
;;><INSINNER2>
|
||
"RTN","GPLXPAT0",187,0)
|
||
;;>>>K GXML,G2,GBL,G3
|
||
"RTN","GPLXPAT0",188,0)
|
||
;;>>>D ZTEST^GPLXPATH("INITXML")
|
||
"RTN","GPLXPAT0",189,0)
|
||
;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2")
|
||
"RTN","GPLXPAT0",190,0)
|
||
;;>>>D INSINNER^GPLXPATH("G2","G2")
|
||
"RTN","GPLXPAT0",191,0)
|
||
;;>>?G2(8)="<FIFTH>"
|
||
"RTN","GPLXPAT0",192,0)
|
||
;;><PUSHA>
|
||
"RTN","GPLXPAT0",193,0)
|
||
;;>>>K GTMP,GTMP2
|
||
"RTN","GPLXPAT0",194,0)
|
||
;;>>>N GTMP,GTMP2
|
||
"RTN","GPLXPAT0",195,0)
|
||
;;>>>D PUSH^GPLXPATH("GTMP","A")
|
||
"RTN","GPLXPAT0",196,0)
|
||
;;>>>D PUSH^GPLXPATH("GTMP2","B")
|
||
"RTN","GPLXPAT0",197,0)
|
||
;;>>>D PUSH^GPLXPATH("GTMP2","C")
|
||
"RTN","GPLXPAT0",198,0)
|
||
;;>>>D PUSHA^GPLXPATH("GTMP","GTMP2")
|
||
"RTN","GPLXPAT0",199,0)
|
||
;;>>?GTMP(3)="C"
|
||
"RTN","GPLXPAT0",200,0)
|
||
;;>>?GTMP(0)=3
|
||
"RTN","GPLXPAT0",201,0)
|
||
;;><H2ARY>
|
||
"RTN","GPLXPAT0",202,0)
|
||
;;>>>K GTMP,GTMP2
|
||
"RTN","GPLXPAT0",203,0)
|
||
;;>>>S GTMP("TEST1")=1
|
||
"RTN","GPLXPAT0",204,0)
|
||
;;>>>D H2ARY^GPLXPATH("GTMP2","GTMP")
|
||
"RTN","GPLXPAT0",205,0)
|
||
;;>>?GTMP2(0)=1
|
||
"RTN","GPLXPAT0",206,0)
|
||
;;>>?GTMP2(1)="^TEST1^1"
|
||
"RTN","GPLXPAT0",207,0)
|
||
;;><XVARS>
|
||
"RTN","GPLXPAT0",208,0)
|
||
;;>>>K GTMP,GTMP2
|
||
"RTN","GPLXPAT0",209,0)
|
||
;;>>>D PUSH^GPLXPATH("GTMP","<VALUE>@@VAR1@@</VALUE>")
|
||
"RTN","GPLXPAT0",210,0)
|
||
;;>>>D XVARS^GPLXPATH("GTMP2","GTMP")
|
||
"RTN","GPLXPAT0",211,0)
|
||
;;>>?GTMP2(1)="^VAR1^"
|
||
"RTN","GPLXPAT0",212,0)
|
||
;;></TEST>
|
||
"RTN","GPLXPATH")
|
||
0^9^B255658739
|
||
"RTN","GPLXPATH",1,0)
|
||
GPLXPATH ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08
|
||
"RTN","GPLXPATH",2,0)
|
||
;;0.2;CCDCCR;nopatch;noreleasedate;Build 15
|
||
"RTN","GPLXPATH",3,0)
|
||
;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
||
"RTN","GPLXPATH",4,0)
|
||
;General Public License See attached copy of the License.
|
||
"RTN","GPLXPATH",5,0)
|
||
;
|
||
"RTN","GPLXPATH",6,0)
|
||
;This program is free software; you can redistribute it and/or modify
|
||
"RTN","GPLXPATH",7,0)
|
||
;it under the terms of the GNU General Public License as published by
|
||
"RTN","GPLXPATH",8,0)
|
||
;the Free Software Foundation; either version 2 of the License, or
|
||
"RTN","GPLXPATH",9,0)
|
||
;(at your option) any later version.
|
||
"RTN","GPLXPATH",10,0)
|
||
;
|
||
"RTN","GPLXPATH",11,0)
|
||
;This program is distributed in the hope that it will be useful,
|
||
"RTN","GPLXPATH",12,0)
|
||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
"RTN","GPLXPATH",13,0)
|
||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
"RTN","GPLXPATH",14,0)
|
||
;GNU General Public License for more details.
|
||
"RTN","GPLXPATH",15,0)
|
||
;
|
||
"RTN","GPLXPATH",16,0)
|
||
;You should have received a copy of the GNU General Public License along
|
||
"RTN","GPLXPATH",17,0)
|
||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
||
"RTN","GPLXPATH",18,0)
|
||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
||
"RTN","GPLXPATH",19,0)
|
||
;
|
||
"RTN","GPLXPATH",20,0)
|
||
W "This is an XML XPATH utility library",!
|
||
"RTN","GPLXPATH",21,0)
|
||
W !
|
||
"RTN","GPLXPATH",22,0)
|
||
Q
|
||
"RTN","GPLXPATH",23,0)
|
||
;
|
||
"RTN","GPLXPATH",24,0)
|
||
OUTPUT(OUTARY,OUTNAME,OUTDIR) ; WRITE AN ARRAY TO A FILE
|
||
"RTN","GPLXPATH",25,0)
|
||
;
|
||
"RTN","GPLXPATH",26,0)
|
||
N Y
|
||
"RTN","GPLXPATH",27,0)
|
||
S Y=$$GTF^%ZISH(OUTARY,$QL(OUTARY),OUTDIR,OUTNAME)
|
||
"RTN","GPLXPATH",28,0)
|
||
I Y Q 1_U_"WROTE FILE: "_OUTNAME_" TO "_OUTDIR
|
||
"RTN","GPLXPATH",29,0)
|
||
I 'Y Q 0_U_"ERROR WRITING FILE"_OUTNAME_" TO "_OUTDIR
|
||
"RTN","GPLXPATH",30,0)
|
||
Q
|
||
"RTN","GPLXPATH",31,0)
|
||
;
|
||
"RTN","GPLXPATH",32,0)
|
||
PUSH(STK,VAL) ; pushs VAL onto STK and updates STK(0)
|
||
"RTN","GPLXPATH",33,0)
|
||
; VAL IS A STRING AND STK IS PASSED BY NAME
|
||
"RTN","GPLXPATH",34,0)
|
||
;
|
||
"RTN","GPLXPATH",35,0)
|
||
I '$D(@STK@(0)) S @STK@(0)=0 ; IF THE ARRAY IS EMPTY, INITIALIZE
|
||
"RTN","GPLXPATH",36,0)
|
||
S @STK@(0)=@STK@(0)+1 ; INCREMENT ARRAY DEPTH
|
||
"RTN","GPLXPATH",37,0)
|
||
S @STK@(@STK@(0))=VAL ; PUT VAL A THE END OF THE ARRAY
|
||
"RTN","GPLXPATH",38,0)
|
||
Q
|
||
"RTN","GPLXPATH",39,0)
|
||
;
|
||
"RTN","GPLXPATH",40,0)
|
||
POP(STK,VAL) ; POPS THE LAST VALUE OFF THE STK AND RETURNS IT IN VAL
|
||
"RTN","GPLXPATH",41,0)
|
||
; VAL AND STK ARE PASSED BY REFERENCE
|
||
"RTN","GPLXPATH",42,0)
|
||
;
|
||
"RTN","GPLXPATH",43,0)
|
||
I @STK@(0)<1 D ; IF ARRAY IS EMPTY
|
||
"RTN","GPLXPATH",44,0)
|
||
. S VAL=""
|
||
"RTN","GPLXPATH",45,0)
|
||
. S @STK@(0)=0
|
||
"RTN","GPLXPATH",46,0)
|
||
I @STK@(0)>0 D ;
|
||
"RTN","GPLXPATH",47,0)
|
||
. S VAL=@STK@(@STK@(0))
|
||
"RTN","GPLXPATH",48,0)
|
||
. K @STK@(@STK@(0))
|
||
"RTN","GPLXPATH",49,0)
|
||
. S @STK@(0)=@STK@(0)-1 ; NEW DEPTH OF THE ARRAY
|
||
"RTN","GPLXPATH",50,0)
|
||
Q
|
||
"RTN","GPLXPATH",51,0)
|
||
;
|
||
"RTN","GPLXPATH",52,0)
|
||
PUSHA(ADEST,ASRC) ; PUSH ASRC ONTO ADEST, BOTH PASSED BY NAME
|
||
"RTN","GPLXPATH",53,0)
|
||
;
|
||
"RTN","GPLXPATH",54,0)
|
||
N ZGI
|
||
"RTN","GPLXPATH",55,0)
|
||
F ZGI=1:1:@ASRC@(0) D ; FOR ALL OF THE SOURCE ARRAY
|
||
"RTN","GPLXPATH",56,0)
|
||
. D PUSH(ADEST,@ASRC@(ZGI)) ; PUSH ONE ELEMENT
|
||
"RTN","GPLXPATH",57,0)
|
||
Q
|
||
"RTN","GPLXPATH",58,0)
|
||
;
|
||
"RTN","GPLXPATH",59,0)
|
||
MKMDX(STK,RTN) ; MAKES A MUMPS INDEX FROM THE ARRAY STK
|
||
"RTN","GPLXPATH",60,0)
|
||
; RTN IS SET TO //FIRST/SECOND/THIRD FOR THREE ARRAY ELEMENTS
|
||
"RTN","GPLXPATH",61,0)
|
||
S RTN=""
|
||
"RTN","GPLXPATH",62,0)
|
||
N I
|
||
"RTN","GPLXPATH",63,0)
|
||
; W "STK= ",STK,!
|
||
"RTN","GPLXPATH",64,0)
|
||
I @STK@(0)>0 D ; IF THE ARRAY IS NOT EMPTY
|
||
"RTN","GPLXPATH",65,0)
|
||
. S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON
|
||
"RTN","GPLXPATH",66,0)
|
||
. I @STK@(0)>1 D ; SUBSEQUENT ELEMENTS NEED A SEMICOLON
|
||
"RTN","GPLXPATH",67,0)
|
||
. . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I)
|
||
"RTN","GPLXPATH",68,0)
|
||
Q
|
||
"RTN","GPLXPATH",69,0)
|
||
;
|
||
"RTN","GPLXPATH",70,0)
|
||
XNAME(ISTR) ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG
|
||
"RTN","GPLXPATH",71,0)
|
||
; </NAME> AND <NAME ID=XNAME> WILL RETURN NAME
|
||
"RTN","GPLXPATH",72,0)
|
||
; ISTR IS PASSED BY VALUE
|
||
"RTN","GPLXPATH",73,0)
|
||
N CUR,TMP
|
||
"RTN","GPLXPATH",74,0)
|
||
I ISTR?.E1"<".E D ; STRIP OFF LEFT BRACKET
|
||
"RTN","GPLXPATH",75,0)
|
||
. S TMP=$P(ISTR,"<",2)
|
||
"RTN","GPLXPATH",76,0)
|
||
I TMP?1"/".E D ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME>
|
||
"RTN","GPLXPATH",77,0)
|
||
. S TMP=$P(TMP,"/",2)
|
||
"RTN","GPLXPATH",78,0)
|
||
S CUR=$P(TMP,">",1) ; EXTRACT THE NAME
|
||
"RTN","GPLXPATH",79,0)
|
||
; W "CUR= ",CUR,!
|
||
"RTN","GPLXPATH",80,0)
|
||
I CUR?.1"_"1.A1" ".E D ; CONTAINS A BLANK IE NAME ID=TEST>
|
||
"RTN","GPLXPATH",81,0)
|
||
. S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER
|
||
"RTN","GPLXPATH",82,0)
|
||
; W "CUR2= ",CUR,!
|
||
"RTN","GPLXPATH",83,0)
|
||
Q CUR
|
||
"RTN","GPLXPATH",84,0)
|
||
;
|
||
"RTN","GPLXPATH",85,0)
|
||
INDEX(ZXML) ; parse the XML in ZXML and produce an XPATH index
|
||
"RTN","GPLXPATH",86,0)
|
||
; ex. ZXML(FIRST,SECOND,THIRD,FOURTH)=FIRSTLINE^LASTLINE
|
||
"RTN","GPLXPATH",87,0)
|
||
; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE
|
||
"RTN","GPLXPATH",88,0)
|
||
; XML SECTION
|
||
"RTN","GPLXPATH",89,0)
|
||
; ZXML IS PASSED BY NAME
|
||
"RTN","GPLXPATH",90,0)
|
||
N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND
|
||
"RTN","GPLXPATH",91,0)
|
||
N GPLSTK ; LEAVE OUT FOR DEBUGGING
|
||
"RTN","GPLXPATH",92,0)
|
||
I '$D(@ZXML@(0)) D ; NO XML PASSED
|
||
"RTN","GPLXPATH",93,0)
|
||
. W "ERROR IN XML FILE",!
|
||
"RTN","GPLXPATH",94,0)
|
||
S GPLSTK(0)=0 ; INITIALIZE STACK
|
||
"RTN","GPLXPATH",95,0)
|
||
F I=1:1:@ZXML@(0) D ; PROCESS THE ENTIRE ARRAY
|
||
"RTN","GPLXPATH",96,0)
|
||
. S LINE=@ZXML@(I)
|
||
"RTN","GPLXPATH",97,0)
|
||
. ;W LINE,!
|
||
"RTN","GPLXPATH",98,0)
|
||
. S FOUND=0 ; INTIALIZED FOUND FLAG
|
||
"RTN","GPLXPATH",99,0)
|
||
. I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS
|
||
"RTN","GPLXPATH",100,0)
|
||
. I FOUND'=1 D
|
||
"RTN","GPLXPATH",101,0)
|
||
. . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E) D
|
||
"RTN","GPLXPATH",102,0)
|
||
. . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS
|
||
"RTN","GPLXPATH",103,0)
|
||
. . . ; ON THE SAME LINE
|
||
"RTN","GPLXPATH",104,0)
|
||
. . . ; W "FOUND ",LINE,!
|
||
"RTN","GPLXPATH",105,0)
|
||
. . . S FOUND=1 ; SET FOUND FLAG
|
||
"RTN","GPLXPATH",106,0)
|
||
. . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
|
||
"RTN","GPLXPATH",107,0)
|
||
. . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
|
||
"RTN","GPLXPATH",108,0)
|
||
. . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
|
||
"RTN","GPLXPATH",109,0)
|
||
. . . ; W "MDX=",MDX,!
|
||
"RTN","GPLXPATH",110,0)
|
||
. . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE
|
||
"RTN","GPLXPATH",111,0)
|
||
. . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
|
||
"RTN","GPLXPATH",112,0)
|
||
. . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, NOT A MULTIPLE
|
||
"RTN","GPLXPATH",113,0)
|
||
. . . . S @ZXML@(MDX)=I_"^"_I ; ADD INDEX ENTRY-FIRST AND LAST
|
||
"RTN","GPLXPATH",114,0)
|
||
. . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
|
||
"RTN","GPLXPATH",115,0)
|
||
. I FOUND'=1 D ; THE LINE DOESN'T CONTAIN THE START AND END
|
||
"RTN","GPLXPATH",116,0)
|
||
. . I LINE?.E1"</"1.E D ; LINE CONTAINS END OF A SECTION
|
||
"RTN","GPLXPATH",117,0)
|
||
. . . ; W "FOUND ",LINE,!
|
||
"RTN","GPLXPATH",118,0)
|
||
. . . S FOUND=1 ; SET FOUND FLAG
|
||
"RTN","GPLXPATH",119,0)
|
||
. . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
|
||
"RTN","GPLXPATH",120,0)
|
||
. . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
|
||
"RTN","GPLXPATH",121,0)
|
||
. . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
|
||
"RTN","GPLXPATH",122,0)
|
||
. . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
|
||
"RTN","GPLXPATH",123,0)
|
||
. . . I TMP'=CUR D ; MALFORMED XML, END MUST MATCH START
|
||
"RTN","GPLXPATH",124,0)
|
||
. . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,!
|
||
"RTN","GPLXPATH",125,0)
|
||
. . . . D PARY("GPLSTK") ; PRINT OUT THE STACK FOR DEBUGING
|
||
"RTN","GPLXPATH",126,0)
|
||
. . . . Q
|
||
"RTN","GPLXPATH",127,0)
|
||
. I FOUND'=1 D ; THE LINE MIGHT CONTAIN A SECTION BEGINNING
|
||
"RTN","GPLXPATH",128,0)
|
||
. . I (LINE?.E1"<"1.E)&(LINE'["?>") D ; BEGINNING OF A SECTION
|
||
"RTN","GPLXPATH",129,0)
|
||
. . . ; W "FOUND ",LINE,!
|
||
"RTN","GPLXPATH",130,0)
|
||
. . . S FOUND=1 ; SET FOUND FLAG
|
||
"RTN","GPLXPATH",131,0)
|
||
. . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
|
||
"RTN","GPLXPATH",132,0)
|
||
. . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
|
||
"RTN","GPLXPATH",133,0)
|
||
. . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
|
||
"RTN","GPLXPATH",134,0)
|
||
. . . ; W "MDX=",MDX,!
|
||
"RTN","GPLXPATH",135,0)
|
||
. . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE
|
||
"RTN","GPLXPATH",136,0)
|
||
. . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
|
||
"RTN","GPLXPATH",137,0)
|
||
. . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, NOT A MULTIPLE
|
||
"RTN","GPLXPATH",138,0)
|
||
. . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX
|
||
"RTN","GPLXPATH",139,0)
|
||
S @ZXML@("INDEXED")=""
|
||
"RTN","GPLXPATH",140,0)
|
||
S @ZXML@("//")="1^"_@ZXML@(0) ; ROOT XPATH
|
||
"RTN","GPLXPATH",141,0)
|
||
Q
|
||
"RTN","GPLXPATH",142,0)
|
||
;
|
||
"RTN","GPLXPATH",143,0)
|
||
QUERY(IARY,XPATH,OARY) ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION
|
||
"RTN","GPLXPATH",144,0)
|
||
; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD"
|
||
"RTN","GPLXPATH",145,0)
|
||
; IARY AND OARY ARE PASSED BY NAME
|
||
"RTN","GPLXPATH",146,0)
|
||
I '$D(@IARY@("INDEXED")) D ; INDEX IS NOT PRESENT IN IARY
|
||
"RTN","GPLXPATH",147,0)
|
||
. D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML
|
||
"RTN","GPLXPATH",148,0)
|
||
N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN
|
||
"RTN","GPLXPATH",149,0)
|
||
N TMP,I,J,QXPATH
|
||
"RTN","GPLXPATH",150,0)
|
||
S FIRST=1
|
||
"RTN","GPLXPATH",151,0)
|
||
S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT
|
||
"RTN","GPLXPATH",152,0)
|
||
I XPATH'="//" D ; NOT A ROOT QUERY
|
||
"RTN","GPLXPATH",153,0)
|
||
. S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES
|
||
"RTN","GPLXPATH",154,0)
|
||
. S FIRST=$P(TMP,"^",1)
|
||
"RTN","GPLXPATH",155,0)
|
||
. S LAST=$P(TMP,"^",2)
|
||
"RTN","GPLXPATH",156,0)
|
||
K @OARY
|
||
"RTN","GPLXPATH",157,0)
|
||
S @OARY@(0)=+LAST-FIRST+1
|
||
"RTN","GPLXPATH",158,0)
|
||
S J=1
|
||
"RTN","GPLXPATH",159,0)
|
||
FOR I=FIRST:1:LAST D
|
||
"RTN","GPLXPATH",160,0)
|
||
. S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY
|
||
"RTN","GPLXPATH",161,0)
|
||
. S J=J+1
|
||
"RTN","GPLXPATH",162,0)
|
||
; ZWR OARY
|
||
"RTN","GPLXPATH",163,0)
|
||
Q
|
||
"RTN","GPLXPATH",164,0)
|
||
;
|
||
"RTN","GPLXPATH",165,0)
|
||
XF(IDX,XPATH) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH
|
||
"RTN","GPLXPATH",166,0)
|
||
; INDEX WITH TWO PIECES START^FINISH
|
||
"RTN","GPLXPATH",167,0)
|
||
; IDX IS PASSED BY NAME
|
||
"RTN","GPLXPATH",168,0)
|
||
Q $P(@IDX@(XPATH),"^",1)
|
||
"RTN","GPLXPATH",169,0)
|
||
;
|
||
"RTN","GPLXPATH",170,0)
|
||
XL(IDX,XPATH) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH
|
||
"RTN","GPLXPATH",171,0)
|
||
; INDEX WITH TWO PIECES START^FINISH
|
||
"RTN","GPLXPATH",172,0)
|
||
; IDX IS PASSED BY NAME
|
||
"RTN","GPLXPATH",173,0)
|
||
Q $P(@IDX@(XPATH),"^",2)
|
||
"RTN","GPLXPATH",174,0)
|
||
;
|
||
"RTN","GPLXPATH",175,0)
|
||
START(ISTR) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX
|
||
"RTN","GPLXPATH",176,0)
|
||
; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
|
||
"RTN","GPLXPATH",177,0)
|
||
; COMPANION TO FINISH ; IDX IS PASSED BY NAME
|
||
"RTN","GPLXPATH",178,0)
|
||
Q $P(ISTR,";",2)
|
||
"RTN","GPLXPATH",179,0)
|
||
;
|
||
"RTN","GPLXPATH",180,0)
|
||
FINISH(ISTR) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX
|
||
"RTN","GPLXPATH",181,0)
|
||
; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
|
||
"RTN","GPLXPATH",182,0)
|
||
Q $P(ISTR,";",3)
|
||
"RTN","GPLXPATH",183,0)
|
||
;
|
||
"RTN","GPLXPATH",184,0)
|
||
ARRAY(ISTR) ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX
|
||
"RTN","GPLXPATH",185,0)
|
||
; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
|
||
"RTN","GPLXPATH",186,0)
|
||
Q $P(ISTR,";",1)
|
||
"RTN","GPLXPATH",187,0)
|
||
;
|
||
"RTN","GPLXPATH",188,0)
|
||
BUILD(BLIST,BDEST) ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
|
||
"RTN","GPLXPATH",189,0)
|
||
; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST
|
||
"RTN","GPLXPATH",190,0)
|
||
; DEST IS CLEARED TO START
|
||
"RTN","GPLXPATH",191,0)
|
||
; USES PUSH TO DO THE COPY
|
||
"RTN","GPLXPATH",192,0)
|
||
N I
|
||
"RTN","GPLXPATH",193,0)
|
||
K @BDEST
|
||
"RTN","GPLXPATH",194,0)
|
||
F I=1:1:@BLIST@(0) D ; FOR EACH INSTRUCTION IN BLIST
|
||
"RTN","GPLXPATH",195,0)
|
||
. N J,ATMP
|
||
"RTN","GPLXPATH",196,0)
|
||
. S ATMP=$$ARRAY(@BLIST@(I))
|
||
"RTN","GPLXPATH",197,0)
|
||
. I DEBUG W "ATMP=",ATMP,!
|
||
"RTN","GPLXPATH",198,0)
|
||
. I DEBUG W @BLIST@(I),!
|
||
"RTN","GPLXPATH",199,0)
|
||
. F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D ;
|
||
"RTN","GPLXPATH",200,0)
|
||
. . ; FOR EACH LINE IN THIS INSTR
|
||
"RTN","GPLXPATH",201,0)
|
||
. . I DEBUG W "BDEST= ",BDEST,!
|
||
"RTN","GPLXPATH",202,0)
|
||
. . I DEBUG W "ATMP= ",@ATMP@(J),!
|
||
"RTN","GPLXPATH",203,0)
|
||
. . D PUSH(BDEST,@ATMP@(J))
|
||
"RTN","GPLXPATH",204,0)
|
||
Q
|
||
"RTN","GPLXPATH",205,0)
|
||
;
|
||
"RTN","GPLXPATH",206,0)
|
||
QUEUE(BLST,ARRAY,FIRST,LAST) ; ADD AN ENTRY TO A BLIST
|
||
"RTN","GPLXPATH",207,0)
|
||
;
|
||
"RTN","GPLXPATH",208,0)
|
||
I DEBUG W "QUEUEING ",BLST,!
|
||
"RTN","GPLXPATH",209,0)
|
||
D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST)
|
||
"RTN","GPLXPATH",210,0)
|
||
Q
|
||
"RTN","GPLXPATH",211,0)
|
||
;
|
||
"RTN","GPLXPATH",212,0)
|
||
CP(CPSRC,CPDEST) ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME
|
||
"RTN","GPLXPATH",213,0)
|
||
; KILLS CPDEST FIRST
|
||
"RTN","GPLXPATH",214,0)
|
||
N CPINSTR
|
||
"RTN","GPLXPATH",215,0)
|
||
I DEBUG W "MADE IT TO COPY",CPSRC,CPDEST,!
|
||
"RTN","GPLXPATH",216,0)
|
||
I @CPSRC@(0)<1 D ; BAD LENGTH
|
||
"RTN","GPLXPATH",217,0)
|
||
. W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,!
|
||
"RTN","GPLXPATH",218,0)
|
||
. Q
|
||
"RTN","GPLXPATH",219,0)
|
||
; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INIT
|
||
"RTN","GPLXPATH",220,0)
|
||
D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY
|
||
"RTN","GPLXPATH",221,0)
|
||
D BUILD("CPINSTR",CPDEST)
|
||
"RTN","GPLXPATH",222,0)
|
||
Q
|
||
"RTN","GPLXPATH",223,0)
|
||
;
|
||
"RTN","GPLXPATH",224,0)
|
||
QOPEN(QOBLIST,QOXML,QOXPATH) ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST
|
||
"RTN","GPLXPATH",225,0)
|
||
; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD
|
||
"RTN","GPLXPATH",226,0)
|
||
; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT
|
||
"RTN","GPLXPATH",227,0)
|
||
; USED TO INSERT CHILDREN NODES
|
||
"RTN","GPLXPATH",228,0)
|
||
I @QOXML@(0)<1 D ; MALFORMED XML
|
||
"RTN","GPLXPATH",229,0)
|
||
. W "MALFORMED XML PASSED TO QOPEN: ",QOXML,!
|
||
"RTN","GPLXPATH",230,0)
|
||
. Q
|
||
"RTN","GPLXPATH",231,0)
|
||
I DEBUG W "DOING QOPEN",!
|
||
"RTN","GPLXPATH",232,0)
|
||
N S1,E1,QOT,QOTMP
|
||
"RTN","GPLXPATH",233,0)
|
||
S S1=1 ; OPEN FROM THE BEGINNING OF THE XML
|
||
"RTN","GPLXPATH",234,0)
|
||
I $D(QOXPATH) D ; XPATH PROVIDED
|
||
"RTN","GPLXPATH",235,0)
|
||
. D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX
|
||
"RTN","GPLXPATH",236,0)
|
||
. S E1=$P(@QOXML@(QOXPATH),"^",2)-1
|
||
"RTN","GPLXPATH",237,0)
|
||
I '$D(QOXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT
|
||
"RTN","GPLXPATH",238,0)
|
||
. S E1=@QOXML@(0)-1
|
||
"RTN","GPLXPATH",239,0)
|
||
D QUEUE(QOBLIST,QOXML,S1,E1)
|
||
"RTN","GPLXPATH",240,0)
|
||
; S QOTMP=QOXML_"^"_S1_"^"_E1
|
||
"RTN","GPLXPATH",241,0)
|
||
; D PUSH(QOBLIST,QOTMP)
|
||
"RTN","GPLXPATH",242,0)
|
||
Q
|
||
"RTN","GPLXPATH",243,0)
|
||
;
|
||
"RTN","GPLXPATH",244,0)
|
||
QCLOSE(QCBLIST,QCXML,QCXPATH) ; CLOSE XML AFTER A QOPEN
|
||
"RTN","GPLXPATH",245,0)
|
||
; ADDS THE LIST LINE OF QCXML TO QCBLIST
|
||
"RTN","GPLXPATH",246,0)
|
||
; USED TO FINISH INSERTING CHILDERN NODES
|
||
"RTN","GPLXPATH",247,0)
|
||
; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END
|
||
"RTN","GPLXPATH",248,0)
|
||
; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO
|
||
"RTN","GPLXPATH",249,0)
|
||
I @QCXML@(0)<1 D ; MALFORMED XML
|
||
"RTN","GPLXPATH",250,0)
|
||
. W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,!
|
||
"RTN","GPLXPATH",251,0)
|
||
I DEBUG W "GOING TO CLOSE",!
|
||
"RTN","GPLXPATH",252,0)
|
||
N S1,E1,QCT,QCTMP
|
||
"RTN","GPLXPATH",253,0)
|
||
S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML
|
||
"RTN","GPLXPATH",254,0)
|
||
I $D(QCXPATH) D ; XPATH PROVIDED
|
||
"RTN","GPLXPATH",255,0)
|
||
. D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX
|
||
"RTN","GPLXPATH",256,0)
|
||
. S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML
|
||
"RTN","GPLXPATH",257,0)
|
||
I '$D(QCXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT
|
||
"RTN","GPLXPATH",258,0)
|
||
. S S1=@QCXML@(0)
|
||
"RTN","GPLXPATH",259,0)
|
||
D QUEUE(QCBLIST,QCXML,S1,E1)
|
||
"RTN","GPLXPATH",260,0)
|
||
; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1)
|
||
"RTN","GPLXPATH",261,0)
|
||
Q
|
||
"RTN","GPLXPATH",262,0)
|
||
;
|
||
"RTN","GPLXPATH",263,0)
|
||
INSERT(INSXML,INSNEW,INSXPATH) ; INSERT INSNEW INTO INSXML AT THE
|
||
"RTN","GPLXPATH",264,0)
|
||
; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS
|
||
"RTN","GPLXPATH",265,0)
|
||
; OMITTED, INSERTION WILL BE AT THE ROOT
|
||
"RTN","GPLXPATH",266,0)
|
||
; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW
|
||
"RTN","GPLXPATH",267,0)
|
||
; XML AT THE END OF THE XPATH POINT
|
||
"RTN","GPLXPATH",268,0)
|
||
; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE
|
||
"RTN","GPLXPATH",269,0)
|
||
N INSBLD,INSTMP
|
||
"RTN","GPLXPATH",270,0)
|
||
I DEBUG W "DOING INSERT ",INSXML,INSNEW,INSXPATH,!
|
||
"RTN","GPLXPATH",271,0)
|
||
I DEBUG F G1=1:1:@INSXML@(0) W @INSXML@(G1),!
|
||
"RTN","GPLXPATH",272,0)
|
||
I '$D(@INSXML@(0)) D ; INSERT INTO AN EMPTY ARRAY
|
||
"RTN","GPLXPATH",273,0)
|
||
. D CP^GPLXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT
|
||
"RTN","GPLXPATH",274,0)
|
||
I $D(@INSXML@(0)) D ; IF ORIGINAL ARRAY IS NOT EMPTY
|
||
"RTN","GPLXPATH",275,0)
|
||
. I $D(INSXPATH) D ; XPATH PROVIDED
|
||
"RTN","GPLXPATH",276,0)
|
||
. . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE
|
||
"RTN","GPLXPATH",277,0)
|
||
. . I DEBUG D PARY^GPLXPATH("INSBLD")
|
||
"RTN","GPLXPATH",278,0)
|
||
. I '$D(INSXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT
|
||
"RTN","GPLXPATH",279,0)
|
||
. . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH
|
||
"RTN","GPLXPATH",280,0)
|
||
. D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML
|
||
"RTN","GPLXPATH",281,0)
|
||
. I $D(INSXPATH) D ; XPATH PROVIDED
|
||
"RTN","GPLXPATH",282,0)
|
||
. . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH
|
||
"RTN","GPLXPATH",283,0)
|
||
. I '$D(INSXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT
|
||
"RTN","GPLXPATH",284,0)
|
||
. . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH
|
||
"RTN","GPLXPATH",285,0)
|
||
. D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST
|
||
"RTN","GPLXPATH",286,0)
|
||
. D CP^GPLXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE
|
||
"RTN","GPLXPATH",287,0)
|
||
Q
|
||
"RTN","GPLXPATH",288,0)
|
||
;
|
||
"RTN","GPLXPATH",289,0)
|
||
INSINNER(INNXML,INNNEW,INNXPATH) ; INSERT THE INNER XML OF INNNEW
|
||
"RTN","GPLXPATH",290,0)
|
||
; INTO INNXML AT THE INNXPATH XPATH POINT
|
||
"RTN","GPLXPATH",291,0)
|
||
;
|
||
"RTN","GPLXPATH",292,0)
|
||
N INNBLD,UXPATH
|
||
"RTN","GPLXPATH",293,0)
|
||
N INNTBUF
|
||
"RTN","GPLXPATH",294,0)
|
||
S INNTBUF=$NA(^TMP($J,"INNTBUF"))
|
||
"RTN","GPLXPATH",295,0)
|
||
I '$D(INNXPATH) D ; XPATH NOT PASSED
|
||
"RTN","GPLXPATH",296,0)
|
||
. S UXPATH="//" ; USE ROOT XPATH
|
||
"RTN","GPLXPATH",297,0)
|
||
I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED
|
||
"RTN","GPLXPATH",298,0)
|
||
I '$D(@INNXML@(0)) D ; INNXML IS EMPTY
|
||
"RTN","GPLXPATH",299,0)
|
||
. D QUEUE^GPLXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER
|
||
"RTN","GPLXPATH",300,0)
|
||
. D BUILD("INNBLD",INNXML)
|
||
"RTN","GPLXPATH",301,0)
|
||
I @INNXML@(0)>0 D ; NOT EMPTY
|
||
"RTN","GPLXPATH",302,0)
|
||
. D QOPEN("INNBLD",INNXML,UXPATH) ;
|
||
"RTN","GPLXPATH",303,0)
|
||
. D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML
|
||
"RTN","GPLXPATH",304,0)
|
||
. D QCLOSE("INNBLD",INNXML,UXPATH)
|
||
"RTN","GPLXPATH",305,0)
|
||
. D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER
|
||
"RTN","GPLXPATH",306,0)
|
||
. D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST
|
||
"RTN","GPLXPATH",307,0)
|
||
Q
|
||
"RTN","GPLXPATH",308,0)
|
||
;
|
||
"RTN","GPLXPATH",309,0)
|
||
INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST
|
||
"RTN","GPLXPATH",310,0)
|
||
; BUT XDEST AN XNEW ARE PASSED BY NAME
|
||
"RTN","GPLXPATH",311,0)
|
||
N XBLD,XTMP
|
||
"RTN","GPLXPATH",312,0)
|
||
D QUEUE("XBLD",XDEST,1,1) ; NEED TO PRESERVE SECTION ROOT
|
||
"RTN","GPLXPATH",313,0)
|
||
D QUEUE("XBLD",XNEW,1,@XNEW@(0)) ; ALL OF NEW XML FIRST
|
||
"RTN","GPLXPATH",314,0)
|
||
D QUEUE("XBLD",XDEST,2,@XDEST@(0)) ; FOLLOWED BY THE REST OF SECTION
|
||
"RTN","GPLXPATH",315,0)
|
||
D BUILD("XBLD","XTMP") ; BUILD THE RESULT
|
||
"RTN","GPLXPATH",316,0)
|
||
D CP("XTMP",XDEST) ; COPY TO THE DESTINATION
|
||
"RTN","GPLXPATH",317,0)
|
||
I DEBUG D PARY("XDEST")
|
||
"RTN","GPLXPATH",318,0)
|
||
Q
|
||
"RTN","GPLXPATH",319,0)
|
||
;
|
||
"RTN","GPLXPATH",320,0)
|
||
REPLACE(REXML,RENEW,REXPATH) ; REPLACE THE XML AT THE XPATH POINT
|
||
"RTN","GPLXPATH",321,0)
|
||
; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE
|
||
"RTN","GPLXPATH",322,0)
|
||
; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE
|
||
"RTN","GPLXPATH",323,0)
|
||
; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD")
|
||
"RTN","GPLXPATH",324,0)
|
||
N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
|
||
"RTN","GPLXPATH",325,0)
|
||
S OLD=$NA(^TMP($J,"REPLACE_OLD"))
|
||
"RTN","GPLXPATH",326,0)
|
||
D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
|
||
"RTN","GPLXPATH",327,0)
|
||
S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
|
||
"RTN","GPLXPATH",328,0)
|
||
S XFIRST=$P(XNODE,"^",1)
|
||
"RTN","GPLXPATH",329,0)
|
||
S XLAST=$P(XNODE,"^",2)
|
||
"RTN","GPLXPATH",330,0)
|
||
I RENEW="" D ; WE ARE DELETING A SECTION, MUST SAVE THE TAG
|
||
"RTN","GPLXPATH",331,0)
|
||
. D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE
|
||
"RTN","GPLXPATH",332,0)
|
||
. D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST
|
||
"RTN","GPLXPATH",333,0)
|
||
I RENEW'="" D ; NEW XML IS NOT NULL
|
||
"RTN","GPLXPATH",334,0)
|
||
. D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE
|
||
"RTN","GPLXPATH",335,0)
|
||
. D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW
|
||
"RTN","GPLXPATH",336,0)
|
||
. D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST
|
||
"RTN","GPLXPATH",337,0)
|
||
I DEBUG W "REPLACE PREBUILD",!
|
||
"RTN","GPLXPATH",338,0)
|
||
I DEBUG D PARY("REBLD")
|
||
"RTN","GPLXPATH",339,0)
|
||
D BUILD("REBLD","RTMP")
|
||
"RTN","GPLXPATH",340,0)
|
||
K @REXML ; KILL WHAT WAS THERE
|
||
"RTN","GPLXPATH",341,0)
|
||
D CP("RTMP",REXML) ; COPY IN THE RESULT
|
||
"RTN","GPLXPATH",342,0)
|
||
Q
|
||
"RTN","GPLXPATH",343,0)
|
||
;
|
||
"RTN","GPLXPATH",344,0)
|
||
MISSING(IXML,OARY) ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY
|
||
"RTN","GPLXPATH",345,0)
|
||
; W "Reporting on the missing",!
|
||
"RTN","GPLXPATH",346,0)
|
||
; W OARY
|
||
"RTN","GPLXPATH",347,0)
|
||
I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q
|
||
"RTN","GPLXPATH",348,0)
|
||
N I
|
||
"RTN","GPLXPATH",349,0)
|
||
S @OARY@(0)=0 ; INITIALIZED MISSING COUNT
|
||
"RTN","GPLXPATH",350,0)
|
||
F I=1:1:@IXML@(0) D ; LOOP THROUGH WHOLE ARRAY
|
||
"RTN","GPLXPATH",351,0)
|
||
. I @IXML@(I)?.E1"@@".E D ; MISSING VARIABLE HERE
|
||
"RTN","GPLXPATH",352,0)
|
||
. . D PUSH^GPLXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY
|
||
"RTN","GPLXPATH",353,0)
|
||
. . Q
|
||
"RTN","GPLXPATH",354,0)
|
||
Q
|
||
"RTN","GPLXPATH",355,0)
|
||
;
|
||
"RTN","GPLXPATH",356,0)
|
||
MAP(IXML,INARY,OXML) ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY
|
||
"RTN","GPLXPATH",357,0)
|
||
; AND PUT THE RESULTS IN OXML
|
||
"RTN","GPLXPATH",358,0)
|
||
I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MAP",! Q
|
||
"RTN","GPLXPATH",359,0)
|
||
I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q
|
||
"RTN","GPLXPATH",360,0)
|
||
N I,J,TNAM,TVAL,TSTR
|
||
"RTN","GPLXPATH",361,0)
|
||
S @OXML@(0)=@IXML@(0) ; TOTAL LINES IN OUTPUT
|
||
"RTN","GPLXPATH",362,0)
|
||
F I=1:1:@OXML@(0) D ; LOOP THROUGH WHOLE ARRAY
|
||
"RTN","GPLXPATH",363,0)
|
||
. S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT
|
||
"RTN","GPLXPATH",364,0)
|
||
. I @OXML@(I)?.E1"@@".E D ; IS THERE A VARIABLE HERE?
|
||
"RTN","GPLXPATH",365,0)
|
||
. . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS
|
||
"RTN","GPLXPATH",366,0)
|
||
. . F J=2:2:10 D Q:$P(@IXML@(I),"@@",J+2)="" ; QUIT IF NO MORE VARS
|
||
"RTN","GPLXPATH",367,0)
|
||
. . . I DEBUG W "IN MAPPING LOOP: ",TSTR,!
|
||
"RTN","GPLXPATH",368,0)
|
||
. . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME
|
||
"RTN","GPLXPATH",369,0)
|
||
. . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED
|
||
"RTN","GPLXPATH",370,0)
|
||
. . . I $D(@INARY@(TNAM)) D ; IS THE VARIABLE IN THE MAP?
|
||
"RTN","GPLXPATH",371,0)
|
||
. . . . I '$D(@INARY@(TNAM,"F")) D ; NOT A SPECIAL FIELD
|
||
"RTN","GPLXPATH",372,0)
|
||
. . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
|
||
"RTN","GPLXPATH",373,0)
|
||
. . . . E D DOFLD ; PROCESS A FIELD
|
||
"RTN","GPLXPATH",374,0)
|
||
. . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER
|
||
"RTN","GPLXPATH",375,0)
|
||
. . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES
|
||
"RTN","GPLXPATH",376,0)
|
||
. . I DEBUG W TSTR
|
||
"RTN","GPLXPATH",377,0)
|
||
I DEBUG W "MAPPED",!
|
||
"RTN","GPLXPATH",378,0)
|
||
Q
|
||
"RTN","GPLXPATH",379,0)
|
||
;
|
||
"RTN","GPLXPATH",380,0)
|
||
DOFLD ; PROCESS A FILEMAN FIELD REFERENCED BY A VARIABLE
|
||
"RTN","GPLXPATH",381,0)
|
||
;
|
||
"RTN","GPLXPATH",382,0)
|
||
Q
|
||
"RTN","GPLXPATH",383,0)
|
||
;
|
||
"RTN","GPLXPATH",384,0)
|
||
TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS
|
||
"RTN","GPLXPATH",385,0)
|
||
; THEXML IS PASSED BY NAME
|
||
"RTN","GPLXPATH",386,0)
|
||
N I,J,TMPXML,DEL,FOUND,INTXT
|
||
"RTN","GPLXPATH",387,0)
|
||
S FOUND=0
|
||
"RTN","GPLXPATH",388,0)
|
||
S INTXT=0
|
||
"RTN","GPLXPATH",389,0)
|
||
I DEBUG W "DELETING EMPTY ELEMENTS",!
|
||
"RTN","GPLXPATH",390,0)
|
||
F I=1:1:(@THEXML@(0)-1) D ; LOOP THROUGH ENTIRE ARRAY
|
||
"RTN","GPLXPATH",391,0)
|
||
. S J=@THEXML@(I)
|
||
"RTN","GPLXPATH",392,0)
|
||
. I J["<text>" D
|
||
"RTN","GPLXPATH",393,0)
|
||
. . S INTXT=1 ; IN HTML SECTION, DON'T TRIM
|
||
"RTN","GPLXPATH",394,0)
|
||
. . I DEBUG W "IN HTML SECTION",!
|
||
"RTN","GPLXPATH",395,0)
|
||
. N JM,JP,JPX ; JMINUS AND JPLUS
|
||
"RTN","GPLXPATH",396,0)
|
||
. S JM=@THEXML@(I-1) ; LINE BEFORE
|
||
"RTN","GPLXPATH",397,0)
|
||
. I JM["</text>" S INTXT=0 ; LEFT HTML SECTION,START TRIM
|
||
"RTN","GPLXPATH",398,0)
|
||
. S JP=@THEXML@(I+1) ; LINE AFTER
|
||
"RTN","GPLXPATH",399,0)
|
||
. I INTXT=0 D ; IF NOT IN AN HTML SECTION
|
||
"RTN","GPLXPATH",400,0)
|
||
. . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH
|
||
"RTN","GPLXPATH",401,0)
|
||
. . I J=JPX D ; AN EMPTY ELEMENT ON TWO LINES
|
||
"RTN","GPLXPATH",402,0)
|
||
. . . I DEBUG W I,J,JP,!
|
||
"RTN","GPLXPATH",403,0)
|
||
. . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
|
||
"RTN","GPLXPATH",404,0)
|
||
. . . S DEL(I)="" ; SET LINE TO DELETE
|
||
"RTN","GPLXPATH",405,0)
|
||
. . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE
|
||
"RTN","GPLXPATH",406,0)
|
||
. . I J["><" D ; AN EMPTY ELEMENT ON ONE LINE
|
||
"RTN","GPLXPATH",407,0)
|
||
. . . I DEBUG W I,J,!
|
||
"RTN","GPLXPATH",408,0)
|
||
. . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
|
||
"RTN","GPLXPATH",409,0)
|
||
. . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED
|
||
"RTN","GPLXPATH",410,0)
|
||
. . . I JM=JPX D ;
|
||
"RTN","GPLXPATH",411,0)
|
||
. . . . I DEBUG W I,JM_J_JPX,!
|
||
"RTN","GPLXPATH",412,0)
|
||
. . . . S DEL(I-1)=""
|
||
"RTN","GPLXPATH",413,0)
|
||
. . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL
|
||
"RTN","GPLXPATH",414,0)
|
||
; . I J'["><" D PUSH("TMPXML",J)
|
||
"RTN","GPLXPATH",415,0)
|
||
I FOUND D ; NEED TO DELETE THINGS
|
||
"RTN","GPLXPATH",416,0)
|
||
. F I=1:1:@THEXML@(0) D ; COPY ARRAY LEAVING OUT DELELTED LINES
|
||
"RTN","GPLXPATH",417,0)
|
||
. . I '$D(DEL(I)) D ; IF THE LINE IS NOT DELETED
|
||
"RTN","GPLXPATH",418,0)
|
||
. . . D PUSH("TMPXML",@THEXML@(I)) ; COPY TO TMPXML ARRAY
|
||
"RTN","GPLXPATH",419,0)
|
||
. D CP("TMPXML",THEXML) ; REPLACE THE XML WITH THE COPY
|
||
"RTN","GPLXPATH",420,0)
|
||
Q FOUND
|
||
"RTN","GPLXPATH",421,0)
|
||
;
|
||
"RTN","GPLXPATH",422,0)
|
||
UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML
|
||
"RTN","GPLXPATH",423,0)
|
||
; XSEC IS A SECTION PASSED BY NAME
|
||
"RTN","GPLXPATH",424,0)
|
||
N XBLD,XTMP
|
||
"RTN","GPLXPATH",425,0)
|
||
D QUEUE("XBLD",XSEC,2,@XSEC@(0)-1) ; BUILD LIST FOR INNER XML
|
||
"RTN","GPLXPATH",426,0)
|
||
D BUILD("XBLD","XTMP") ; BUILD THE RESULT
|
||
"RTN","GPLXPATH",427,0)
|
||
D CP("XTMP",XSEC) ; REPLACE PASSED XML
|
||
"RTN","GPLXPATH",428,0)
|
||
Q
|
||
"RTN","GPLXPATH",429,0)
|
||
;
|
||
"RTN","GPLXPATH",430,0)
|
||
PARY(GLO) ;PRINT AN ARRAY
|
||
"RTN","GPLXPATH",431,0)
|
||
N I
|
||
"RTN","GPLXPATH",432,0)
|
||
F I=1:1:@GLO@(0) W I_" "_@GLO@(I),!
|
||
"RTN","GPLXPATH",433,0)
|
||
Q
|
||
"RTN","GPLXPATH",434,0)
|
||
;
|
||
"RTN","GPLXPATH",435,0)
|
||
H2ARY(IARYRTN,IHASH,IPRE) ; CONVERT IHASH TO RETURN ARRAY
|
||
"RTN","GPLXPATH",436,0)
|
||
; IPRE IS OPTIONAL PREFIX FOR THE ELEMENTS. USED FOR MUPTIPLES 1^"VAR"^VALUE
|
||
"RTN","GPLXPATH",437,0)
|
||
I '$D(IPRE) S IPRE=""
|
||
"RTN","GPLXPATH",438,0)
|
||
N H2I S H2I=""
|
||
"RTN","GPLXPATH",439,0)
|
||
; W $O(@IHASH@(H2I)),!
|
||
"RTN","GPLXPATH",440,0)
|
||
F S H2I=$O(@IHASH@(H2I)) Q:H2I="" D ; FOR EACH ELEMENT OF THE HASH
|
||
"RTN","GPLXPATH",441,0)
|
||
. I $QS(H2I,$QL(H2I))="M" D Q ; SPECIAL CASE FOR MULTIPLES
|
||
"RTN","GPLXPATH",442,0)
|
||
. . ;W H2I_"^"_@IHASH@(H2I),!
|
||
"RTN","GPLXPATH",443,0)
|
||
. . N IH,IHI
|
||
"RTN","GPLXPATH",444,0)
|
||
. . S IH=$NA(@IHASH@(H2I)) ;
|
||
"RTN","GPLXPATH",445,0)
|
||
. . S IH2A=$O(@IH@("")) ; SKIP OVER MULTIPLE DISCRIPTOR
|
||
"RTN","GPLXPATH",446,0)
|
||
. . S IH2=$NA(@IH@(IH2A)) ; PAST THE "M","DIRETIONS" FOR EXAMPLE
|
||
"RTN","GPLXPATH",447,0)
|
||
. . S IHI="" ; INDEX INTO "M" MULTIPLES
|
||
"RTN","GPLXPATH",448,0)
|
||
. . F S IHI=$O(@IH2@(IHI)) Q:IHI="" D ; FOR EACH SUB-MULTIPLE
|
||
"RTN","GPLXPATH",449,0)
|
||
. . . ; W @IH@(IHI)
|
||
"RTN","GPLXPATH",450,0)
|
||
. . . S IH3=$NA(@IH2@(IHI))
|
||
"RTN","GPLXPATH",451,0)
|
||
. . . ; W "HEY",IH3,!
|
||
"RTN","GPLXPATH",452,0)
|
||
. . . D H2ARY(.IARYRTN,IH3,IPRE_";"_IHI) ; RECURSIVE CALL - INDENTED ELEMENTS
|
||
"RTN","GPLXPATH",453,0)
|
||
. . ; W IH,!
|
||
"RTN","GPLXPATH",454,0)
|
||
. . ; W "GPLZZ",!
|
||
"RTN","GPLXPATH",455,0)
|
||
. . ; W $NA(@IHASH@(H2I)),!
|
||
"RTN","GPLXPATH",456,0)
|
||
. . Q ;
|
||
"RTN","GPLXPATH",457,0)
|
||
. D PUSH(IARYRTN,IPRE_"^"_H2I_"^"_@IHASH@(H2I))
|
||
"RTN","GPLXPATH",458,0)
|
||
. ; W @IARYRTN@(0),!
|
||
"RTN","GPLXPATH",459,0)
|
||
Q
|
||
"RTN","GPLXPATH",460,0)
|
||
;
|
||
"RTN","GPLXPATH",461,0)
|
||
XVARS(XVRTN,XVIXML) ; RETURNS AN ARRAY XVRTN OF ALL UNIQUE VARIABLES
|
||
"RTN","GPLXPATH",462,0)
|
||
; DEFINED IN INPUT XML XVIXML BY @@VAR@@
|
||
"RTN","GPLXPATH",463,0)
|
||
; XVRTN AND XVIXML ARE PASSED BY NAME
|
||
"RTN","GPLXPATH",464,0)
|
||
;
|
||
"RTN","GPLXPATH",465,0)
|
||
N XVI,XVTMP,XVT
|
||
"RTN","GPLXPATH",466,0)
|
||
F XVI=1:1:@XVIXML@(0) D ; FOR ALL LINES OF THE XML
|
||
"RTN","GPLXPATH",467,0)
|
||
. S XVT=@XVIXML@(XVI)
|
||
"RTN","GPLXPATH",468,0)
|
||
. I XVT["@@" S XVTMP($P(XVT,"@@",2))=XVI
|
||
"RTN","GPLXPATH",469,0)
|
||
D H2ARY(XVRTN,"XVTMP")
|
||
"RTN","GPLXPATH",470,0)
|
||
Q
|
||
"RTN","GPLXPATH",471,0)
|
||
;
|
||
"RTN","GPLXPATH",472,0)
|
||
DXVARS(DXIN) ;DISPLAY ALL VARIABLES IN A TEMPLATE
|
||
"RTN","GPLXPATH",473,0)
|
||
; IF PARAMETERS ARE NULL, DEFAULTS TO CCR TEMPLATE
|
||
"RTN","GPLXPATH",474,0)
|
||
;
|
||
"RTN","GPLXPATH",475,0)
|
||
N DXUSE,DTMP ; DXUSE IS NAME OF VARIABLE, DTMP IS VARIABLE IF NOT SUPPLIED
|
||
"RTN","GPLXPATH",476,0)
|
||
I DXIN="CCR" D ; NEED TO GO GET CCR TEMPLATE
|
||
"RTN","GPLXPATH",477,0)
|
||
. D LOAD^GPLCCR0("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
|
||
"RTN","GPLXPATH",478,0)
|
||
. S DXUSE="DTMP" ; DXUSE IS NAME
|
||
"RTN","GPLXPATH",479,0)
|
||
E I DXIN="CCD" D ; NEED TO GO GET CCD TEMPLATE
|
||
"RTN","GPLXPATH",480,0)
|
||
. D LOAD^GPLCCD1("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
|
||
"RTN","GPLXPATH",481,0)
|
||
. S DXUSE="DTMP" ; DXUSE IS NAME
|
||
"RTN","GPLXPATH",482,0)
|
||
E S DXUSE=DXIN ; IF PASSED THE TEMPLATE TO USE
|
||
"RTN","GPLXPATH",483,0)
|
||
N DVARS ; PUT VARIABLE NAME RESULTS IN ARRAY HERE
|
||
"RTN","GPLXPATH",484,0)
|
||
D XVARS("DVARS",DXUSE) ; PULL OUT VARS
|
||
"RTN","GPLXPATH",485,0)
|
||
D PARY^GPLXPATH("DVARS") ;AND DISPLAY THEM
|
||
"RTN","GPLXPATH",486,0)
|
||
Q
|
||
"RTN","GPLXPATH",487,0)
|
||
;
|
||
"RTN","GPLXPATH",488,0)
|
||
TEST ; Run all the test cases
|
||
"RTN","GPLXPATH",489,0)
|
||
D TESTALL^GPLUNIT("GPLXPAT0")
|
||
"RTN","GPLXPATH",490,0)
|
||
Q
|
||
"RTN","GPLXPATH",491,0)
|
||
;
|
||
"RTN","GPLXPATH",492,0)
|
||
ZTEST(WHICH) ; RUN ONE SET OF TESTS
|
||
"RTN","GPLXPATH",493,0)
|
||
N ZTMP
|
||
"RTN","GPLXPATH",494,0)
|
||
S DEBUG=1
|
||
"RTN","GPLXPATH",495,0)
|
||
D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
|
||
"RTN","GPLXPATH",496,0)
|
||
D ZTEST^GPLUNIT(.ZTMP,WHICH)
|
||
"RTN","GPLXPATH",497,0)
|
||
Q
|
||
"RTN","GPLXPATH",498,0)
|
||
;
|
||
"RTN","GPLXPATH",499,0)
|
||
TLIST ; LIST THE TESTS
|
||
"RTN","GPLXPATH",500,0)
|
||
N ZTMP
|
||
"RTN","GPLXPATH",501,0)
|
||
D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
|
||
"RTN","GPLXPATH",502,0)
|
||
D TLIST^GPLUNIT(.ZTMP)
|
||
"RTN","GPLXPATH",503,0)
|
||
Q
|
||
"RTN","GPLXPATH",504,0)
|
||
;
|
||
"RTN","LA7QRY1")
|
||
0^23^B12511401
|
||
"RTN","LA7QRY1",1,0)
|
||
LA7QRY1 ;DALOI/JMC - Lab HL7 Query Utility ;01/19/99 13:48
|
||
"RTN","LA7QRY1",2,0)
|
||
;;5.2;AUTOMATED LAB INSTRUMENTS;**46,61**;Sep 27, 1994;Build 15
|
||
"RTN","LA7QRY1",3,0)
|
||
;
|
||
"RTN","LA7QRY1",4,0)
|
||
Q
|
||
"RTN","LA7QRY1",5,0)
|
||
;
|
||
"RTN","LA7QRY1",6,0)
|
||
CHKSC ; Check search NLT/LOINC codes
|
||
"RTN","LA7QRY1",7,0)
|
||
;
|
||
"RTN","LA7QRY1",8,0)
|
||
N J
|
||
"RTN","LA7QRY1",9,0)
|
||
;
|
||
"RTN","LA7QRY1",10,0)
|
||
S J=0
|
||
"RTN","LA7QRY1",11,0)
|
||
F S J=$O(LA7SC(J)) Q:'J D
|
||
"RTN","LA7QRY1",12,0)
|
||
. N X
|
||
"RTN","LA7QRY1",13,0)
|
||
. S X=LA7SC(J)
|
||
"RTN","LA7QRY1",14,0)
|
||
. I $P(X,"^",2)="NLT",$D(^LAM("E",$P(X,"^"))) D Q
|
||
"RTN","LA7QRY1",15,0)
|
||
. . S ^TMP("LA7-NLT",$J,$P(X,"^"))=""
|
||
"RTN","LA7QRY1",16,0)
|
||
. I $P(X,"^",2)="LN",$D(^LAB(95.3,$P($P(X,"^"),"-"))) D Q
|
||
"RTN","LA7QRY1",17,0)
|
||
. . S ^TMP("LA7-LN",$J,$P($P(X,"^"),"-"))=""
|
||
"RTN","LA7QRY1",18,0)
|
||
. S LA7ERR(6)="Unknown search code "_$P(X,"^")_" passed"
|
||
"RTN","LA7QRY1",19,0)
|
||
. K LA7SC(J)
|
||
"RTN","LA7QRY1",20,0)
|
||
Q
|
||
"RTN","LA7QRY1",21,0)
|
||
;
|
||
"RTN","LA7QRY1",22,0)
|
||
;
|
||
"RTN","LA7QRY1",23,0)
|
||
SPEC ; Convert HL7 Specimen Codes to File #61, Topography codes
|
||
"RTN","LA7QRY1",24,0)
|
||
; Find all topographies that use this HL7 specimen code
|
||
"RTN","LA7QRY1",25,0)
|
||
N J,K,L
|
||
"RTN","LA7QRY1",26,0)
|
||
;
|
||
"RTN","LA7QRY1",27,0)
|
||
S J=0
|
||
"RTN","LA7QRY1",28,0)
|
||
F S J=$O(LA7SPEC(J)) Q:'J D
|
||
"RTN","LA7QRY1",29,0)
|
||
. S K=LA7SPEC(J),L=0
|
||
"RTN","LA7QRY1",30,0)
|
||
. F S L=$O(^LAB(61,"HL7",K,L)) Q:'L S ^TMP("LA7-61",$J,L)=""
|
||
"RTN","LA7QRY1",31,0)
|
||
Q
|
||
"RTN","LA7QRY1",32,0)
|
||
;
|
||
"RTN","LA7QRY1",33,0)
|
||
;
|
||
"RTN","LA7QRY1",34,0)
|
||
BUILDMSG ; Build HL7 message with result of query
|
||
"RTN","LA7QRY1",35,0)
|
||
;
|
||
"RTN","LA7QRY1",36,0)
|
||
N HL,HLECH,HLFS,HLQ,LA,LA763,LA7ECH,LA7FS,LA7MSH,LA7NOMSG,LA7NTESN,LA7NVAF,LA7OBRSN,LA7OBXSN,LA7PIDSN,LA7ROOT,LA7X,X
|
||
"RTN","LA7QRY1",37,0)
|
||
;
|
||
"RTN","LA7QRY1",38,0)
|
||
I $L($G(LA7HL7))'=5 S LA7HL7="|^\~&"
|
||
"RTN","LA7QRY1",39,0)
|
||
S (HL("FS"),HLFS,LA7FS)=$E(LA7HL7),(HL("ECH"),HLECH,LA7ECH)=$E(LA7HL7,2,5)
|
||
"RTN","LA7QRY1",40,0)
|
||
S (HLQ,HL("Q"))=""""""
|
||
"RTN","LA7QRY1",41,0)
|
||
; Set flag to not send HL7 message
|
||
"RTN","LA7QRY1",42,0)
|
||
S LA7NOMSG=1
|
||
"RTN","LA7QRY1",43,0)
|
||
; Create dummy MSH to pass HL7 delimiters
|
||
"RTN","LA7QRY1",44,0)
|
||
S LA7MSH(0)="MSH"_LA7FS_LA7ECH_LA7FS
|
||
"RTN","LA7QRY1",45,0)
|
||
D FILESEG^LA7VHLU(GBL,.LA7MSH)
|
||
"RTN","LA7QRY1",46,0)
|
||
;
|
||
"RTN","LA7QRY1",47,0)
|
||
F X="AUTO-INST","LRDFN","LRIDT","SUB","HUID","NLT","RUID","SITE" S LA(X)=""
|
||
"RTN","LA7QRY1",48,0)
|
||
;
|
||
"RTN","LA7QRY1",49,0)
|
||
; Take search results and put in HL7 message structure
|
||
"RTN","LA7QRY1",50,0)
|
||
S LA7ROOT="^TMP(""LA7-QRY"",$J)",(LA7QUIT,LA7PIDSN)=0
|
||
"RTN","LA7QRY1",51,0)
|
||
; F S LA7ROOT=$Q(@LA7ROOT) Q:LA7QUIT D ;change per John M
|
||
"RTN","LA7QRY1",52,0)
|
||
F S LA7ROOT=$Q(@LA7ROOT) Q:LA7ROOT="" D Q:LA7QUIT
|
||
"RTN","LA7QRY1",53,0)
|
||
. I $QS(LA7ROOT,1)'="LA7-QRY"!($QS(LA7ROOT,2)'=$J) S LA7QUIT=1 Q
|
||
"RTN","LA7QRY1",54,0)
|
||
. I LA("LRDFN")'=$QS(LA7ROOT,3) D PID S LA7OBRSN=0
|
||
"RTN","LA7QRY1",55,0)
|
||
. I LA("LRIDT")'=$QS(LA7ROOT,4) D ORC,OBR
|
||
"RTN","LA7QRY1",56,0)
|
||
. I LA("SUB")'=$QS(LA7ROOT,5) D ORC,OBR
|
||
"RTN","LA7QRY1",57,0)
|
||
. I LA("NLT")'=$P($QS(LA7ROOT,6),"!") D ORC,OBR
|
||
"RTN","LA7QRY1",58,0)
|
||
. D OBX
|
||
"RTN","LA7QRY1",59,0)
|
||
;
|
||
"RTN","LA7QRY1",60,0)
|
||
Q
|
||
"RTN","LA7QRY1",61,0)
|
||
;
|
||
"RTN","LA7QRY1",62,0)
|
||
;
|
||
"RTN","LA7QRY1",63,0)
|
||
PID ; Build PID segment
|
||
"RTN","LA7QRY1",64,0)
|
||
;
|
||
"RTN","LA7QRY1",65,0)
|
||
N LA7PID
|
||
"RTN","LA7QRY1",66,0)
|
||
;
|
||
"RTN","LA7QRY1",67,0)
|
||
S (LA("LRDFN"),LRDFN)=$QS(LA7ROOT,3)
|
||
"RTN","LA7QRY1",68,0)
|
||
S LRDPF=$P(^LR(LRDFN,0),"^",2),DFN=$P(^(0),"^",3)
|
||
"RTN","LA7QRY1",69,0)
|
||
D DEM^LRX
|
||
"RTN","LA7QRY1",70,0)
|
||
D PID^LA7VPID(LA("LRDFN"),"",.LA7PID,.LA7PIDSN,.HL)
|
||
"RTN","LA7QRY1",71,0)
|
||
D FILESEG^LA7VHLU(GBL,.LA7PID)
|
||
"RTN","LA7QRY1",72,0)
|
||
S (LA("LRIDT"),LA("SUB"))=""
|
||
"RTN","LA7QRY1",73,0)
|
||
Q
|
||
"RTN","LA7QRY1",74,0)
|
||
;
|
||
"RTN","LA7QRY1",75,0)
|
||
;
|
||
"RTN","LA7QRY1",76,0)
|
||
ORC ; Build ORC segment
|
||
"RTN","LA7QRY1",77,0)
|
||
;
|
||
"RTN","LA7QRY1",78,0)
|
||
N X
|
||
"RTN","LA7QRY1",79,0)
|
||
;
|
||
"RTN","LA7QRY1",80,0)
|
||
S LA("LRIDT")=$QS(LA7ROOT,4),LA("SUB")=$QS(LA7ROOT,5)
|
||
"RTN","LA7QRY1",81,0)
|
||
S LA763(0)=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),0))
|
||
"RTN","LA7QRY1",82,0)
|
||
S X=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),"ORU"))
|
||
"RTN","LA7QRY1",83,0)
|
||
S LA("HUID")=$P(X,"^"),LA("SITE")=$P(X,"^",2),LA("RUID")=$P(X,"^",4)
|
||
"RTN","LA7QRY1",84,0)
|
||
I LA("HUID")="" S LA("HUID")=$P(LA763(0),"^",6)
|
||
"RTN","LA7QRY1",85,0)
|
||
S LA7NVAF=$$NVAF^LA7VHLU2(0),LA7NTESN=0
|
||
"RTN","LA7QRY1",86,0)
|
||
D ORC^LA7VORU
|
||
"RTN","LA7QRY1",87,0)
|
||
S LA("NLT")=""
|
||
"RTN","LA7QRY1",88,0)
|
||
;
|
||
"RTN","LA7QRY1",89,0)
|
||
Q
|
||
"RTN","LA7QRY1",90,0)
|
||
;
|
||
"RTN","LA7QRY1",91,0)
|
||
;
|
||
"RTN","LA7QRY1",92,0)
|
||
OBR ; Build OBR segment
|
||
"RTN","LA7QRY1",93,0)
|
||
;
|
||
"RTN","LA7QRY1",94,0)
|
||
N LA764,LA7NLT
|
||
"RTN","LA7QRY1",95,0)
|
||
;
|
||
"RTN","LA7QRY1",96,0)
|
||
S (LA("NLT"),LA7NLT)=$P($QS(LA7ROOT,6),"!"),(LA764,LA("ORD"))=""
|
||
"RTN","LA7QRY1",97,0)
|
||
I $L(LA7NLT) D
|
||
"RTN","LA7QRY1",98,0)
|
||
. S LA764=+$O(^LAM("E",LA7NLT,0))
|
||
"RTN","LA7QRY1",99,0)
|
||
. I LA764 S LA("ORD")=$$GET1^DIQ(64,LA764_",",.01)
|
||
"RTN","LA7QRY1",100,0)
|
||
I LA("SUB")="CH" D
|
||
"RTN","LA7QRY1",101,0)
|
||
. D OBR^LA7VORU
|
||
"RTN","LA7QRY1",102,0)
|
||
. D NTE^LA7VORU
|
||
"RTN","LA7QRY1",103,0)
|
||
. S LA7OBXSN=0
|
||
"RTN","LA7QRY1",104,0)
|
||
;
|
||
"RTN","LA7QRY1",105,0)
|
||
Q
|
||
"RTN","LA7QRY1",106,0)
|
||
;
|
||
"RTN","LA7QRY1",107,0)
|
||
;
|
||
"RTN","LA7QRY1",108,0)
|
||
OBX ; Build OBX segment
|
||
"RTN","LA7QRY1",109,0)
|
||
;
|
||
"RTN","LA7QRY1",110,0)
|
||
N LA7DATA,LA7VT
|
||
"RTN","LA7QRY1",111,0)
|
||
;
|
||
"RTN","LA7QRY1",112,0)
|
||
S LA7NTESN=0
|
||
"RTN","LA7QRY1",113,0)
|
||
I LA("SUB")="MI" D MI^LA7VORU1 Q
|
||
"RTN","LA7QRY1",114,0)
|
||
I "CYEMSP"[LA("SUB") D AP^LA7VORU2 Q
|
||
"RTN","LA7QRY1",115,0)
|
||
;
|
||
"RTN","LA7QRY1",116,0)
|
||
S LA7VT=$QS(LA7ROOT,7)
|
||
"RTN","LA7QRY1",117,0)
|
||
D OBX^LA7VOBX(LA("LRDFN"),LA("SUB"),LA("LRIDT"),LA7VT,.LA7DATA,.LA7OBXSN,LA7FS,LA7ECH)
|
||
"RTN","LA7QRY1",118,0)
|
||
I '$D(LA7DATA) Q
|
||
"RTN","LA7QRY1",119,0)
|
||
D FILESEG^LA7VHLU(GBL,.LA7DATA)
|
||
"RTN","LA7QRY1",120,0)
|
||
; Send any test interpretation from file #60
|
||
"RTN","LA7QRY1",121,0)
|
||
D INTRP^LA7VORUA
|
||
"RTN","LA7QRY1",122,0)
|
||
;
|
||
"RTN","LA7QRY1",123,0)
|
||
Q
|
||
"VER")
|
||
8.0^22.0
|
||
**END**
|
||
**END**
|