iSharkFly-Open
/
VistA-BMXNET_RPMS_dotNET_UTILITIES-BMX
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
VistA-BMXNET_RPMS_dotNET_UT.../k/bmx_0231.k

23799 lines
636 KiB
Plaintext
Raw Permalink Blame History

KIDS Distribution saved on Jul 25, 2011@09:55:55
BMX 2.31; Fixes infinite loop caused by Error Trap
**KIDS**:BMX 2.31^
**INSTALL NAME**
BMX 2.31
"BLD",7644,0)
BMX 2.31^BMXNET RPMS .NET UTILITIES^0^3110725^n
"BLD",7644,1,0)
^^23^23^3110725^
"BLD",7644,1,1,0)
BMXNet .NET Connectivity utilities for RPMS.
"BLD",7644,1,2,0)
Version 2.0 kids build to support BMXNet20.dll
"BLD",7644,1,3,0)
"BLD",7644,1,4,0)
Version 2.1 adds support to GT.M.
"BLD",7644,1,5,0)
"BLD",7644,1,6,0)
Version 2.2 adds a few bug fixes:
"BLD",7644,1,7,0)
- Process Name is now set in BMXMON
"BLD",7644,1,8,0)
- Timeout is now correct:
"BLD",7644,1,9,0)
- 10 seconds for 1st connection
"BLD",7644,1,10,0)
- 180 seconds for continuation
"BLD",7644,1,11,0)
- Kernel Broker Timeout for regular use
"BLD",7644,1,12,0)
- Divisions are now presented to the user if the user has more than one
"BLD",7644,1,13,0)
division in his/her profile.
"BLD",7644,1,14,0)
Version 2.2 requires BMXNet22.dll
"BLD",7644,1,15,0)
"BLD",7644,1,16,0)
Version 2.3 (Dec 12 2010)
"BLD",7644,1,17,0)
Screens network errors and not log them into the error trap.
"BLD",7644,1,18,0)
Process Name set causes an error on Cache. Now fixed.
"BLD",7644,1,19,0)
Requires BMXNet23.dll
"BLD",7644,1,20,0)
"BLD",7644,1,21,0)
Version 2.31 (Jul 25 2011)
"BLD",7644,1,22,0)
Error trap corrections in v 2.3 introduced a bug that causes an infinite
"BLD",7644,1,23,0)
loop in the error trap causing a hard drive to fill up. This is fixed.
"BLD",7644,4,0)
^9.64PA^90093.9^6
"BLD",7644,4,90093.1,0)
90093.1
"BLD",7644,4,90093.1,222)
y^y^f^^^^n
"BLD",7644,4,90093.2,0)
90093.2
"BLD",7644,4,90093.2,222)
y^y^f^^n^^y^o^n
"BLD",7644,4,90093.5,0)
90093.5
"BLD",7644,4,90093.5,222)
y^y^f^^^^n
"BLD",7644,4,90093.9,0)
90093.9
"BLD",7644,4,90093.9,222)
y^y^f^^^^n
"BLD",7644,4,90093.98,0)
90093.98
"BLD",7644,4,90093.98,222)
y^y^f^^^^n
"BLD",7644,4,90093.99,0)
90093.99
"BLD",7644,4,90093.99,222)
y^y^f^^n^^y^a^n
"BLD",7644,4,"B",90093.1,90093.1)
"BLD",7644,4,"B",90093.2,90093.2)
"BLD",7644,4,"B",90093.5,90093.5)
"BLD",7644,4,"B",90093.9,90093.9)
"BLD",7644,4,"B",90093.98,90093.98)
"BLD",7644,4,"B",90093.99,90093.99)
"BLD",7644,6.3)
16
"BLD",7644,"ABPKG")
n
"BLD",7644,"INIT")
"BLD",7644,"KRN",0)
^9.67PA^8989.52^19
"BLD",7644,"KRN",.4,0)
.4
"BLD",7644,"KRN",.4,"NM",0)
^9.68A^^
"BLD",7644,"KRN",.401,0)
.401
"BLD",7644,"KRN",.402,0)
.402
"BLD",7644,"KRN",.402,"NM",0)
^9.68A^1^1
"BLD",7644,"KRN",.402,"NM",1,0)
BMX MONITOR EDIT FILE #90093.5^90093.5^0
"BLD",7644,"KRN",.402,"NM","B","BMX MONITOR EDIT FILE #90093.5",1)
"BLD",7644,"KRN",.403,0)
.403
"BLD",7644,"KRN",.5,0)
.5
"BLD",7644,"KRN",.84,0)
.84
"BLD",7644,"KRN",3.6,0)
3.6
"BLD",7644,"KRN",3.8,0)
3.8
"BLD",7644,"KRN",9.2,0)
9.2
"BLD",7644,"KRN",9.8,0)
9.8
"BLD",7644,"KRN",9.8,"NM",0)
^9.68A^117^59
"BLD",7644,"KRN",9.8,"NM",45,0)
BMXADOV1^^0^B71930345
"BLD",7644,"KRN",9.8,"NM",58,0)
BMXMON^^0^B199224797
"BLD",7644,"KRN",9.8,"NM",59,0)
BMXADE1^^0^B11418056
"BLD",7644,"KRN",9.8,"NM",60,0)
BMXADE2^^0^B13063702
"BLD",7644,"KRN",9.8,"NM",61,0)
BMXADO^^0^B32349097
"BLD",7644,"KRN",9.8,"NM",62,0)
BMXADO2^^0^B10227201
"BLD",7644,"KRN",9.8,"NM",63,0)
BMXADOF^^0^B90964967
"BLD",7644,"KRN",9.8,"NM",64,0)
BMXADOF1^^0^B12833341
"BLD",7644,"KRN",9.8,"NM",65,0)
BMXADOF2^^0^B7123769
"BLD",7644,"KRN",9.8,"NM",66,0)
BMXADOFD^^0^B8876207
"BLD",7644,"KRN",9.8,"NM",67,0)
BMXADOFS^^0^B38538227
"BLD",7644,"KRN",9.8,"NM",68,0)
BMXADOI^^0^B6267463
"BLD",7644,"KRN",9.8,"NM",69,0)
BMXADOS^^0^B78902997
"BLD",7644,"KRN",9.8,"NM",70,0)
BMXADOS1^^0^B9622665
"BLD",7644,"KRN",9.8,"NM",71,0)
BMXADOV^^0^B22947698
"BLD",7644,"KRN",9.8,"NM",72,0)
BMXADOV2^^0^B19908593
"BLD",7644,"KRN",9.8,"NM",73,0)
BMXADOVJ^^0^B8677686
"BLD",7644,"KRN",9.8,"NM",74,0)
BMXADOX^^0^B208011638
"BLD",7644,"KRN",9.8,"NM",75,0)
BMXADOX1^^0^B84889528
"BLD",7644,"KRN",9.8,"NM",76,0)
BMXADOX2^^0^B11989229
"BLD",7644,"KRN",9.8,"NM",77,0)
BMXADOXX^^0^B166011930
"BLD",7644,"KRN",9.8,"NM",78,0)
BMXADOXY^^0^B61093377
"BLD",7644,"KRN",9.8,"NM",79,0)
BMXFIND^^0^B45092715
"BLD",7644,"KRN",9.8,"NM",80,0)
BMXG^^0^B2718298
"BLD",7644,"KRN",9.8,"NM",81,0)
BMXGETS^^0^B15016739
"BLD",7644,"KRN",9.8,"NM",82,0)
BMXMBRK^^0^B32854296
"BLD",7644,"KRN",9.8,"NM",83,0)
BMXMBRK2^^0^B17554247
"BLD",7644,"KRN",9.8,"NM",84,0)
BMXMEVN^^0^B41862703
"BLD",7644,"KRN",9.8,"NM",85,0)
BMXMSEC^^0^B8709977
"BLD",7644,"KRN",9.8,"NM",86,0)
BMXPRS^^0^B8898368
"BLD",7644,"KRN",9.8,"NM",87,0)
BMXRPC^^0^B21470311
"BLD",7644,"KRN",9.8,"NM",88,0)
BMXRPC1^^0^B52168951
"BLD",7644,"KRN",9.8,"NM",89,0)
BMXRPC2^^0^B11504982
"BLD",7644,"KRN",9.8,"NM",90,0)
BMXRPC3^^0^B39843476
"BLD",7644,"KRN",9.8,"NM",91,0)
BMXRPC4^^0^B28124037
"BLD",7644,"KRN",9.8,"NM",92,0)
BMXRPC5^^0^B15030574
"BLD",7644,"KRN",9.8,"NM",93,0)
BMXRPC6^^0^B14693179
"BLD",7644,"KRN",9.8,"NM",94,0)
BMXRPC7^^0^B40496291
"BLD",7644,"KRN",9.8,"NM",95,0)
BMXRPC8^^0^B5993639
"BLD",7644,"KRN",9.8,"NM",96,0)
BMXRPC9^^0^B45877662
"BLD",7644,"KRN",9.8,"NM",97,0)
BMXSQL^^0^B109951806
"BLD",7644,"KRN",9.8,"NM",98,0)
BMXSQL1^^0^B112955506
"BLD",7644,"KRN",9.8,"NM",99,0)
BMXSQL2^^0^B9590811
"BLD",7644,"KRN",9.8,"NM",100,0)
BMXSQL3^^0^B190410807
"BLD",7644,"KRN",9.8,"NM",101,0)
BMXSQL4^^0^B3594616
"BLD",7644,"KRN",9.8,"NM",102,0)
BMXSQL5^^0^B51902207
"BLD",7644,"KRN",9.8,"NM",103,0)
BMXSQL6^^0^B130304448
"BLD",7644,"KRN",9.8,"NM",104,0)
BMXSQL7^^0^B65321243
"BLD",7644,"KRN",9.8,"NM",105,0)
BMXSQL91^^0^B25109398
"BLD",7644,"KRN",9.8,"NM",106,0)
BMXTABLE^^0^B130270
"BLD",7644,"KRN",9.8,"NM",107,0)
BMXTRS^^0^B1202427
"BLD",7644,"KRN",9.8,"NM",108,0)
BMXUTL1^^0^B39816098
"BLD",7644,"KRN",9.8,"NM",109,0)
BMXUTL2^^0^B1806952
"BLD",7644,"KRN",9.8,"NM",110,0)
BMXUTL5^^0^B16165811
"BLD",7644,"KRN",9.8,"NM",111,0)
BMXUTL6^^0^B582471
"BLD",7644,"KRN",9.8,"NM",114,0)
BMXE01^^0^B6931626
"BLD",7644,"KRN",9.8,"NM",115,0)
BMXNTEG^^0^B7300059
"BLD",7644,"KRN",9.8,"NM",116,0)
BMXPO^^0^B4666839
"BLD",7644,"KRN",9.8,"NM",117,0)
BMXUTL7^^0^B65930
"BLD",7644,"KRN",9.8,"NM","B","BMXADE1",59)
"BLD",7644,"KRN",9.8,"NM","B","BMXADE2",60)
"BLD",7644,"KRN",9.8,"NM","B","BMXADO",61)
"BLD",7644,"KRN",9.8,"NM","B","BMXADO2",62)
"BLD",7644,"KRN",9.8,"NM","B","BMXADOF",63)
"BLD",7644,"KRN",9.8,"NM","B","BMXADOF1",64)
"BLD",7644,"KRN",9.8,"NM","B","BMXADOF2",65)
"BLD",7644,"KRN",9.8,"NM","B","BMXADOFD",66)
"BLD",7644,"KRN",9.8,"NM","B","BMXADOFS",67)
"BLD",7644,"KRN",9.8,"NM","B","BMXADOI",68)
"BLD",7644,"KRN",9.8,"NM","B","BMXADOS",69)
"BLD",7644,"KRN",9.8,"NM","B","BMXADOS1",70)
"BLD",7644,"KRN",9.8,"NM","B","BMXADOV",71)
"BLD",7644,"KRN",9.8,"NM","B","BMXADOV1",45)
"BLD",7644,"KRN",9.8,"NM","B","BMXADOV2",72)
"BLD",7644,"KRN",9.8,"NM","B","BMXADOVJ",73)
"BLD",7644,"KRN",9.8,"NM","B","BMXADOX",74)
"BLD",7644,"KRN",9.8,"NM","B","BMXADOX1",75)
"BLD",7644,"KRN",9.8,"NM","B","BMXADOX2",76)
"BLD",7644,"KRN",9.8,"NM","B","BMXADOXX",77)
"BLD",7644,"KRN",9.8,"NM","B","BMXADOXY",78)
"BLD",7644,"KRN",9.8,"NM","B","BMXE01",114)
"BLD",7644,"KRN",9.8,"NM","B","BMXFIND",79)
"BLD",7644,"KRN",9.8,"NM","B","BMXG",80)
"BLD",7644,"KRN",9.8,"NM","B","BMXGETS",81)
"BLD",7644,"KRN",9.8,"NM","B","BMXMBRK",82)
"BLD",7644,"KRN",9.8,"NM","B","BMXMBRK2",83)
"BLD",7644,"KRN",9.8,"NM","B","BMXMEVN",84)
"BLD",7644,"KRN",9.8,"NM","B","BMXMON",58)
"BLD",7644,"KRN",9.8,"NM","B","BMXMSEC",85)
"BLD",7644,"KRN",9.8,"NM","B","BMXNTEG",115)
"BLD",7644,"KRN",9.8,"NM","B","BMXPO",116)
"BLD",7644,"KRN",9.8,"NM","B","BMXPRS",86)
"BLD",7644,"KRN",9.8,"NM","B","BMXRPC",87)
"BLD",7644,"KRN",9.8,"NM","B","BMXRPC1",88)
"BLD",7644,"KRN",9.8,"NM","B","BMXRPC2",89)
"BLD",7644,"KRN",9.8,"NM","B","BMXRPC3",90)
"BLD",7644,"KRN",9.8,"NM","B","BMXRPC4",91)
"BLD",7644,"KRN",9.8,"NM","B","BMXRPC5",92)
"BLD",7644,"KRN",9.8,"NM","B","BMXRPC6",93)
"BLD",7644,"KRN",9.8,"NM","B","BMXRPC7",94)
"BLD",7644,"KRN",9.8,"NM","B","BMXRPC8",95)
"BLD",7644,"KRN",9.8,"NM","B","BMXRPC9",96)
"BLD",7644,"KRN",9.8,"NM","B","BMXSQL",97)
"BLD",7644,"KRN",9.8,"NM","B","BMXSQL1",98)
"BLD",7644,"KRN",9.8,"NM","B","BMXSQL2",99)
"BLD",7644,"KRN",9.8,"NM","B","BMXSQL3",100)
"BLD",7644,"KRN",9.8,"NM","B","BMXSQL4",101)
"BLD",7644,"KRN",9.8,"NM","B","BMXSQL5",102)
"BLD",7644,"KRN",9.8,"NM","B","BMXSQL6",103)
"BLD",7644,"KRN",9.8,"NM","B","BMXSQL7",104)
"BLD",7644,"KRN",9.8,"NM","B","BMXSQL91",105)
"BLD",7644,"KRN",9.8,"NM","B","BMXTABLE",106)
"BLD",7644,"KRN",9.8,"NM","B","BMXTRS",107)
"BLD",7644,"KRN",9.8,"NM","B","BMXUTL1",108)
"BLD",7644,"KRN",9.8,"NM","B","BMXUTL2",109)
"BLD",7644,"KRN",9.8,"NM","B","BMXUTL5",110)
"BLD",7644,"KRN",9.8,"NM","B","BMXUTL6",111)
"BLD",7644,"KRN",9.8,"NM","B","BMXUTL7",117)
"BLD",7644,"KRN",19,0)
19
"BLD",7644,"KRN",19,"NM",0)
^9.68A^5^5
"BLD",7644,"KRN",19,"NM",1,0)
BMX MONITOR EDIT^^0
"BLD",7644,"KRN",19,"NM",2,0)
BMX MONITOR START^^0
"BLD",7644,"KRN",19,"NM",3,0)
BMX MONITOR STOP^^0
"BLD",7644,"KRN",19,"NM",4,0)
BMXMENU^^0
"BLD",7644,"KRN",19,"NM",5,0)
BMXRPC^^0
"BLD",7644,"KRN",19,"NM","B","BMX MONITOR EDIT",1)
"BLD",7644,"KRN",19,"NM","B","BMX MONITOR START",2)
"BLD",7644,"KRN",19,"NM","B","BMX MONITOR STOP",3)
"BLD",7644,"KRN",19,"NM","B","BMXMENU",4)
"BLD",7644,"KRN",19,"NM","B","BMXRPC",5)
"BLD",7644,"KRN",19.1,0)
19.1
"BLD",7644,"KRN",19.1,"NM",0)
^9.68A^1^1
"BLD",7644,"KRN",19.1,"NM",1,0)
BMXZMENU^^0
"BLD",7644,"KRN",19.1,"NM","B","BMXZMENU",1)
"BLD",7644,"KRN",101,0)
101
"BLD",7644,"KRN",101,"NM",0)
^9.68A^^
"BLD",7644,"KRN",409.61,0)
409.61
"BLD",7644,"KRN",409.61,"NM",0)
^9.68A^^
"BLD",7644,"KRN",771,0)
771
"BLD",7644,"KRN",870,0)
870
"BLD",7644,"KRN",8989.51,0)
8989.51
"BLD",7644,"KRN",8989.51,"NM",0)
^9.68A^^
"BLD",7644,"KRN",8989.52,0)
8989.52
"BLD",7644,"KRN",8994,0)
8994
"BLD",7644,"KRN",8994,"NM",0)
^9.68A^45^45
"BLD",7644,"KRN",8994,"NM",1,0)
BMX ADO SS^^0
"BLD",7644,"KRN",8994,"NM",2,0)
BMX ASYNC GET^^0
"BLD",7644,"KRN",8994,"NM",3,0)
BMX ASYNC QUEUE^^0
"BLD",7644,"KRN",8994,"NM",4,0)
BMX AV CODE^^0
"BLD",7644,"KRN",8994,"NM",5,0)
BMX DEMO^^0
"BLD",7644,"KRN",8994,"NM",6,0)
BMX DENTAL REPORT 1^^0
"BLD",7644,"KRN",8994,"NM",7,0)
BMX DENTAL REPORT 2^^0
"BLD",7644,"KRN",8994,"NM",8,0)
BMX EVENT POLL^^0
"BLD",7644,"KRN",8994,"NM",9,0)
BMX EVENT RAISE^^0
"BLD",7644,"KRN",8994,"NM",10,0)
BMX EVENT REGISTER^^0
"BLD",7644,"KRN",8994,"NM",11,0)
BMX EVENT UNREGISTER^^0
"BLD",7644,"KRN",8994,"NM",12,0)
BMX FIELD LIST^^0
"BLD",7644,"KRN",8994,"NM",13,0)
BMX FIND^^0
"BLD",7644,"KRN",8994,"NM",14,0)
BMX GET VARIABLE VALUE^^0
"BLD",7644,"KRN",8994,"NM",15,0)
BMX HEALTH SUMMARY^^0
"BLD",7644,"KRN",8994,"NM",16,0)
BMX IM HERE^^0
"BLD",7644,"KRN",8994,"NM",17,0)
BMX LOCK^^0
"BLD",7644,"KRN",8994,"NM",18,0)
BMX LOOKUP^^0
"BLD",7644,"KRN",8994,"NM",19,0)
BMX MULT LIST^^0
"BLD",7644,"KRN",8994,"NM",20,0)
BMX NTUSER^^0
"BLD",7644,"KRN",8994,"NM",21,0)
BMX PATIENT DEMOG DATA GET^^0
"BLD",7644,"KRN",8994,"NM",22,0)
BMX PDATA CHART^^0
"BLD",7644,"KRN",8994,"NM",23,0)
BMX SCHEMA ONLY^^0
"BLD",7644,"KRN",8994,"NM",24,0)
BMX SECURITY KEY^^0
"BLD",7644,"KRN",8994,"NM",25,0)
BMX SIGNATURE^^0
"BLD",7644,"KRN",8994,"NM",26,0)
BMX SQL^^0
"BLD",7644,"KRN",8994,"NM",27,0)
BMX SQL COLINFO^^0
"BLD",7644,"KRN",8994,"NM",28,0)
BMX TABLE^^0
"BLD",7644,"KRN",8994,"NM",29,0)
BMX TEST^^0
"BLD",7644,"KRN",8994,"NM",30,0)
BMX TIMER TEST^^0
"BLD",7644,"KRN",8994,"NM",31,0)
BMX TLIST^^0
"BLD",7644,"KRN",8994,"NM",32,0)
BMX UPDATE^^0
"BLD",7644,"KRN",8994,"NM",33,0)
BMX USER^^0
"BLD",7644,"KRN",8994,"NM",34,0)
BMX VERSION INFO^^0
"BLD",7644,"KRN",8994,"NM",35,0)
BMXGetFac^^0
"BLD",7644,"KRN",8994,"NM",36,0)
BMXGetFacRS^^0
"BLD",7644,"KRN",8994,"NM",37,0)
BMXNRC^^0
"BLD",7644,"KRN",8994,"NM",38,0)
BMXNetGetCodes^^0
"BLD",7644,"KRN",8994,"NM",39,0)
BMXNetSetUser^^0
"BLD",7644,"KRN",8994,"NM",40,0)
BMXPatientInfoRS^^0
"BLD",7644,"KRN",8994,"NM",41,0)
BMXPatientLookupRS^^0
"BLD",7644,"KRN",8994,"NM",42,0)
BMXProviderLookupRS^^0
"BLD",7644,"KRN",8994,"NM",43,0)
BMXSetFac^^0
"BLD",7644,"KRN",8994,"NM",44,0)
BMXUserKeyRS^^0
"BLD",7644,"KRN",8994,"NM",45,0)
BMX UTF-8^^0
"BLD",7644,"KRN",8994,"NM","B","BMX ADO SS",1)
"BLD",7644,"KRN",8994,"NM","B","BMX ASYNC GET",2)
"BLD",7644,"KRN",8994,"NM","B","BMX ASYNC QUEUE",3)
"BLD",7644,"KRN",8994,"NM","B","BMX AV CODE",4)
"BLD",7644,"KRN",8994,"NM","B","BMX DEMO",5)
"BLD",7644,"KRN",8994,"NM","B","BMX DENTAL REPORT 1",6)
"BLD",7644,"KRN",8994,"NM","B","BMX DENTAL REPORT 2",7)
"BLD",7644,"KRN",8994,"NM","B","BMX EVENT POLL",8)
"BLD",7644,"KRN",8994,"NM","B","BMX EVENT RAISE",9)
"BLD",7644,"KRN",8994,"NM","B","BMX EVENT REGISTER",10)
"BLD",7644,"KRN",8994,"NM","B","BMX EVENT UNREGISTER",11)
"BLD",7644,"KRN",8994,"NM","B","BMX FIELD LIST",12)
"BLD",7644,"KRN",8994,"NM","B","BMX FIND",13)
"BLD",7644,"KRN",8994,"NM","B","BMX GET VARIABLE VALUE",14)
"BLD",7644,"KRN",8994,"NM","B","BMX HEALTH SUMMARY",15)
"BLD",7644,"KRN",8994,"NM","B","BMX IM HERE",16)
"BLD",7644,"KRN",8994,"NM","B","BMX LOCK",17)
"BLD",7644,"KRN",8994,"NM","B","BMX LOOKUP",18)
"BLD",7644,"KRN",8994,"NM","B","BMX MULT LIST",19)
"BLD",7644,"KRN",8994,"NM","B","BMX NTUSER",20)
"BLD",7644,"KRN",8994,"NM","B","BMX PATIENT DEMOG DATA GET",21)
"BLD",7644,"KRN",8994,"NM","B","BMX PDATA CHART",22)
"BLD",7644,"KRN",8994,"NM","B","BMX SCHEMA ONLY",23)
"BLD",7644,"KRN",8994,"NM","B","BMX SECURITY KEY",24)
"BLD",7644,"KRN",8994,"NM","B","BMX SIGNATURE",25)
"BLD",7644,"KRN",8994,"NM","B","BMX SQL",26)
"BLD",7644,"KRN",8994,"NM","B","BMX SQL COLINFO",27)
"BLD",7644,"KRN",8994,"NM","B","BMX TABLE",28)
"BLD",7644,"KRN",8994,"NM","B","BMX TEST",29)
"BLD",7644,"KRN",8994,"NM","B","BMX TIMER TEST",30)
"BLD",7644,"KRN",8994,"NM","B","BMX TLIST",31)
"BLD",7644,"KRN",8994,"NM","B","BMX UPDATE",32)
"BLD",7644,"KRN",8994,"NM","B","BMX USER",33)
"BLD",7644,"KRN",8994,"NM","B","BMX UTF-8",45)
"BLD",7644,"KRN",8994,"NM","B","BMX VERSION INFO",34)
"BLD",7644,"KRN",8994,"NM","B","BMXGetFac",35)
"BLD",7644,"KRN",8994,"NM","B","BMXGetFacRS",36)
"BLD",7644,"KRN",8994,"NM","B","BMXNRC",37)
"BLD",7644,"KRN",8994,"NM","B","BMXNetGetCodes",38)
"BLD",7644,"KRN",8994,"NM","B","BMXNetSetUser",39)
"BLD",7644,"KRN",8994,"NM","B","BMXPatientInfoRS",40)
"BLD",7644,"KRN",8994,"NM","B","BMXPatientLookupRS",41)
"BLD",7644,"KRN",8994,"NM","B","BMXProviderLookupRS",42)
"BLD",7644,"KRN",8994,"NM","B","BMXSetFac",43)
"BLD",7644,"KRN",8994,"NM","B","BMXUserKeyRS",44)
"BLD",7644,"KRN","B",.4,.4)
"BLD",7644,"KRN","B",.401,.401)
"BLD",7644,"KRN","B",.402,.402)
"BLD",7644,"KRN","B",.403,.403)
"BLD",7644,"KRN","B",.5,.5)
"BLD",7644,"KRN","B",.84,.84)
"BLD",7644,"KRN","B",3.6,3.6)
"BLD",7644,"KRN","B",3.8,3.8)
"BLD",7644,"KRN","B",9.2,9.2)
"BLD",7644,"KRN","B",9.8,9.8)
"BLD",7644,"KRN","B",19,19)
"BLD",7644,"KRN","B",19.1,19.1)
"BLD",7644,"KRN","B",101,101)
"BLD",7644,"KRN","B",409.61,409.61)
"BLD",7644,"KRN","B",771,771)
"BLD",7644,"KRN","B",870,870)
"BLD",7644,"KRN","B",8989.51,8989.51)
"BLD",7644,"KRN","B",8989.52,8989.52)
"BLD",7644,"KRN","B",8994,8994)
"BLD",7644,"PRE")
BMXE01
"BLD",7644,"QUES",0)
^9.62^^
"BLD",7644,"REQB",0)
^9.611^^
"DATA",90093.2,1,0)
2^3^3110125.0629
"DATA",90093.99,1,0)
TEST^2160010
"DATA",90093.99,1,1,0)
^90093.991^6^6
"DATA",90093.99,1,1,1,0)
.01^T^30^PATIENT^0^0^0
"DATA",90093.99,1,1,2,0)
.02^T^6^SEX^0^0^1
"DATA",90093.99,1,1,3,0)
.03^D^12^DOB^0^0^1
"DATA",90093.99,1,1,4,0)
.04^T^30^LOCAL FACILITY^0^0^1
"DATA",90093.99,1,1,5,0)
.04IEN^T^00009^LOCAL FACILITY_IEN^0^0^1
"DATA",90093.99,1,1,6,0)
.01ID^T^99^IDENTIFIERS^1^0^1
"DATA",90093.99,1,1,6,1)
TESTID^BMXADOV1
"DATA",90093.99,1,2,0)
^90093.992^1^1
"DATA",90093.99,1,2,1,0)
ALL PATIENTS
"DATA",90093.99,1,2,1,1)
ALL^BMXADO
"DATA",90093.99,1,2,1,2,0)
^90093.9922^2^2
"DATA",90093.99,1,2,1,2,1,0)
DFN^PATIENT IEN
"DATA",90093.99,1,2,1,2,2,0)
IEN^VISIT IEN
"DATA",90093.99,2,0)
TEST1^2160010
"DATA",90093.99,2,1,0)
^90093.991^6^6
"DATA",90093.99,2,1,1,0)
.03^D^8^DOB^0^0^1
"DATA",90093.99,2,1,2,0)
.04^T^40^LOCAL_FACILITY^0^1^1
"DATA",90093.99,2,1,3,0)
.01^T^30^NAME^0^0^0
"DATA",90093.99,2,1,4,0)
.02^T^4^SEX^0^0^1
"DATA",90093.99,2,1,5,0)
.09^T^30^SSN^0^0^1
"DATA",90093.99,2,1,6,0)
.08^T^30^RELIGION^0^0^1
"DATA",90093.99,3,0)
VISIT^9000010
"DATA",90093.99,3,1,0)
^90093.991^6^6
"DATA",90093.99,3,1,1,0)
.01^D^12^TIMESTAMP^0^0^0
"DATA",90093.99,3,1,2,0)
.03^T^3^TYPE^0^0^0
"DATA",90093.99,3,1,3,0)
.05^T^30^PATIENT^0^0^0
"DATA",90093.99,3,1,4,0)
.06^T^30^FACILITY^0^0^0
"DATA",90093.99,3,1,5,0)
.07^T^10^CATEGORY^0^0^0
"DATA",90093.99,3,1,6,0)
.08^T^30^CLINIC^0^0^1
"DATA",90093.99,3,2,0)
^90093.992^1^1
"DATA",90093.99,3,2,1,0)
POSSIBLE MATCHES
"DATA",90093.99,3,2,1,1)
VLIST^BMXADOF1
"DATA",90093.99,4,0)
GREG^2
"DATA",90093.99,4,1,0)
^90093.991^9^6
"DATA",90093.99,4,1,1,0)
.01^T^30^NAME^0^0^0
"DATA",90093.99,4,1,2,0)
.02^T^4^SEX^0^0^0
"DATA",90093.99,4,1,3,0)
.03^D^12^DOB^0^0^0
"DATA",90093.99,4,1,4,0)
.04IEN^T^00009^LOCAL FACILITY_IEN^0^0^1
"DATA",90093.99,4,1,8,0)
.01ID^T^00017^NAME_ID^0^0^0
"DATA",90093.99,4,1,8,1)
DEMOGR^BMXADOX
"DATA",90093.99,4,1,9,0)
.04^T^30^LOCAL FACILITY^0^0^1
"DATA",90093.99,5,0)
TEST2^2160010.111
"DATA",90093.99,5,1,0)
^90093.991^2^2
"DATA",90093.99,5,1,1,0)
.01^T^30^MEDICATION INSTRUCTIONS^0^0^1
"DATA",90093.99,5,1,2,0)
.02^T^4^LEVEL OF UNDERSTANDING^0^0^1
"DATA",90093.99,6,0)
IHS PATIENT^9000001
"DATA",90093.99,6,1,0)
^90093.991^3^3
"DATA",90093.99,6,1,1,0)
.01^T^30^NAME^0^0^0
"DATA",90093.99,6,1,2,0)
.02^D^21^DATE ESTABLISHED^0^0^1
"DATA",90093.99,6,1,3,0)
.06^T^9^PCIS ID NO.^0^0^1
"DATA",90093.99,7,0)
VISITS^9000010^0
"DATA",90093.99,7,1,0)
^90093.991^7^7
"DATA",90093.99,7,1,1,0)
.01^D^21^TIMESTAMP^0^0^0
"DATA",90093.99,7,1,2,0)
.03^T^3^TYPE^0^0^0
"DATA",90093.99,7,1,3,0)
.05^T^30^PATIENT^0^0^0
"DATA",90093.99,7,1,4,0)
.06^T^30^FACILITY^0^0^0
"DATA",90093.99,7,1,5,0)
.07^T^10^CATEGORY^0^0^0
"DATA",90093.99,7,1,6,0)
.08^T^30^CLINIC^0^0^1
"DATA",90093.99,7,1,7,0)
.05IEN^N^15^PATIENT_IEN^1^0^0
"DATA",90093.99,8,0)
MEASUREMENTS^9000010.01
"DATA",90093.99,8,1,0)
^90093.991^4^4
"DATA",90093.99,8,1,1,0)
.02^T^30^PATIENT NAME^0^0^1
"DATA",90093.99,8,1,2,0)
.03^T^30^VISIT^0^0^1
"DATA",90093.99,8,1,3,0)
.01^T^30^TYPE^0^0^1
"DATA",90093.99,8,1,4,0)
.04^T^100^VALUE^0^0^1
"DATA",90093.99,9,0)
XVISIT^2160010.01
"DATA",90093.99,9,1,0)
^90093.991^2^2
"DATA",90093.99,9,1,1,0)
.01^D^21^VISIT^0^0^1
"DATA",90093.99,9,1,2,0)
.02^T^30^CLINIC^0^0^1
"DATA",90093.99,10,0)
ICD^80
"DATA",90093.99,10,1,0)
^90093.991^3^3
"DATA",90093.99,10,1,1,0)
.01^T^7^CODE NUMBER^0^0^1
"DATA",90093.99,10,1,2,0)
2^T^10^IDENTIFIER^0^0^1
"DATA",90093.99,10,1,3,0)
3^T^30^DIAGNOSIS^0^0^1
"DATA",90093.99,11,0)
PATIENT DEMOGRAPHICS^2^0
"DATA",90093.99,11,1,0)
^90093.991^5^5
"DATA",90093.99,11,1,1,0)
.01^T^30^NAME^0^0^0^0
"DATA",90093.99,11,1,2,0)
.02^T^4^SEX^0^0^1
"DATA",90093.99,11,1,3,0)
.03^D^21^DOB^0^0^1
"DATA",90093.99,11,1,4,0)
.09^T^30^SSN^0^0^1
"DATA",90093.99,11,1,5,0)
.03TRIGGER1^D^21^IDOB^1^0^1
"DATA",90093.99,11,1,5,3)
DATE^BMXADOI
"DATA",90093.99,12,0)
VIEW POVS^9000010.07
"DATA",90093.99,12,1,0)
^90093.991^8^8
"DATA",90093.99,12,1,1,0)
.01^T^30^POV^0^0^0
"DATA",90093.99,12,1,2,0)
.01IEN^T^00009^POV_IEN^0^0^0
"DATA",90093.99,12,1,3,0)
.02^T^30^PATIENT^0^0^0
"DATA",90093.99,12,1,4,0)
.02IEN^T^00009^PATIENT_IEN^0^0^0
"DATA",90093.99,12,1,5,0)
.03^T^30^VISIT^0^0^0
"DATA",90093.99,12,1,6,0)
.03IEN^T^00009^VISIT_IEN^0^0^0
"DATA",90093.99,12,1,7,0)
.04^T^30^PROVIDER NARRATIVE^0^0^0
"DATA",90093.99,12,1,8,0)
.04IEN^T^00009^PROVIDER NARRATIVE_IEN^0^0^0
"DATA",90093.99,13,0)
UPDATE PATIENT DEMOGRAPHICS^2
"DATA",90093.99,13,1,0)
^90093.991^13^13
"DATA",90093.99,13,1,1,0)
.09^T^30^SSN^0^0^0
"DATA",90093.99,13,1,2,0)
.111^T^50^MAILING ADDRESS-STREET^0^0^1
"DATA",90093.99,13,1,3,0)
.112^T^30^STREET ADDRESS [LINE 2]^0^0^1
"DATA",90093.99,13,1,4,0)
.114^T^30^MAILING ADDRESS-CITY^0^0^1
"DATA",90093.99,13,1,5,0)
.115^T^30^MAILING ADDRESS-STATE^0^0^1
"DATA",90093.99,13,1,6,0)
.115IEN^T^00009^MAILING ADDRESS-STATE_IEN^0^0^1
"DATA",90093.99,13,1,7,0)
.116^T^10^MAILING ADDRESS-ZIP^0^0^1
"DATA",90093.99,13,1,8,0)
.131^T^20^HOME PHONE^0^0^1
"DATA",90093.99,13,1,9,0)
.132^T^20^OFFICE PHONE^0^0^1
"DATA",90093.99,13,1,10,0)
.3111^T^30^EMPLOYER^0^0^1
"DATA",90093.99,13,1,11,0)
.31115^T^18^EMPLOYMENT STATUS^0^0^1
"DATA",90093.99,13,1,12,0)
.01^T^30^NAME^0^0^0
"DATA",90093.99,13,1,13,0)
.01ID^T^00017^NAME_ID^0^0^0
"DATA",90093.99,13,1,13,1)
DEMOID^BMXADOI
"DATA",90093.99,14,0)
UPDATE PVT INSURANCE INFO^9000006.11
"DATA",90093.99,14,1,0)
^90093.991^7^7
"DATA",90093.99,14,1,1,0)
.01^T^30^INSURER^0^0^0
"DATA",90093.99,14,1,2,0)
.01IEN^T^00009^INSURER_IEN^0^0^0
"DATA",90093.99,14,1,3,0)
.02^T^30^POLICY NUMBER^0^0^1
"DATA",90093.99,14,1,4,0)
.04^T^30^NAME OF INSURED^0^0^1
"DATA",90093.99,14,1,5,0)
.05^T^30^RELATIONSHIP^0^0^1
"DATA",90093.99,14,1,6,0)
.06^D^21^ELIG. DATE^0^0^1
"DATA",90093.99,14,1,7,0)
.07^D^21^ELIG. END DATE^0^0^1
"DATA",90093.99,15,0)
UPDATE MEDICARE INFO^9000003
"DATA",90093.99,15,1,0)
^90093.991^6^6
"DATA",90093.99,15,1,1,0)
.01^T^30^PATIENT NAME^0^0^1
"DATA",90093.99,15,1,2,0)
.01IEN^T^00009^PATIENT NAME_IEN^0^0^1
"DATA",90093.99,15,1,3,0)
.03^T^9^MEDICARE NUMBER^0^0^1
"DATA",90093.99,15,1,4,0)
.04^T^30^SUFFIX^0^0^1
"DATA",90093.99,15,1,5,0)
.04IEN^T^00009^SUFFIX_IEN^0^0^1
"DATA",90093.99,15,1,6,0)
.15^T^3^MEDICARE CARD COPY ON FILE^0^0^1
"DATA",90093.99,16,0)
UPDATE MEDICARE DATES^9000003.11
"DATA",90093.99,16,1,0)
^90093.991^3^3
"DATA",90093.99,16,1,1,0)
.01^D^21^ELIG. DATE^0^0^1
"DATA",90093.99,16,1,2,0)
.02^D^21^ELIG. END DATE^0^0^1
"DATA",90093.99,16,1,3,0)
.03^T^1^COVERAGE TYPE^0^0
"DATA",90093.99,17,0)
UPDATE MEDICAID INFO^9000004
"DATA",90093.99,17,1,0)
^90093.991^7^7
"DATA",90093.99,17,1,1,0)
.01^T^30^PATIENT NAME^0^0^0
"DATA",90093.99,17,1,2,0)
.01IEN^T^00009^PATIENT NAME_IEN^0^0^0
"DATA",90093.99,17,1,3,0)
.02^T^30^INSURER POINTER^0^0^1
"DATA",90093.99,17,1,4,0)
.02IEN^T^00009^INSURER POINTER_IEN^0^0^1
"DATA",90093.99,17,1,5,0)
.03^T^30^MEDICAID NUMBER^0^0^1
"DATA",90093.99,17,1,6,0)
.04^T^30^STATE^0^0^1
"DATA",90093.99,17,1,7,0)
.04IEN^T^00009^STATE_IEN^0^0^1
"DATA",90093.99,18,0)
UPDATE MEDICAID DATES^9000004.11
"DATA",90093.99,18,1,0)
^90093.991^3^3
"DATA",90093.99,18,1,1,0)
.01^D^21^ELIG. DATE^0^0^0
"DATA",90093.99,18,1,2,0)
.02^D^21^ELIG. END DATE^0^0^1
"DATA",90093.99,18,1,3,0)
.03^T^2^COVERAGE TYPE^0^0^1
"DATA",90093.99,19,0)
VIEW PROBLEMS^9000011
"DATA",90093.99,19,1,0)
^90093.991^13^13
"DATA",90093.99,19,1,1,0)
.01^T^30^ICD CODE^0^0^0
"DATA",90093.99,19,1,2,0)
.01IEN^T^00009^ICD CODE_IEN^0^0^0
"DATA",90093.99,19,1,3,0)
.02^T^30^PATIENT^0^0^0
"DATA",90093.99,19,1,4,0)
.02IEN^T^00009^PATIENT_IEN^0^0^0
"DATA",90093.99,19,1,5,0)
.03^D^21^DATE LAST MODIFIED^0^0^1
"DATA",90093.99,19,1,6,0)
.04^T^16^CLASS^0^0^1
"DATA",90093.99,19,1,7,0)
.05^T^30^PROVIDER NARRATIVE^0^0^1
"DATA",90093.99,19,1,8,0)
.05IEN^T^00009^PROVIDER NARRATIVE_IEN^0^0^1
"DATA",90093.99,19,1,9,0)
.08^D^21^DATE ENTERED^0^0^1
"DATA",90093.99,19,1,10,0)
.12^T^6^STATUS^0^0^1
"DATA",90093.99,19,1,11,0)
.06^T^30^FACILITY^0^0^1
"DATA",90093.99,19,1,12,0)
.06IEN^T^00009^FACILITY_IEN^0^0^1
"DATA",90093.99,19,1,13,0)
.07^N^9^NMBR^0^0^1
"DATA",90093.99,20,0)
UPDATE POVS^9000010.07
"DATA",90093.99,20,1,0)
^90093.991^6^6
"DATA",90093.99,20,1,1,0)
.01^T^30^POV^0^0^0
"DATA",90093.99,20,1,2,0)
.02^T^30^PATIENT NAME^0^0^0
"DATA",90093.99,20,1,3,0)
.03^T^30^VISIT^0^0^0
"DATA",90093.99,20,1,4,0)
.04^T^30^PROVIDER NARRATIVE^0^0^0
"DATA",90093.99,20,1,5,0)
.08^T^11^FIRST/REVISIT^0^0^1
"DATA",90093.99,20,1,6,0)
.12^T^7^PRIMARY/SECONDARY^0^0^1
"DATA",90093.99,21,0)
VIEW MEASUREMENTS^9000010.01
"DATA",90093.99,21,1,0)
^90093.991^7^7
"DATA",90093.99,21,1,1,0)
.01^T^30^TYPE^0^0^0
"DATA",90093.99,21,1,2,0)
.01IEN^T^00009^TYPE_IEN^0^0^0
"DATA",90093.99,21,1,3,0)
.02^T^30^PATIENT NAME^0^0^0
"DATA",90093.99,21,1,4,0)
.02IEN^T^00009^PATIENT NAME_IEN^0^0^0
"DATA",90093.99,21,1,5,0)
.03^T^30^VISIT^0^0^0
"DATA",90093.99,21,1,6,0)
.03IEN^T^00009^VISIT_IEN^0^0^0
"DATA",90093.99,21,1,7,0)
.04^T^100^VALUE^0^0^1
"DATA",90093.99,22,0)
UPDATE MEASUREMENTS^9000010.01
"DATA",90093.99,22,1,0)
^90093.991^5^5
"DATA",90093.99,22,1,1,0)
.01^T^30^TYPE^0^0^0
"DATA",90093.99,22,1,2,0)
.02^T^30^PATIENT NAME^0^0^0
"DATA",90093.99,22,1,3,0)
.03^T^30^VISIT^0^0^0
"DATA",90093.99,22,1,4,0)
.04^T^100^VALUE^0^0^1
"DATA",90093.99,22,1,5,0)
99^T^30^METHOD^0^0^1
"DATA",90093.99,23,0)
VIEW MEDS^9000010.14
"DATA",90093.99,23,1,0)
^90093.991^8^8
"DATA",90093.99,23,1,1,0)
.01^T^30^MEDICATION^0^0^0
"DATA",90093.99,23,1,2,0)
.01IEN^T^00009^MEDICATION_IEN^0^0^0
"DATA",90093.99,23,1,3,0)
.02^T^30^PATIENT NAME^0^0^0
"DATA",90093.99,23,1,4,0)
.02IEN^T^00009^PATIENT NAME_IEN^0^0^0
"DATA",90093.99,23,1,5,0)
.03^T^30^VISIT^0^0^0
"DATA",90093.99,23,1,6,0)
.03IEN^T^00009^VISIT_IEN^0^0^0
"DATA",90093.99,23,1,7,0)
.05^T^32^SIG^0^0^1
"DATA",90093.99,23,1,8,0)
.06^I^7^QUANTITY^0^0^1
"DATA",90093.99,24,0)
UPDATE MEDS^9000010.14
"DATA",90093.99,24,1,0)
^90093.991^5^5
"DATA",90093.99,24,1,1,0)
.01^T^30^MEDICATION^0^0^0
"DATA",90093.99,24,1,2,0)
.02^T^30^PATIENT NAME^0^0^0
"DATA",90093.99,24,1,3,0)
.03^T^30^VISIT^0^0^0
"DATA",90093.99,24,1,4,0)
.05^T^32^SIG^0^0^1
"DATA",90093.99,24,1,5,0)
.06^I^7^QUANTITY^0^0^1
"DATA",90093.99,25,0)
VIEW LABS^9000010.09
"DATA",90093.99,25,1,0)
^90093.991^7^7
"DATA",90093.99,25,1,1,0)
.01^T^30^LAB TEST^0^0^0
"DATA",90093.99,25,1,2,0)
.01IEN^T^00009^LAB TEST_IEN^0^0^0
"DATA",90093.99,25,1,3,0)
.02^T^30^PATIENT NAME^0^0^0
"DATA",90093.99,25,1,4,0)
.02IEN^T^00009^PATIENT NAME_IEN^0^0^0
"DATA",90093.99,25,1,5,0)
.03^T^30^VISIT^0^0^0
"DATA",90093.99,25,1,6,0)
.03IEN^T^00009^VISIT_IEN^0^0^0
"DATA",90093.99,25,1,7,0)
.04^T^200^RESULTS^0^0^1
"DATA",90093.99,26,0)
UPDATE LABS^9000010.09
"DATA",90093.99,26,1,0)
^90093.991^5^5
"DATA",90093.99,26,1,1,0)
.01^T^30^LAB TEST^0^0^0
"DATA",90093.99,26,1,2,0)
.02^T^30^PATIENT NAME^0^0^0
"DATA",90093.99,26,1,3,0)
.03^T^30^VISIT^0^0^0
"DATA",90093.99,26,1,4,0)
.04^T^200^RESULTS^0^0^0
"DATA",90093.99,26,1,5,0)
.05^T^2^ABNORMAL^0^0^1
"DATA",90093.99,27,0)
VIEW EXAMS^9000010.13
"DATA",90093.99,27,1,0)
^90093.991^7^7
"DATA",90093.99,27,1,1,0)
.01^T^30^EXAM^0^0^0
"DATA",90093.99,27,1,2,0)
.01IEN^T^00009^EXAM_IEN^0^0^0
"DATA",90093.99,27,1,3,0)
.02^T^30^PATIENT NAME^0^0^0
"DATA",90093.99,27,1,4,0)
.02IEN^T^00009^PATIENT NAME_IEN^0^0^0
"DATA",90093.99,27,1,5,0)
.03^T^30^VISIT^0^0^0
"DATA",90093.99,27,1,6,0)
.03IEN^T^00009^VISIT_IEN^0^0^0
"DATA",90093.99,27,1,7,0)
.04^T^8^RESULT^0^0^1
"DATA",90093.99,28,0)
UPDATE EXAMS^9000010.13
"DATA",90093.99,28,1,0)
^90093.991^4^4
"DATA",90093.99,28,1,1,0)
.01^T^30^EXAM^0^0^0
"DATA",90093.99,28,1,2,0)
.02^T^30^PATIENT NAME^0^0^0
"DATA",90093.99,28,1,3,0)
.03^T^30^VISIT^0^0^0
"DATA",90093.99,28,1,4,0)
.04^T^8^RESULT^0^0^1
"DATA",90093.99,29,0)
VIEW IMM^9000010.11
"DATA",90093.99,29,1,0)
^90093.991^7^7
"DATA",90093.99,29,1,1,0)
.01^T^30^IMMUNIZATION^0^0^0
"DATA",90093.99,29,1,2,0)
.01IEN^T^00009^IMMUNIZATION_IEN^0^0^0
"DATA",90093.99,29,1,3,0)
.02^T^30^PATIENT NAME^0^0^0
"DATA",90093.99,29,1,4,0)
.02IEN^T^00009^PATIENT NAME_IEN^0^0^0
"DATA",90093.99,29,1,5,0)
.03^T^30^VISIT^0^0^0
"DATA",90093.99,29,1,6,0)
.03IEN^T^00009^VISIT_IEN^0^0^0
"DATA",90093.99,29,1,7,0)
.04^T^18^SERIES^0^0^1
"DATA",90093.99,30,0)
UPDATE IMM^9000010.11
"DATA",90093.99,30,1,0)
^90093.991^4^4
"DATA",90093.99,30,1,1,0)
.01^T^30^IMMUNIZATION^0^0^0
"DATA",90093.99,30,1,2,0)
.02^T^30^PATIENT NAME^0^0^0
"DATA",90093.99,30,1,3,0)
.03^T^30^VISIT^0^0^0
"DATA",90093.99,30,1,4,0)
.04^T^18^SERIES^0^0^1
"DATA",90093.99,31,0)
VIEW PROV^9000010.06
"DATA",90093.99,31,1,0)
^90093.991^7^7
"DATA",90093.99,31,1,1,0)
.01^T^30^PROVIDER^0^0^0
"DATA",90093.99,31,1,2,0)
.01IEN^T^00009^PROVIDER_IEN^0^0^0
"DATA",90093.99,31,1,3,0)
.02^T^30^PATIENT NAME^0^0^0
"DATA",90093.99,31,1,4,0)
.02IEN^T^00009^PATIENT NAME_IEN^0^0^0
"DATA",90093.99,31,1,5,0)
.03^T^30^VISIT^0^0^0
"DATA",90093.99,31,1,6,0)
.03IEN^T^00009^VISIT_IEN^0^0^0
"DATA",90093.99,31,1,7,0)
.04^T^7^PRIMARY/SECONDARY^0^0^1
"DATA",90093.99,32,0)
UPDATE PROV^9000010.06
"DATA",90093.99,32,1,0)
^90093.991^4^4
"DATA",90093.99,32,1,1,0)
.01^T^30^PROVIDER^0^0^0
"DATA",90093.99,32,1,2,0)
.02^T^30^PATIENT NAME^0^0^0
"DATA",90093.99,32,1,3,0)
.03^T^30^VISIT^0^0^0
"DATA",90093.99,32,1,4,0)
.04^T^7^PRIMARY/SECONDARY^0^0^1
"DATA",90093.99,33,0)
VIEW PROCEDURES^9000010.08
"DATA",90093.99,33,1,0)
^90093.991^8^8
"DATA",90093.99,33,1,1,0)
.01^T^30^PROCEDURE^0^0^0
"DATA",90093.99,33,1,2,0)
.01IEN^T^00009^PROCEDURE_IEN^0^0^0
"DATA",90093.99,33,1,3,0)
.02^T^30^PATIENT NAME^0^0^0
"DATA",90093.99,33,1,4,0)
.02IEN^T^00009^PATIENT NAME_IEN^0^0^0
"DATA",90093.99,33,1,5,0)
.03^T^30^VISIT^0^0^0
"DATA",90093.99,33,1,6,0)
.03IEN^T^00009^VISIT_IEN^0^0^0
"DATA",90093.99,33,1,7,0)
.05^T^30^DIAGNOSIS^0^0^1
"DATA",90093.99,33,1,8,0)
.05IEN^T^00009^DIAGNOSIS_IEN^0^0^1
"DATA",90093.99,34,0)
UPDATE PROCEDURES^9000010.08
"DATA",90093.99,34,1,0)
^90093.991^4^4
"DATA",90093.99,34,1,1,0)
.01^T^30^PROCEDURE^0^0^0
"DATA",90093.99,34,1,2,0)
.02^T^30^PATIENT NAME^0^0^0
"DATA",90093.99,34,1,3,0)
.03^T^30^VISIT^0^0^0
"DATA",90093.99,34,1,4,0)
.05^T^30^DIAGNOSIS^0^0^1
"DATA",90093.99,35,0)
VIEW CPT^9000010.18
"DATA",90093.99,35,1,0)
^90093.991^6^6
"DATA",90093.99,35,1,1,0)
.01^T^30^CPT^0^0^0
"DATA",90093.99,35,1,2,0)
.01IEN^T^00009^CPT_IEN^0^0^0
"DATA",90093.99,35,1,3,0)
.02^T^30^PATIENT NAME^0^0^0
"DATA",90093.99,35,1,4,0)
.02IEN^T^00009^PATIENT NAME_IEN^0^0^0
"DATA",90093.99,35,1,5,0)
.03^T^30^VISIT^0^0^0
"DATA",90093.99,35,1,6,0)
.03IEN^T^00009^VISIT_IEN^0^0^0
"DATA",90093.99,36,0)
UPDATE CPT^9000010.18
"DATA",90093.99,36,1,0)
^90093.991^4^4
"DATA",90093.99,36,1,1,0)
.01^T^30^CPT^0^0^0
"DATA",90093.99,36,1,2,0)
.02^T^30^PATIENT NAME^0^0^0
"DATA",90093.99,36,1,3,0)
.03^T^30^VISIT^0^0^0
"DATA",90093.99,36,1,4,0)
.04^T^30^PROVIDER NARRATIVE^0^0^1
"DATA",90093.99,37,0)
VIEW HEALTH FACTORS^9000019
"DATA",90093.99,37,1,0)
^90093.991^5^5
"DATA",90093.99,37,1,1,0)
.01^T^30^HEALTH FACTOR^0^0^0
"DATA",90093.99,37,1,2,0)
.01IEN^T^00009^HEALTH FACTOR_IEN^0^0^0
"DATA",90093.99,37,1,3,0)
.02^T^30^PATIENT NAME^0^0^0
"DATA",90093.99,37,1,4,0)
.02IEN^T^00009^PATIENT NAME_IEN^0^0^0
"DATA",90093.99,37,1,5,0)
.03^D^21^DATE NOTED^0^0^1
"DATA",90093.99,38,0)
UPDATE HEALTH FACTORS^9000019
"DATA",90093.99,38,1,0)
^90093.991^3^3
"DATA",90093.99,38,1,1,0)
.01^T^30^HEALTH FACTOR^0^0^0
"DATA",90093.99,38,1,2,0)
.02^T^30^PATIENT NAME^0^0^0
"DATA",90093.99,38,1,3,0)
.03^D^21^DATE NOTED^0^0^1
"DATA",90093.99,39,0)
UPDATE PROBLEMS^9000011
"DATA",90093.99,39,1,0)
^90093.991^9^9
"DATA",90093.99,39,1,1,0)
.01^T^30^DIAGNOSIS^0^0^0
"DATA",90093.99,39,1,2,0)
.02^T^30^PATIENT NAME^0^0^0
"DATA",90093.99,39,1,3,0)
.03^D^21^DATE LAST MODIFIED^0^0^1
"DATA",90093.99,39,1,4,0)
.04^T^16^CLASS^0^0^1
"DATA",90093.99,39,1,5,0)
.05^T^30^PROVIDER NARRATIVE^0^0^0
"DATA",90093.99,39,1,6,0)
.06^T^30^FACILITY^0^0^0
"DATA",90093.99,39,1,7,0)
.07^N^9^NMBR^0^0^0
"DATA",90093.99,39,1,8,0)
.08^D^21^DATE ENTERED^0^0^1
"DATA",90093.99,39,1,9,0)
.12^T^6^STATUS^0^0^0
"DATA",90093.99,40,0)
WEIGHT^9000010.01
"DATA",90093.99,40,1,0)
^90093.991^1^1
"DATA",90093.99,40,1,1,0)
.02
"DATA",90093.99,41,0)
VIEW PERSONAL HISTORY^9000013
"DATA",90093.99,41,1,0)
^90093.991^8^8
"DATA",90093.99,41,1,1,0)
.01^T^30^DIAGNOSIS^0^0^0
"DATA",90093.99,41,1,2,0)
.01IEN^T^00009^DIAGNOSIS_IEN^0^0^0
"DATA",90093.99,41,1,3,0)
.02^T^30^PATIENT NAME^0^0^0
"DATA",90093.99,41,1,4,0)
.02IEN^T^00009^PATIENT NAME_IEN^0^0^0
"DATA",90093.99,41,1,5,0)
.03^D^21^DATE NOTED^0^0^1
"DATA",90093.99,41,1,6,0)
.04^T^30^PROVIDER NARRATIVE^0^0^1
"DATA",90093.99,41,1,7,0)
.04IEN^T^00009^PROVIDER NARRATIVE_IEN^0^0^1
"DATA",90093.99,41,1,8,0)
.05^D^21^DATE OF ONSET^0^0^1
"DATA",90093.99,42,0)
UPDATE PERSONAL HISTORY^9000013
"DATA",90093.99,42,1,0)
^90093.991^5^5
"DATA",90093.99,42,1,1,0)
.01^T^30^DIAGNOSIS^0^0^0
"DATA",90093.99,42,1,2,0)
.02^T^30^PATIENT NAME^0^0^0
"DATA",90093.99,42,1,3,0)
.03^D^21^DATE NOTED^0^0^1
"DATA",90093.99,42,1,4,0)
.04^T^30^PROVIDER NARRATIVE^0^0^0
"DATA",90093.99,42,1,5,0)
.05^D^21^DATE OF ONSET^0^0^1
"DATA",90093.99,43,0)
VIEW FAMILY HISTORY^9000014
"DATA",90093.99,43,1,0)
^90093.991^7^7
"DATA",90093.99,43,1,1,0)
.01^T^30^DIAGNOSIS^0^0^0
"DATA",90093.99,43,1,2,0)
.01IEN^T^00009^DIAGNOSIS_IEN^0^0^0
"DATA",90093.99,43,1,3,0)
.02^T^30^PATIENT NAME^0^0^0
"DATA",90093.99,43,1,4,0)
.02IEN^T^00009^PATIENT NAME_IEN^0^0^0
"DATA",90093.99,43,1,5,0)
.03^D^21^DATE NOTED^0^0^1
"DATA",90093.99,43,1,6,0)
.04^T^30^PROVIDER NARRATIVE^0^0^0
"DATA",90093.99,43,1,7,0)
.04IEN^T^00009^PROVIDER NARRATIVE_IEN^0^0^0
"DATA",90093.99,44,0)
UPDATE FAMILY HISTORY^9000014
"DATA",90093.99,44,1,0)
^90093.991^4^4
"DATA",90093.99,44,1,1,0)
.01^T^30^DIAGNOSIS^0^0^0
"DATA",90093.99,44,1,2,0)
.02^T^30^PATIENT NAME^0^0^0
"DATA",90093.99,44,1,3,0)
.03^D^21^DATE NOTED^0^0^1
"DATA",90093.99,44,1,4,0)
.04^T^30^PROVIDER NARRATIVE^0^0^0
"DATA",90093.99,45,0)
VIEW REPRODUCTIVE FACTORS^9000017
"DATA",90093.99,45,1,0)
^90093.991^7^7
"DATA",90093.99,45,1,1,0)
.01^T^30^NAME^0^0^0
"DATA",90093.99,45,1,2,0)
.01IEN^T^00009^NAME_IEN^0^0^0
"DATA",90093.99,45,1,3,0)
1^T^18^REPRODUCTIVE HISTORY^0^0^1
"DATA",90093.99,45,1,4,0)
1.1^D^21^DATE REPRO HX OBTAINED^0^0^1
"DATA",90093.99,45,1,5,0)
3^T^25^CONTRACEPTION METHOD^0^0^1
"DATA",90093.99,45,1,6,0)
3.05^D^21^CONTRACEPTION BEGUN^0^0^1
"DATA",90093.99,45,1,7,0)
3.1^D^21^DATE METHOD HX OBTAINED^0^0^1
"DATA",90093.99,46,0)
UPDATE REPRODUCTIVE FACTORS^9000017
"DATA",90093.99,46,1,0)
^90093.991^6^6
"DATA",90093.99,46,1,1,0)
.01^T^30^NAME^0^0^0
"DATA",90093.99,46,1,2,0)
1^T^18^REPRODUCTIVE HISTORY^0^0^1
"DATA",90093.99,46,1,3,0)
1.1^D^21^DATE REPRO HX OBTAINED^0^0^1
"DATA",90093.99,46,1,4,0)
3^T^25^CONTRACEPTION METHOD^0^0^1
"DATA",90093.99,46,1,5,0)
3.05^D^21^CONTRACEPTION BEGUN^0^0^1
"DATA",90093.99,46,1,6,0)
3.1^D^21^DATE METHOD HX OBTAINED^0^0^1
"DATA",90093.99,47,0)
MEASUREMENT^9000010.01
"DATA",90093.99,47,1,0)
^90093.991^4^4
"DATA",90093.99,47,1,1,0)
.02^T^30^PATIENT NAME^0^0^1
"DATA",90093.99,47,1,2,0)
.03^T^30^VISIT^0^0^1
"DATA",90093.99,47,1,3,0)
.01^T^30^TYPE^0^0^1
"DATA",90093.99,47,1,4,0)
.04^T^100^VALUE^0^0^1
"DATA",90093.99,48,0)
HORACE^2^0
"DATA",90093.99,48,1,0)
^90093.991^5^5
"DATA",90093.99,48,1,1,0)
.01^T^30^NAME^0^0^0
"DATA",90093.99,48,1,2,0)
.02^T^4^SEX^0^0^1
"DATA",90093.99,48,1,3,0)
.03^D^21^DOB^0^0^1
"DATA",90093.99,48,1,4,0)
.05^T^30^MARITAL STATUS^0^0^1
"DATA",90093.99,48,1,5,0)
.05IEN^T^00009^MARITAL STATUS_IEN^0^0^1
"DATA",90093.99,49,0)
SELECT LAB TESTS^60
"DATA",90093.99,49,1,0)
^90093.991^1^1
"DATA",90093.99,49,1,1,0)
.01^T^40^NAME^0^0^0
"DATA",90093.99,50,0)
UPDATE PROBLEM NUMBER^9000011
"DATA",90093.99,50,1,0)
^90093.991^2^2
"DATA",90093.99,50,1,1,0)
.07^N^9^NMBR^0^0^1
"DATA",90093.99,50,1,2,0)
.12^T^6^STATUS^0^0^1
"DATA",90093.99,51,0)
UPDATE VA PATIENT^2
"DATA",90093.99,51,1,0)
^90093.991^4^4
"DATA",90093.99,51,1,1,0)
.01^T^30^NAME^0^0^0
"DATA",90093.99,51,1,2,0)
.02^T^4^SEX^0^0^0
"DATA",90093.99,51,1,3,0)
.03^D^21^DATE OF BIRTH^0^0^0
"DATA",90093.99,51,1,4,0)
.09^T^30^SOCIAL SECURITY NUMBER^0^0^0
"DATA",90093.99,52,0)
FILEMAN FILES^1^1
"DATA",90093.99,52,1,0)
^90093.991^2^2
"DATA",90093.99,52,1,1,0)
.01^T^45^NAME^0^0^0
"DATA",90093.99,52,1,2,0)
.01TRIGGER1^T^3^SUBFILES PRESENT?^1^0^1
"DATA",90093.99,52,1,2,3)
SFT^BMXADOS1
"DATA",90093.99,53,0)
SUBFILES^1^1
"DATA",90093.99,53,1,0)
^90093.991^2^2
"DATA",90093.99,53,1,1,0)
.01^T^45^NAME^0^0^0
"DATA",90093.99,53,1,2,0)
.01TRIGGER1^T^3^SUBFILES PRESENT?^1^0^1
"DATA",90093.99,53,1,2,3)
SFT^BMXADOS1
"DATA",90093.99,54,0)
FIELDS^1^1
"DATA",90093.99,54,1,0)
^90093.991^8^8
"DATA",90093.99,54,1,1,0)
.01^T^45^NAME^0^0^0
"DATA",90093.99,54,1,2,0)
.001TRIGGER1^T^7^DATA TYPE^1^0^0
"DATA",90093.99,54,1,2,3)
DDT^BMXADOS1
"DATA",90093.99,54,1,3,0)
.01X2^T^8^DEFAULT DATA TYPE^1^0^1
"DATA",90093.99,54,1,4,0)
.01X3^I^5^DEFAULT FIELD LENGTH^1^0^1
"DATA",90093.99,54,1,5,0)
.01X4^T^40^DEFAULT HEADER^1^0^1
"DATA",90093.99,54,1,6,0)
.01X5^T^3^DEFAULT READ ONLY SETTING^1^0^1
"DATA",90093.99,54,1,7,0)
.01X6^T^3^DEFAULT KEY FIELD SETTING^1^0^1
"DATA",90093.99,54,1,8,0)
.01X7^T^3^DEFAULT NULL ALLOWED SETTING^1^0^1
"DATA",90093.99,55,0)
SCHEMAS^90093.99
"DATA",90093.99,55,1,0)
^90093.991^3^3
"DATA",90093.99,55,1,1,0)
.01^T^30^SCHEMA^0^0^0
"DATA",90093.99,55,1,2,0)
.02^N^15^FILE OR SUBFILE NUMBER^0^0^0
"DATA",90093.99,55,1,3,0)
.03^T^5^DATASET IS READ ONLY^0^0^1
"DATA",90093.99,56,0)
SCHEMA DEFINITION^90093.991^0
"DATA",90093.99,56,1,0)
^90093.991^12^12
"DATA",90093.99,56,1,1,0)
.01^T^30^FIELD NUMBER^0^0^0
"DATA",90093.99,56,1,2,0)
.02^T^4^DATA TYPE^0^0^0
"DATA",90093.99,56,1,3,0)
.03^T^5^FIELD LENGTH^0^0^0
"DATA",90093.99,56,1,4,0)
.04^T^30^COLUMN HEADER^0^0^0
"DATA",90093.99,56,1,5,0)
.05^T^3^READ ONLY^0^0^0
"DATA",90093.99,56,1,6,0)
.06^T^3^KEY FIELD^0^0^0
"DATA",90093.99,56,1,7,0)
.07^T^3^NULL ALLOWED^0^0^0
"DATA",90093.99,56,1,8,0)
.08^T^3^IEN AUTOMATICALLY INCLUDED^0^0^1
"DATA",90093.99,56,1,9,0)
.09^T^3^ALWAYS GET INTERNAL VALUE^0^0^1
"DATA",90093.99,56,1,10,0)
1^T^19^AUTO IDENTIFIER EXTR FUNCT^0^0^1
"DATA",90093.99,56,1,11,0)
2^T^19^SPECIAL UPDATE EP^0^0^1
"DATA",90093.99,56,1,12,0)
3^T^17^EXTR FUNCT FOR TRIGGERED VALUE^0^0^1
"DATA",90093.99,57,0)
FILEMAN FILEINFO^1
"DATA",90093.99,57,1,0)
^90093.991^1^1
"DATA",90093.99,57,1,1,0)
.01^T^45^NAME^0^0^0
"DATA",90093.99,58,0)
BMXADO VIEW MEASUREMENTS^9000010.01^1
"DATA",90093.99,58,1,0)
^90093.991^5^5
"DATA",90093.99,58,1,1,0)
.01^T^6^MEASUREMENT MNEMONIC^1^0^0
"DATA",90093.99,58,1,2,0)
.02^T^15^PATIENT LOOKUP VALUE^1^0^0
"DATA",90093.99,58,1,3,0)
.03^T^15^VISIT LOOKUP VALUE^1^0^0
"DATA",90093.99,58,1,4,0)
.04^T^30^VALUE^1^0^1
"DATA",90093.99,58,1,5,0)
.01X^T^30^MEASUREMENT^1^0^0
"DATA",90093.99,59,0)
VEN MOJO DE MEASUREMENT^19707.82
"DATA",90093.99,59,1,0)
^90093.991^20^10
"DATA",90093.99,59,1,3,0)
2.01^T^9^MEASUREMENT TYPE^0^0^0
"DATA",90093.99,59,1,4,0)
2.03^T^30^MEASUREMENT^0^0^1
"DATA",90093.99,59,1,5,0)
2.02^T^30^MEASUREMENT VALUE^0^0^1
"DATA",90093.99,59,1,13,0)
.01TRIGGER3^T^30^ERROR CELL^1^0^1
"DATA",90093.99,59,1,13,3)
ECELL^VENPCCTG
"DATA",90093.99,59,1,15,0)
.01^I^15^TRANSACTION ID^0^0^1
"DATA",90093.99,59,1,16,0)
.02IEN^I^3^SEGMENT IEN^1^0^1
"DATA",90093.99,59,1,17,0)
.03^T^20^TID-SID^0^0^1
"DATA",90093.99,59,1,18,0)
100^T^80^COMMENT^1^0^0
"DATA",90093.99,59,1,19,0)
.001TRIGGER1^I^4^MEASUREMENT IEN^0^0^1
"DATA",90093.99,59,1,19,3)
IEN^VENPCCTG
"DATA",90093.99,59,1,20,0)
999^T^1^NEW ROW^0^0^1
"DATA",90093.99,60,0)
VEN MOJO DE INTRO^19707.82^1
"DATA",90093.99,60,1,0)
^90093.991^24^18
"DATA",90093.99,60,1,1,0)
.01^T^30^TRANSACTION ID^0^0^0
"DATA",90093.99,60,1,5,0)
.05^T^30^PATIENT NAME^0^0^1
"DATA",90093.99,60,1,6,0)
.06^T^6^SEX^0^0^1
"DATA",90093.99,60,1,7,0)
.07^T^10^DOB^0^0^1
"DATA",90093.99,60,1,8,0)
.08^T^15^CHART NUMBER^0^0^1
"DATA",90093.99,60,1,9,0)
.09^T^11^SSN^0^0^1
"DATA",90093.99,60,1,10,0)
99.01^T^15^VCN^0^0^1
"DATA",90093.99,60,1,11,0)
99.02^T^20^VISIT TIMESTAMP^0^0^1
"DATA",90093.99,60,1,13,0)
99.04^T^30^VISIT TYPE^0^0^1
"DATA",90093.99,60,1,14,0)
99.05^T^30^SERVICE CAT^0^0^1
"DATA",90093.99,60,1,15,0)
99.06^T^30^CLINIC^0^0^1
"DATA",90093.99,60,1,18,0)
99.09^T^30^FACILITY NAME^0^0^1
"DATA",90093.99,60,1,19,0)
99.1^D^21^DATE VISIT CREATED^0^0^1
"DATA",90093.99,60,1,20,0)
99.11^D^21^LAST MODIFIED^0^0^1
"DATA",90093.99,60,1,21,0)
100^T^240^COMMENT^0^0^1
"DATA",90093.99,60,1,22,0)
98.01^T^30^FORM^0^0^1
"DATA",90093.99,60,1,23,0)
97.01^T^99^ImagePage1^0^0^1
"DATA",90093.99,60,1,24,0)
97.02^T^99^ImagePage2^0^0^1
"DATA",90093.99,61,0)
GREG2^9000010^1
"DATA",90093.99,61,1,0)
^90093.991^4^4
"DATA",90093.99,61,1,1,0)
.01^D^15^VISIT/ADMIT DATE&TIME^1^0^0
"DATA",90093.99,61,1,2,0)
.02^D^15^DATE VISIT CREATED^1^0^0
"DATA",90093.99,61,1,3,0)
.05^T^30^PATIENT NAME^1^0^0
"DATA",90093.99,61,1,4,0)
.08^T^40^CLINIC^0^0^0
"DATA",90093.99,62,0)
HW OPTION SCHEDULING^19.2^1
"DATA",90093.99,62,1,0)
^90093.991^4^4
"DATA",90093.99,62,1,1,0)
.01^T^30^NAME^1^0^0^0
"DATA",90093.99,62,1,2,0)
2^T^30^QUEUED TO RUN AT WHAT TIME^1^0^1^0
"DATA",90093.99,62,1,3,0)
6^T^30^RESCHEDULING FREQUENCY^0^0^1^0
"DATA",90093.99,62,1,4,0)
9^T^30^SPECIAL QUEUEING^0^0^1^0
"DATA",90093.99,63,0)
HW SD DEVICE1^3.5^1
"DATA",90093.99,63,1,0)
^90093.991^8^8
"DATA",90093.99,63,1,1,0)
.01^T^30^NAME^1
"DATA",90093.99,63,1,2,0)
1^T^30^$I^1
"DATA",90093.99,63,1,3,0)
2^T^30^TYPE^1
"DATA",90093.99,63,1,4,0)
3^T^30^SUBTYPE^1
"DATA",90093.99,63,1,5,0)
4^T^30^ASK DEVICE^0
"DATA",90093.99,63,1,6,0)
5^T^30^ASK PARAMETERS^0
"DATA",90093.99,63,1,7,0)
7^T^30^NEAREST PHONE^0
"DATA",90093.99,63,1,8,0)
8^T^30^KEY OPERATOR^0^^1
"DATA",90093.99,64,0)
HW SD NEW PERSON^200^1
"DATA",90093.99,64,1,0)
^90093.991^6^6
"DATA",90093.99,64,1,1,0)
.01^T^30^NAME^0^0
"DATA",90093.99,64,1,2,0)
1^T^30^INITIAL^0^0
"DATA",90093.99,64,1,3,0)
4^T^30^SEX^0^0
"DATA",90093.99,64,1,4,0)
5^D^15^DOB^0^0
"DATA",90093.99,64,1,5,0)
9^T^30^SSN^0^0
"DATA",90093.99,64,1,6,0)
13^T^30^NICK NAME^0^0
"DATA",90093.99,65,0)
HW SD VISIT1^9000010^1
"DATA",90093.99,65,1,0)
^90093.991^3^3
"DATA",90093.99,65,1,1,0)
.01^D^20^VISIT/ADMIT DATE&TIME^1^0^0
"DATA",90093.99,65,1,2,0)
.05^T^30^PATIENT NAME^1^0^0
"DATA",90093.99,65,1,3,0)
.08^T^30^CLINIC^1^0^0
"DATA",90093.99,66,0)
ScottsdaleDemo^9000001^1
"DATA",90093.99,66,1,0)
^90093.991^3^3
"DATA",90093.99,66,1,1,0)
.01^T^30^NAME^1^0^0
"DATA",90093.99,66,1,2,0)
1102.2^D^30^DOB^1^0^1
"DATA",90093.99,66,1,3,0)
1101.2^T^30^SEX^0^0^1
"DATA",90093.99,67,0)
BMXADO MEASUREMENT TYPES^9999999.07
"DATA",90093.99,67,1,0)
^90093.991^3^3
"DATA",90093.99,67,1,1,0)
.02^T^30^MEASUREMENT NAME^0^0^0
"DATA",90093.99,67,1,2,0)
.01^T^4^MEASUREMENT MNEMONIC^0^0^0
"DATA",90093.99,67,1,3,0)
.03^T^2^CODE^0^0^0
"DATA",90093.99,68,0)
BMXADO DX^19707.82^1
"DATA",90093.99,68,1,0)
^90093.991^16^16
"DATA",90093.99,68,1,1,0)
.01^T^7^ACTION^0^0^0
"DATA",90093.99,68,1,2,0)
.02^T^30^PATIENT IEN^0^0^0^^1
"DATA",90093.99,68,1,3,0)
.03^T^30^VISIT IEN^0^0^0
"DATA",90093.99,68,1,4,0)
.04^D^21^VISIT DATE^0^0^0
"DATA",90093.99,68,1,5,0)
.05^T^30^ICD IEN^0^0^1^^1
"DATA",90093.99,68,1,6,0)
.06^T^9^ICD CODE^0^0^1
"DATA",90093.99,68,1,7,0)
.07^T^30^FACILITY IEN^0^0^1^^1
"DATA",90093.99,68,1,8,0)
.08^T^30^FACILITY ABBR^0^0^1
"DATA",90093.99,68,1,9,0)
.09^I^3^PROBLEM NUMBER^0^0^1
"DATA",90093.99,68,1,10,0)
.1^T^30^PROBLEM IEN^0^0^1^^1
"DATA",90093.99,68,1,11,0)
.11^I^2^NOTE NUMBER^0^0^1
"DATA",90093.99,68,1,12,0)
.12^I^3^NOTE IEN^0^0^1^^1
"DATA",90093.99,68,1,13,0)
.13^I^2^FAC NOTE IEN^0^0^1^^1
"DATA",90093.99,68,1,14,0)
.14^T^80^PROVIDER NARRATIVE^0^0^1
"DATA",90093.99,68,1,15,0)
.15^I^2^PRIMARY-SECONDARY^0^0^1
"DATA",90093.99,68,1,16,0)
.16^T^6^PROBLEM STATUS^0^0^1
"DATA",90093.99,69,0)
BMXADO ADD POV^9000010.07
"DATA",90093.99,69,1,0)
^90093.991^5^5
"DATA",90093.99,69,1,1,0)
.01^T^9^ICD CODE^0^0^0
"DATA",90093.99,69,1,2,0)
.02^T^15^PATIENT LOOKUP VALUE^0^0^0
"DATA",90093.99,69,1,3,0)
.03^T^15^VISIT LOOKUP VALUE^0^0^0
"DATA",90093.99,69,1,4,0)
.04^T^80^PROVIDER NARRATIVE^0^0^0
"DATA",90093.99,69,1,5,0)
.12^T^2^PRIMARY-SECONDARY^0^0^1
"DATA",90093.99,70,0)
BMXADO ADD PROBLEM^9000011
"DATA",90093.99,70,1,0)
^90093.991^7^7
"DATA",90093.99,70,1,1,0)
.01^T^9^ICD CODE^0^0^0
"DATA",90093.99,70,1,2,0)
.02^T^15^PATIENT LOOKUP VALUE^0^0^0
"DATA",90093.99,70,1,3,0)
.03^D^15^DATE LAST MODIFIED^0^0^0
"DATA",90093.99,70,1,4,0)
.05^T^80^PROVIDER NARRATIVE^0^0^0
"DATA",90093.99,70,1,5,0)
.06^T^15^FACILITY LOOKUP VALUE^0^0^0
"DATA",90093.99,70,1,6,0)
.08^D^15^DATE ENTERED^0^0^0
"DATA",90093.99,70,1,7,0)
.12^T^6^STATUS^0^0^0
"DATA",90093.99,71,0)
BMXADO EDIT PROBLEM^9000011
"DATA",90093.99,71,1,0)
^90093.991^4^4
"DATA",90093.99,71,1,1,0)
.01^T^9^ICD CODE^0^0^0
"DATA",90093.99,71,1,2,0)
.03^D^15^DATE LAST MODIFIED^0^0^0
"DATA",90093.99,71,1,3,0)
.05^T^80^PROVIDER NARRATIVE^0^0^0
"DATA",90093.99,71,1,4,0)
.12^T^6^PROBLEM STATUS^0^0^0
"DATA",90093.99,72,0)
BMXADO ADD FHX^9000014
"DATA",90093.99,72,1,0)
^90093.991^4^4
"DATA",90093.99,72,1,1,0)
.01^T^9^ICD CODE^0^0^0
"DATA",90093.99,72,1,2,0)
.02^T^15^PATIENT LOOKUP VALUE^0^0^0
"DATA",90093.99,72,1,3,0)
.03^D^15^DATE NOTED^0^0^0
"DATA",90093.99,72,1,4,0)
.04^T^80^PROVIDER NARRATIVE^0^0^0
"DATA",90093.99,73,0)
BMXADO ADD PERSONAL HISTORY^9000013
"DATA",90093.99,73,1,0)
^90093.991^4^4
"DATA",90093.99,73,1,1,0)
.01^T^9^ICD CODE^0^0^0
"DATA",90093.99,73,1,2,0)
.02^T^15^PATIENT LOOKUP VALUE^0^0^0
"DATA",90093.99,73,1,3,0)
.03^D^15^DATE NOTED^0^0^0
"DATA",90093.99,73,1,4,0)
.04^T^80^PROVIDER NARRATIVE^0^0^0
"DATA",90093.99,74,0)
BMXADO ADD NOTE^9000011.1111
"DATA",90093.99,74,1,0)
^90093.991^1^1
"DATA",90093.99,74,1,1,0)
.03^T^44^NOTE^0^0^0
"DATA",90093.99,75,0)
BMXADO DATA ENTRY TRANSACTION^19707.82
"DATA",90093.99,75,1,0)
^90093.991^21^21
"DATA",90093.99,75,1,1,0)
.01^T^30^TRANSACTION ID^0^0^0
"DATA",90093.99,75,1,2,0)
.02^T^30^SEGMENT^0^0^0
"DATA",90093.99,75,1,3,0)
.03^T^3^ACCEPT NON FATAL ERRORS^0^0^1
"DATA",90093.99,75,1,4,0)
1.01^T^7^DX ACTION^0^0^1
"DATA",90093.99,75,1,5,0)
1.02^T^30^PATIENT IEN^0^0^1
"DATA",90093.99,75,1,6,0)
1.03^T^30^VISIT IEN^0^0^1
"DATA",90093.99,75,1,7,0)
1.04^D^21^VISIT DATE^0^0^1
"DATA",90093.99,75,1,8,0)
1.05^T^30^ICD IEN^0^0^1
"DATA",90093.99,75,1,9,0)
1.06^T^9^ICD CODE^0^0^1
"DATA",90093.99,75,1,10,0)
1.07^T^30^FACILITY IEN^0^0^1
"DATA",90093.99,75,1,11,0)
1.08^T^9^FACILITY ABBREVIATION^0^0^1
"DATA",90093.99,75,1,12,0)
1.09^I^3^PROBLEM NUMBER^0^0^1
"DATA",90093.99,75,1,13,0)
1.1^T^30^PROBLEM IEN^0^0^1
"DATA",90093.99,75,1,14,0)
1.11^I^2^NOTE NUMBER^0^0^1
"DATA",90093.99,75,1,15,0)
1.12^I^3^NOTE IEN^0^0^1
"DATA",90093.99,75,1,16,0)
1.13^I^2^FAC-NOTE IEN^0^0^1
"DATA",90093.99,75,1,17,0)
1.14^T^80^PROVIDER NARRATIVE^0^0^1
"DATA",90093.99,75,1,18,0)
1.15^I^2^PRIMARY-SECONDARY^0^0^1
"DATA",90093.99,75,1,19,0)
1.16^T^6^PROBLEM STATUS^0^0^1
"DATA",90093.99,75,1,20,0)
2.01^T^30^MEASUREMENT TYPE^0^0^1
"DATA",90093.99,75,1,21,0)
2.02^T^80^MEASUREMENT VALUE^0^0^1
"DATA",90093.99,76,0)
VEN MOJO DE CLINIC^19707.82
"DATA",90093.99,76,1,0)
^90093.991^17^8
"DATA",90093.99,76,1,7,0)
3.01^I^4^CLINIC IEN^0^0^0
"DATA",90093.99,76,1,8,0)
3.02^T^30^CLINIC^0^0^0
"DATA",90093.99,76,1,11,0)
.01TRIGGER3^T^30^ERROR CELL^1^0^1
"DATA",90093.99,76,1,11,3)
ECELL^VENPCCTG
"DATA",90093.99,76,1,13,0)
.01^I^15^TRANSACTION ID^0^0^1
"DATA",90093.99,76,1,14,0)
.02IEN^I^3^SEGMENT IEN^1^0^1
"DATA",90093.99,76,1,15,0)
.03^T^20^TID-SID^0^0^1
"DATA",90093.99,76,1,16,0)
100^T^80^COMMENT^1^0^0
"DATA",90093.99,76,1,17,0)
999^T^1^NEW ROW^0^0^1
"DATA",90093.99,77,0)
VEN MOJO DE PROVIDER^19707.82
"DATA",90093.99,77,1,0)
^90093.991^18^9
"DATA",90093.99,77,1,7,0)
4.01^I^5^PROVIDER IEN^0^0^0
"DATA",90093.99,77,1,8,0)
4.02^T^30^PROVIDER^0^0^0
"DATA",90093.99,77,1,11,0)
.01TRIGGER3^T^30^ERROR CELL^1^0^1
"DATA",90093.99,77,1,11,3)
ECELL^VENPCCTG
"DATA",90093.99,77,1,13,0)
4.03^T^12^PRIMARY OR SECONDARY^0^0^1
"DATA",90093.99,77,1,14,0)
.01^I^15^TRANSACTION ID^0^0^1
"DATA",90093.99,77,1,15,0)
.02IEN^I^3^SEGMENT IEN^1^0^1
"DATA",90093.99,77,1,16,0)
.03^T^20^TID-SID^0^0^1
"DATA",90093.99,77,1,17,0)
100^T^80^COMMENT^1^0^0
"DATA",90093.99,77,1,18,0)
999^T^1^NEW ROW^0^0^1
"DATA",90093.99,78,0)
VEN MOJO LIST PENDING FORMS^19707.81^1
"DATA",90093.99,78,1,0)
^90093.991^4^4
"DATA",90093.99,78,1,1,0)
.01^T^30^VISIT^0^0^0
"DATA",90093.99,78,1,2,0)
.02^D^21^VISIT DATE^0^0^1
"DATA",90093.99,78,1,3,0)
.03^T^30^PATIENT^0^0^1
"DATA",90093.99,78,1,4,0)
.04^T^30^LOCATION^0^0^1
"DATA",90093.99,79,0)
VEN MOJO LIST DE FIFO^19707.81
"DATA",90093.99,79,1,0)
^90093.991^3^2
"DATA",90093.99,79,1,1,0)
.01^T^30^VISIT^0^0^0
"DATA",90093.99,79,1,3,0)
.03^T^30^PATIENT^0^0^0
"DATA",90093.99,80,0)
VEN MOJO DRUG LIST^50
"DATA",90093.99,80,1,0)
^90093.991^2^2
"DATA",90093.99,80,1,1,0)
.01^T^40^GENERIC NAME^0^0^0
"DATA",90093.99,80,1,2,0)
5^T^60^STANDARD SIG^0^0^1
"DATA",90093.99,81,0)
VEN MOJO RX LIST^9000010.14
"DATA",90093.99,81,1,0)
^90093.991^5^5
"DATA",90093.99,81,1,1,0)
.01^T^30^MEDICATION^0^0^0
"DATA",90093.99,81,1,2,0)
.01IEN^I^00009^MEDICATION_IEN^0^0^0
"DATA",90093.99,81,1,3,0)
.06^I^7^QUANTITY^0^0^1
"DATA",90093.99,81,1,4,0)
.05^T^32^SIG^0^0^1
"DATA",90093.99,81,1,5,0)
.03^T^30^VISIT^0^0^0
"DATA",90093.99,82,0)
VEN MOJO LIST PROVIDERS^200^1
"DATA",90093.99,82,1,0)
^90093.991^2^2
"DATA",90093.99,82,1,1,0)
.01^T^35^LABEL^0^0^0
"DATA",90093.99,82,1,2,0)
.001TRIGGER1^I^9^IEN^1^0^1
"DATA",90093.99,82,1,2,3)
IEN^VENPCCTG
"DATA",90093.99,83,0)
VEN MOJO LIST CLINICS^40.7
"DATA",90093.99,83,1,0)
^90093.991^4^4
"DATA",90093.99,83,1,1,0)
.01^T^30^CLINIC NAME^0^0^0
"DATA",90093.99,83,1,2,0)
1^T^2^CLINIC CODE^0^0^0
"DATA",90093.99,83,1,3,0)
.001TRIGGER2^I^9^CLINIC NAME IEN^1^0^1
"DATA",90093.99,83,1,3,3)
IEN^VENPCCTG
"DATA",90093.99,83,1,4,0)
.001TRIGGER1^T^36^LABEL^1^0^1
"DATA",90093.99,83,1,4,3)
CLNN^VENPCCTG
"DATA",90093.99,84,0)
VEN MOJO LIST MEASUREMENTS^9999999.07^1
"DATA",90093.99,84,1,0)
^90093.991^3^3
"DATA",90093.99,84,1,1,0)
.01^T^4^MEASUREMENT TYPE^1^0^0
"DATA",90093.99,84,1,2,0)
.02^T^30^LABEL^1^0^0
"DATA",90093.99,84,1,3,0)
.001TRIGGER1^I^9^IEN^1^0^1
"DATA",90093.99,84,1,3,3)
IEN^VENPCCTG
"DATA",90093.99,85,0)
VEN MOJO DE FMT UHC^19707.47
"DATA",90093.99,85,1,0)
^90093.991^1^1
"DATA",90093.99,85,1,1,0)
.01^T^30^HIDDEN COLUMN NAME^0^0^0
"DATA",90093.99,86,0)
VEN MOJO DE DX PROBLEM^9000011
"DATA",90093.99,86,1,0)
^90093.991^5^5
"DATA",90093.99,86,1,1,0)
.01^T^9^ICD CODE^0^0^1
"DATA",90093.99,86,1,2,0)
.05^T^80^PROVIDER NARRATIVE^0^0^1
"DATA",90093.99,86,1,3,0)
.12^T^6^PROBLEM STATUS^0^0^0
"DATA",90093.99,86,1,4,0)
.001TRIGGER1^I^15^PROBLEM IEN^0^0^0
"DATA",90093.99,86,1,4,3)
PRBIEN^VENPCCTG
"DATA",90093.99,86,1,5,0)
.01IEN^I^15^ICD IEN^0^0^1
"DATA",90093.99,87,0)
VEN MOJO DE DX DXHX^19707.82
"DATA",90093.99,87,1,0)
^90093.991^22^20
"DATA",90093.99,87,1,1,0)
.01^T^30^TRANSACTION ID^0^0^0
"DATA",90093.99,87,1,2,0)
.02IEN^I^3^SEGMENT IEN^1^0^0
"DATA",90093.99,87,1,3,0)
1.02^T^30^ACTION^0^0^1
"DATA",90093.99,87,1,5,0)
1.05^I^15^ICD IEN^0^0^1
"DATA",90093.99,87,1,6,0)
1.14^T^80^PROVIDER NARRATIVE^0^0^1
"DATA",90093.99,87,1,7,0)
1.06^T^9^ICD CODE^0^0^1
"DATA",90093.99,87,1,8,0)
1.15^T^9^P/S^0^0^1
"DATA",90093.99,87,1,9,0)
1.18^T^3^ADD TO PROBLEM LIST^0^0^1
"DATA",90093.99,87,1,10,0)
1.16^T^6^PROBLEM STATUS^0^0^1
"DATA",90093.99,87,1,12,0)
.01TRIGGER3^T^60^ERROR CELL^1^0^1
"DATA",90093.99,87,1,12,3)
ECELL^VENPCCTG
"DATA",90093.99,87,1,13,0)
1.1^T^15^PROBLEM IEN^0^0^1
"DATA",90093.99,87,1,14,0)
.03^T^20^TID-SID^0^0^1
"DATA",90093.99,87,1,15,0)
1.11^I^2^NOTE NUMBER^0^0^1
"DATA",90093.99,87,1,16,0)
1.12^I^3^NOTE IEN^0^0^1
"DATA",90093.99,87,1,17,0)
1.13^I^2^FAC-NOTE IEN^0^0^1
"DATA",90093.99,87,1,18,0)
1.17^T^44^NOTE NARRATIVE^0^0^1
"DATA",90093.99,87,1,19,0)
1.21^T^10^NOTE STATUS^0^0^1
"DATA",90093.99,87,1,20,0)
99.01^T^9^NOTE FACILITY^1^0^1
"DATA",90093.99,87,1,21,0)
999^T^1^NEW ROW^0^0^1
"DATA",90093.99,87,1,22,0)
100^T^240^COMMENT^0^0^1
"DATA",90093.99,88,0)
VEN MOJO DE DX NOTE^19707.82^1
"DATA",90093.99,88,1,0)
^90093.991^11^11
"DATA",90093.99,88,1,1,0)
.001FAC^T^9^NOTE FACILITY^1^0^1
"DATA",90093.99,88,1,2,0)
.01^T^3^NOTE NUMBER^1^0^1
"DATA",90093.99,88,1,3,0)
.03^T^44^NOTE NARRATIVE^1^0^1
"DATA",90093.99,88,1,4,0)
.001DA2^I^15^PROBLEM IEN^1^0^1
"DATA",90093.99,88,1,5,0)
.001DA1^I^3^FAC-NOTE IEN^1^0^1
"DATA",90093.99,88,1,6,0)
.001DA^I^3^NOTE IEN^1^0^1
"DATA",90093.99,88,1,7,0)
99ICD^T^9^ICD CODE^1^0^1
"DATA",90093.99,88,1,8,0)
.04^T^9^NOTE STATUS^1^0^1
"DATA",90093.99,88,1,9,0)
99.01^I^15^TRANSACTION ID^1^0^1
"DATA",90093.99,88,1,10,0)
99.02^T^20^TID-SID^1^0^1
"DATA",90093.99,88,1,11,0)
99.03^T^20^ACTION^1^0^1
"DATA",90093.99,89,0)
VEN MOJO DE FMT GRID^19707.48
"DATA",90093.99,89,1,0)
^90093.991^7^7
"DATA",90093.99,89,1,1,0)
.01^T^30^SCHEMA^0^0^0
"DATA",90093.99,89,1,2,0)
.02^T^3^ADD MODE^0^0^1
"DATA",90093.99,89,1,3,0)
.03^T^4^STYLE^0^0^1
"DATA",90093.99,89,1,4,0)
1^T^240^HIDE COLUMN^0^0^1
"DATA",90093.99,89,1,5,0)
2^T^240^BLOCK CELL^0^0^1
"DATA",90093.99,89,1,6,0)
3^T^240^COMBO BOX^0^0^1
"DATA",90093.99,89,1,7,0)
4^T^240^COLUMN WIDTH^0^0^1
"DATA",90093.99,90,0)
VEN MOJO DE ICD MATCH^80
"DATA",90093.99,90,1,0)
^90093.991^3^3
"DATA",90093.99,90,1,1,0)
.01^T^7^ICD CODE^0^0^0
"DATA",90093.99,90,1,2,0)
3^T^30^DIAGNOSIS^0^0^1
"DATA",90093.99,90,1,3,0)
10^T^250^DESCRIPTION^0^0^1
"DATA",90093.99,91,0)
VEN MOJO DE SEGMENT^19707.44
"DATA",90093.99,91,1,0)
^90093.991^2^2
"DATA",90093.99,91,1,1,0)
.01^T^30^NAME^0^0^0
"DATA",90093.99,91,1,2,0)
.03^T^30^SCHEMA^0^0^1
"DATA",90093.99,92,0)
VEN MOJO DE SEG IMAGE^19707.461
"DATA",90093.99,92,1,0)
^90093.991^7^7
"DATA",90093.99,92,1,1,0)
.01^T^30^SEGMENT^0^0^0
"DATA",90093.99,92,1,2,0)
.02^I^1^PAGE^0^0^1
"DATA",90093.99,92,1,3,0)
.03^I^3^X POSITION^0^0^1
"DATA",90093.99,92,1,4,0)
.04^I^3^Y POSITION^0^0^1
"DATA",90093.99,92,1,5,0)
.05^I^3^WIDTH^0^0^1
"DATA",90093.99,92,1,6,0)
.06^I^3^HEIGHT^0^0^1
"DATA",90093.99,92,1,7,0)
.01TRIGGER1^N^3^SEGMENT IEN^0^0^1
"DATA",90093.99,92,1,7,3)
IEN^VENPCCTG
"DATA",90093.99,93,0)
VEN MOJO CHECKIN PATIENTS^2^1
"DATA",90093.99,93,1,0)
^90093.991^6^6
"DATA",90093.99,93,1,1,0)
.01^T^30^NAME^0^0^0
"DATA",90093.99,93,1,2,0)
.02^T^4^SEX^0^0^0^^1
"DATA",90093.99,93,1,3,0)
.03^D^21^DOB^0^0^0
"DATA",90093.99,93,1,4,0)
.09^T^30^SSN^0^0^1
"DATA",90093.99,93,1,5,0)
.001TRIGGER1^T^20^CHART
"DATA",90093.99,93,1,5,3)
HRN^BMXADOV2
"DATA",90093.99,93,1,6,0)
.001TRIGGER2^T^20^PATIENT IEN^1^0^1
"DATA",90093.99,94,0)
VEN MOJO CHECKIN CLINICS^19707.95^1
"DATA",90093.99,94,1,0)
^90093.991^4^4
"DATA",90093.99,94,1,1,0)
.01^T^30^CLINIC^0^0^0
"DATA",90093.99,94,1,2,0)
.001TRIGGER1^I^4^CLINIC IEN^1^0^1
"DATA",90093.99,94,1,2,3)
IEN^VENPCCTG
"DATA",90093.99,94,1,3,0)
2.05^T^30^DEFAULT ENCOUNTER FORM^0^0^1
"DATA",90093.99,94,1,4,0)
2.02^T^30^DEFAULT PROVIDER^0^0^1
"DATA",90093.99,95,0)
VEN MOJO CHECKIN PROVIDERS^200^1
"DATA",90093.99,95,1,0)
^90093.991^3^3
"DATA",90093.99,95,1,1,0)
.01^T^35^PROVIDER^0^0^0
"DATA",90093.99,95,1,2,0)
9999999.02^T^3^CODE^0^0^0
"DATA",90093.99,95,1,3,0)
.001TRIGGER1^I^15^PROVIDER IEN^1^0^1
"DATA",90093.99,95,1,3,3)
IEN^VENPCCTG
"DATA",90093.99,96,0)
VEN MOJO CHECKIN FORMS^19707.41^1
"DATA",90093.99,96,1,0)
^90093.991^4^4
"DATA",90093.99,96,1,1,0)
.01^T^30^FORM^0^0^0
"DATA",90093.99,96,1,2,0)
.001TRIGGER1^I^4^FORM IEN^1^0^1
"DATA",90093.99,96,1,2,3)
IEN^VENPCCTG
"DATA",90093.99,96,1,3,0)
11.01^T^30^FORM ID^0^0^1
"DATA",90093.99,96,1,4,0)
11.02^T^3^DIGITAL VERSION ONLY^0^0^1
"DATA",90093.99,97,0)
VEN MOJO LIST TABLET QUEUE^19707.23^1
"DATA",90093.99,97,1,0)
^90093.991^13^13
"DATA",90093.99,97,1,1,0)
.01^T^30^PATIENT NAME^0^0^0
"DATA",90093.99,97,1,2,0)
.02^T^4^SEX^0^0^1
"DATA",90093.99,97,1,3,0)
.03^D^21^DOB^0^0^1
"DATA",90093.99,97,1,4,0)
.04^T^20^CHART NUMBER^0^0^1
"DATA",90093.99,97,1,5,0)
.05^D^21^TIMESTAMP^0^0^1
"DATA",90093.99,97,1,6,0)
.06^T^7^STATUS^0^0^1
"DATA",90093.99,97,1,7,0)
.07^T^30^USER^0^0^1
"DATA",90093.99,97,1,8,0)
.08^T^30^CLINIC^0^0^1
"DATA",90093.99,97,1,9,0)
.01TRIGGER1^I^15^PATIENT IEN^1^0^1
"DATA",90093.99,97,1,9,3)
IEN^VENPCCTG
"DATA",90093.99,97,1,10,0)
.07TRIGGER1^I^15^USER IEN^1^0^1
"DATA",90093.99,97,1,10,3)
IEN^VENPCCTG
"DATA",90093.99,97,1,11,0)
.08TRIGGER1^I^4^CLINIC IEN^1^0^1
"DATA",90093.99,97,1,11,3)
IEN^VENPCCTG
"DATA",90093.99,97,1,12,0)
.001TRIGGER1^I^6^TABLET QUEUE IEN^1^0^1
"DATA",90093.99,97,1,12,3)
IEN^VENPCCTG
"DATA",90093.99,97,1,13,0)
.13^T^30^UID^0^0^1
"DATA",90093.99,98,0)
VEN MOJO DE RESUME^19707.82
"DATA",90093.99,98,1,0)
^90093.991^6^6
"DATA",90093.99,98,1,1,0)
.01^T^30^TRANSACTION ID^0^0^0
"DATA",90093.99,98,1,2,0)
.05^T^30^PATIENT NAME^0^0^1
"DATA",90093.99,98,1,3,0)
99.03^D^21^VISIT DATE^0^0^1
"DATA",90093.99,98,1,4,0)
98.01^T^30^FORM^0^0^1
"DATA",90093.99,98,1,5,0)
99.12^T^30^UPDATED BY^0^0^1
"DATA",90093.99,98,1,6,0)
99.13^T^10^WORKFLOW STATUS^0^0^1
"DATA",90093.99,99,0)
VEN MOJO DE DX PRB1^19707.82
"DATA",90093.99,99,1,0)
^90093.991^9^9
"DATA",90093.99,99,1,1,0)
.01^T^30^TRANSACTION ID^0^0^0
"DATA",90093.99,99,1,2,0)
.02IEN^I^3^SEGMENT^0^0^1
"DATA",90093.99,99,1,2,3)
IEN^VENPCCT
"DATA",90093.99,99,1,3,0)
.03^T^20^TID-SID^0^0^1
"DATA",90093.99,99,1,4,0)
1.06^T^9^ICD CODE^0^0^1
"DATA",90093.99,99,1,5,0)
1.14^T^80^PROVIDER NARRATIVE^0^0^1
"DATA",90093.99,99,1,6,0)
1.16^T^8^PROBLEM STATUS^0^0^1
"DATA",90093.99,99,1,7,0)
1.1^T^15^PROBLEM IEN^0^0^1
"DATA",90093.99,99,1,8,0)
1.05^T^15^ICD IEN^0^0^1
"DATA",90093.99,99,1,9,0)
999^T^1^NEW ROW^0^0^1
"DATA",90093.99,100,0)
VEN MOJO DE DX NOTE1^19707.82
"DATA",90093.99,100,1,0)
^90093.991^10^10
"DATA",90093.99,100,1,1,0)
.01^T^30^TRANSACTION ID^0^0^0
"DATA",90093.99,100,1,2,0)
.02IEN^T^30^SEGMENT^0^0^1
"DATA",90093.99,100,1,3,0)
.03^T^20^TID-SID^0^0^1
"DATA",90093.99,100,1,4,0)
1.1^T^15^PROBLEM IEN^0^0^1
"DATA",90093.99,100,1,5,0)
1.13^I^2^FAC-NOTE IEN^0^0^1
"DATA",90093.99,100,1,6,0)
1.12^I^3^NOTE IEN^0^0^1
"DATA",90093.99,100,1,7,0)
1.11^I^2^NOTE NUMBER^0^0^1
"DATA",90093.99,100,1,8,0)
1.17^T^44^NOTE NARRATIVE^0^0^1
"DATA",90093.99,100,1,9,0)
1.21^T^6^NOTE STATUS^0^0^1
"DATA",90093.99,100,1,10,0)
999^T^1^NEW ROW^0^0^1
"DATA",90093.99,101,0)
VEN MOJO DE CPT^19707.82
"DATA",90093.99,101,1,0)
^90093.991^8^8
"DATA",90093.99,101,1,1,0)
5.01^T^9^CPT CODE^0^0^1
"DATA",90093.99,101,1,2,0)
5.02^T^60^CPT TEXT^0^0^1
"DATA",90093.99,101,1,3,0)
.01TRIGGER1^T^30^ERROR CELL^1^0^1
"DATA",90093.99,101,1,3,3)
ECELL^VENPCCTG
"DATA",90093.99,101,1,4,0)
.01^I^15^TRANSACTION ID^1^1^0
"DATA",90093.99,101,1,5,0)
.02IEN^I^3^SEGMENT IEN^1^0^0
"DATA",90093.99,101,1,6,0)
.03^T^20^TID-SID^1^0^0
"DATA",90093.99,101,1,7,0)
100^T^80^COMMENT^1^0^1
"DATA",90093.99,101,1,8,0)
999^T^1^NEW ROW^0^0^1
"DATA",90093.99,102,0)
VEN KB CATEGORY^19707.11^1
"DATA",90093.99,102,1,0)
^90093.991^2^2
"DATA",90093.99,102,1,1,0)
.01^T^30^KB GROUP^1^0^0
"DATA",90093.99,102,1,2,0)
.001TRIGGER1^N^4^IEN^1^0^1
"DATA",90093.99,102,1,2,3)
IEN^VENPCCU
"DATA",90093.99,103,0)
VEN KB ITEM^19707.12
"DATA",90093.99,103,1,0)
^90093.991^12^12
"DATA",90093.99,103,1,1,0)
.01^T^30^TYPE^0^0^0
"DATA",90093.99,103,1,2,0)
.02^T^80^TITLE^0^0^1
"DATA",90093.99,103,1,3,0)
.04^T^16^EXTERNAL CODE^0^0^1
"DATA",90093.99,103,1,4,0)
.07^I^2^START WKS GESTATION^0^0^1
"DATA",90093.99,103,1,5,0)
.08^I^2^STOP WKS GESTATON^0^0^1
"DATA",90093.99,103,1,6,0)
.09^T^8^SCHEDULING INTERVAL^0^0^1
"DATA",90093.99,103,1,7,0)
.1^T^4^GENDER SCREEN^0^0^1
"DATA",90093.99,103,1,8,0)
.11^T^3^INACTIVATED^0^0^1
"DATA",90093.99,103,1,9,0)
.12^T^60^MODIFIER TEXT^0^0^1
"DATA",90093.99,103,1,10,0)
.13^N^8^EXTERNAL START AGE^0^0^1
"DATA",90093.99,103,1,11,0)
.14^N^8^EXTERNAL STOP AGE^0^0^1
"DATA",90093.99,103,1,12,0)
.15^T^30^ICD TAXONOMY^0^0^1
"DATA",90093.99,104,0)
VEN KB TEMPLATES^19707.41
"DATA",90093.99,104,1,0)
^90093.991^2^2
"DATA",90093.99,104,1,1,0)
.01^T^30^TEMPLATE^0^0^0
"DATA",90093.99,104,1,2,0)
.001TRIGGER1^N^4^IEN
"DATA",90093.99,104,1,2,3)
IEN^VENPCCU
"DATA",90093.99,105,0)
VEN KB TAXONOMY^9002226
"DATA",90093.99,105,1,0)
^90093.991^2^2
"DATA",90093.99,105,1,1,0)
.01^T^30^NAME^0^0^0
"DATA",90093.99,105,1,2,0)
.001TRIGGER1^N^6^IEN^1^0^1
"DATA",90093.99,105,1,2,3)
IEN^VENPCCU
"DATA",90093.99,106,0)
VEN UP DISCIPLINES^7
"DATA",90093.99,106,1,0)
^90093.991^2^2
"DATA",90093.99,106,1,1,0)
.01^T^30^DISCIPLINE^0^0^0
"DATA",90093.99,106,1,2,0)
.001TRIGGER1^N^4^IEN^1^0^1
"DATA",90093.99,106,1,2,3)
IEN^VENPCCU
"DATA",90093.99,107,0)
VEN UP CLINIC STOPS^40.7
"DATA",90093.99,107,1,0)
^90093.991^2^2
"DATA",90093.99,107,1,1,0)
.01^T^30^CLINIC^0^0^0
"DATA",90093.99,107,1,2,0)
.001TRIGGER1^N^4^CLINIC^1^0^1
"DATA",90093.99,107,1,2,3)
IEN^VENPCCU
"DATA",90093.99,108,0)
VEN UP ICD GROUPS^19707.33
"DATA",90093.99,108,1,0)
^90093.991^1^1
"DATA",90093.99,108,1,1,0)
.001TRIGGER1^N^4^IDC PREFERENCE SET^1^0^1
"DATA",90093.99,108,1,1,3)
IEN^VENPCCU
"DATA",90093.99,109,0)
VEN UP ICD ITEMS^19707.34
"DATA",90093.99,109,1,0)
^90093.991^22^22
"DATA",90093.99,109,1,1,0)
.01^T^30^OWNER^0^0^0
"DATA",90093.99,109,1,2,0)
.02^T^30^DX PREFERENCE GROUP^0^0^1
"DATA",90093.99,109,1,3,0)
.03^T^80^PRINTED NAME^0^0^1
"DATA",90093.99,109,1,4,0)
.04^T^9^ICD CODE^0^0^1
"DATA",90093.99,109,1,5,0)
.07^T^80^ICD TEXT^0^0^1
"DATA",90093.99,109,1,6,0)
.08^I^6^SORT ORDER NUMBER^0^0^1
"DATA",90093.99,109,1,7,0)
1.01^T^3^INFANT^0^0^1
"DATA",90093.99,109,1,8,0)
1.02^I^7^INFANT TOTAL^0^0^1
"DATA",90093.99,109,1,9,0)
1.03^T^3^CHILD^0^0^1
"DATA",90093.99,109,1,10,0)
1.04^I^7^CHILD TOTAL^0^0^1
"DATA",90093.99,109,1,11,0)
1.05^T^3^TEEN FEMALE^0^0^1
"DATA",90093.99,109,1,12,0)
1.06^I^7^TEEN FEMALE TOTAL^0^0^1
"DATA",90093.99,109,1,13,0)
1.07^T^3^TEEN MALE^0^0^1
"DATA",90093.99,109,1,14,0)
1.08^I^7^TEEN MALE TOTAL^0^0^1
"DATA",90093.99,109,1,15,0)
1.09^T^3^ADULT FEMALE^0^0^1
"DATA",90093.99,109,1,16,0)
1.1^I^7^ADULT FEMALE TOTAL^0^0^1
"DATA",90093.99,109,1,17,0)
1.11^T^3^ADULT MALE^0^0^1
"DATA",90093.99,109,1,18,0)
1.12^I^7^ADULT MALE TOTAL^0^0^1
"DATA",90093.99,109,1,19,0)
1.13^T^3^SENIOR FEMALE^0^0^1
"DATA",90093.99,109,1,20,0)
1.14^I^7^SENIOR FEMALE TOTAL^0^0^1
"DATA",90093.99,109,1,21,0)
1.15^T^3^SENIOR MALE^0^0^1
"DATA",90093.99,109,1,22,0)
1.16^I^7^SENIOR MALE TOTAL^0^0^1
"DATA",90093.99,110,0)
VEN CL GROUPS^19707.9
"DATA",90093.99,110,1,0)
^90093.991^6^6
"DATA",90093.99,110,1,1,0)
.01^T^30^NAME^0^0^0
"DATA",90093.99,110,1,2,0)
.02^T^30^TYPE^0^0^1
"DATA",90093.99,110,1,3,0)
.03^T^9^PRE^0^0^1
"DATA",90093.99,110,1,4,0)
.04^T^9^POST^0^0^1
"DATA",90093.99,110,1,5,0)
1^T^240^BRIEF DESCRIPTION^0^0^1
"DATA",90093.99,110,1,6,0)
.001TRIGGER1^N^3^CHLECK LIST CATEGORY^1^0^1
"DATA",90093.99,110,1,6,3)
IEN^VENPCCU
"DATA",90093.99,111,0)
VEN CL ITEMS^19707.91
"DATA",90093.99,111,1,0)
^90093.991^8^8
"DATA",90093.99,111,1,1,0)
.01^T^30^ITEM^0^0^0
"DATA",90093.99,111,1,2,0)
.03^T^3^INFANTS^0^0^1
"DATA",90093.99,111,1,3,0)
.04^T^3^CHILDREN^0^0^1
"DATA",90093.99,111,1,4,0)
.05^T^3^MEN^0^0^1
"DATA",90093.99,111,1,5,0)
.07^T^30^CODE1^0^0^1
"DATA",90093.99,111,1,6,0)
.08^T^30^CODE2^0^0^1
"DATA",90093.99,111,1,7,0)
.09^I^4^POSITION^0^0^1
"DATA",90093.99,111,1,8,0)
.001TRIGGER1^N^6^IEN^1^0^1
"DATA",90093.99,111,1,8,3)
IEN^VENPCCU
"DATA",90093.99,112,0)
HWADA^9999999.31^0
"DATA",90093.99,112,1,0)
^90093.991^8^5
"DATA",90093.99,112,1,1,0)
.01^T^30^CODE^1^0^0
"DATA",90093.99,112,1,2,0)
.02^T^60^DESCRIPTION^0^0^1
"DATA",90093.99,112,1,5,0)
.09^T^10^NO OPSITE^0^0^1
"DATA",90093.99,112,1,7,0)
.04^I^10^ESTIMATED MINUTES^0^0^1
"DATA",90093.99,112,1,8,0)
.08^D^10^INACTIVE^0^0^1
"FIA",90093.1)
BMX USER
"FIA",90093.1,0)
^BMXUSER(
"FIA",90093.1,0,0)
90093.1
"FIA",90093.1,0,1)
y^y^f^^^^n
"FIA",90093.1,0,10)
"FIA",90093.1,0,11)
"FIA",90093.1,0,"RLRO")
"FIA",90093.1,0,"VR")
2.31^BMX
"FIA",90093.1,90093.1)
0
"FIA",90093.2)
BMX APPLICATION
"FIA",90093.2,0)
^BMXAPPL(
"FIA",90093.2,0,0)
90093.2
"FIA",90093.2,0,1)
y^y^f^^n^^y^o^n
"FIA",90093.2,0,10)
"FIA",90093.2,0,11)
"FIA",90093.2,0,"RLRO")
"FIA",90093.2,0,"VR")
2.31^BMX
"FIA",90093.2,90093.2)
0
"FIA",90093.5)
BMXNET MONITOR
"FIA",90093.5,0)
^BMXMON(
"FIA",90093.5,0,0)
90093.5
"FIA",90093.5,0,1)
y^y^f^^^^n
"FIA",90093.5,0,10)
"FIA",90093.5,0,11)
"FIA",90093.5,0,"RLRO")
"FIA",90093.5,0,"VR")
2.31^BMX
"FIA",90093.5,90093.5)
0
"FIA",90093.9)
BMX GUI REPORT
"FIA",90093.9,0)
^BMXGUIR(
"FIA",90093.9,0,0)
90093.9
"FIA",90093.9,0,1)
y^y^f^^^^n
"FIA",90093.9,0,10)
"FIA",90093.9,0,11)
"FIA",90093.9,0,"RLRO")
"FIA",90093.9,0,"VR")
2.31^BMX
"FIA",90093.9,90093.9)
0
"FIA",90093.9,90093.911)
0
"FIA",90093.98)
BMX ADO LOG
"FIA",90093.98,0)
^BMXADOL(
"FIA",90093.98,0,0)
90093.98D
"FIA",90093.98,0,1)
y^y^f^^^^n
"FIA",90093.98,0,10)
"FIA",90093.98,0,11)
"FIA",90093.98,0,"RLRO")
"FIA",90093.98,0,"VR")
2.31^BMX
"FIA",90093.98,90093.98)
0
"FIA",90093.98,90093.981)
0
"FIA",90093.99)
BMX ADO SCHEMA
"FIA",90093.99,0)
^BMXADO(
"FIA",90093.99,0,0)
90093.99
"FIA",90093.99,0,1)
y^y^f^^n^^y^a^n
"FIA",90093.99,0,10)
"FIA",90093.99,0,11)
"FIA",90093.99,0,"RLRO")
"FIA",90093.99,0,"VR")
2.31^BMX
"FIA",90093.99,90093.99)
0
"FIA",90093.99,90093.991)
0
"FIA",90093.99,90093.992)
0
"FIA",90093.99,90093.9922)
0
"FIA",90093.99,90093.9923)
0
"KRN",.402,1724,-1)
0^1
"KRN",.402,1724,0)
BMX MONITOR EDIT^3040928.1231^@^90093.5^^@^3061103
"KRN",.402,1724,"DR",1,90093.5)
.01;.02;.03;.04;
"KRN",19,10982,-1)
0^5
"KRN",19,10982,0)
BMXRPC^BMX Procedure Calls^^B^^^^^^^^BMXNET RPMS .NET UTILITIES
"KRN",19,10982,99.1)
59512,54859
"KRN",19,10982,"RPC",0)
^19.05P^82^82
"KRN",19,10982,"RPC",1,0)
BMX SQL
"KRN",19,10982,"RPC",2,0)
BMX SQL COLINFO
"KRN",19,10982,"RPC",3,0)
BMX FIELD LIST
"KRN",19,10982,"RPC",4,0)
BMX FIND
"KRN",19,10982,"RPC",5,0)
BMX LOOKUP
"KRN",19,10982,"RPC",6,0)
BMX NTUSER
"KRN",19,10982,"RPC",7,0)
BMX TABLE
"KRN",19,10982,"RPC",8,0)
BMX TLIST
"KRN",19,10982,"RPC",9,0)
BMX USER
"KRN",19,10982,"RPC",10,0)
BMX SECURITY KEY
"KRN",19,10982,"RPC",11,0)
BMX SIGNATURE
"KRN",19,10982,"RPC",12,0)
BMX MULT LIST
"KRN",19,10982,"RPC",13,0)
BMXGetFacRS
"KRN",19,10982,"RPC",14,0)
BMXSetFac
"KRN",19,10982,"RPC",15,0)
BMXPatientLookupRS
"KRN",19,10982,"RPC",16,0)
BMXPatientInfoRS
"KRN",19,10982,"RPC",20,0)
BMX HEALTH SUMMARY
"KRN",19,10982,"RPC",21,0)
BMX DENTAL REPORT 1
"KRN",19,10982,"RPC",22,0)
BMXGetFac
"KRN",19,10982,"RPC",23,0)
BMXUserKeyRS
"KRN",19,10982,"RPC",24,0)
BMX PDATA CHART
"KRN",19,10982,"RPC",26,0)
BMX DENTAL REPORT 2
"KRN",19,10982,"RPC",27,0)
BMX GET VARIABLE VALUE
"KRN",19,10982,"RPC",29,0)
BMX PATIENT DEMOG DATA GET
"KRN",19,10982,"RPC",30,0)
BMXProviderLookupRS
"KRN",19,10982,"RPC",61,0)
BMXNetGetCodes
"KRN",19,10982,"RPC",62,0)
BMXNetSetUser
"KRN",19,10982,"RPC",63,0)
BMX DEMO
"KRN",19,10982,"RPC",64,0)
BMX AV CODE
"KRN",19,10982,"RPC",65,0)
BMXNRC
"KRN",19,10982,"RPC",66,0)
BMX LOCK
"KRN",19,10982,"RPC",67,0)
BMX VERSION INFO
"KRN",19,10982,"RPC",68,0)
BMX IM HERE
"KRN",19,10982,"RPC",69,0)
BMX TEST
"KRN",19,10982,"RPC",70,0)
BMX SCHEMA ONLY
"KRN",19,10982,"RPC",71,0)
BMX UPDATE
"KRN",19,10982,"RPC",74,0)
BMX ADO SS
"KRN",19,10982,"RPC",75,0)
BMX EVENT REGISTER
"KRN",19,10982,"RPC",76,0)
BMX EVENT RAISE
"KRN",19,10982,"RPC",77,0)
BMX EVENT UNREGISTER
"KRN",19,10982,"RPC",78,0)
BMX EVENT POLL
"KRN",19,10982,"RPC",79,0)
BMX TIMER TEST
"KRN",19,10982,"RPC",80,0)
BMX ASYNC GET
"KRN",19,10982,"RPC",81,0)
BMX ASYNC QUEUE
"KRN",19,10982,"RPC",82,0)
BMX UTF-8
"KRN",19,10982,"U")
BMX PROCEDURE CALLS
"KRN",19,10983,-1)
0^2
"KRN",19,10983,0)
BMX MONITOR START^Start All BMXNet Monitors^^R^^^^^^^^^y
"KRN",19,10983,1,0)
^19.06^7^7^3040919^^
"KRN",19,10983,1,1,0)
Use this option to start or restart all BMXNet monitors in the
"KRN",19,10983,1,2,0)
BMXNET MONITOR file. This option should be scheduled as a STARTUP
"KRN",19,10983,1,3,0)
type option in TaskMan. Do not use this option to start a
"KRN",19,10983,1,4,0)
specific monitor. To do this, in programmer mode, do STRT^BMXMON(PORT).
"KRN",19,10983,1,5,0)
See the product documentation for instructions on how to start
"KRN",19,10983,1,6,0)
session monitors in a particular namespace and on how to
"KRN",19,10983,1,7,0)
enable or disable Windows Integrated Security.
"KRN",19,10983,25)
RESTART^BMXMON
"KRN",19,10983,200.9)
s
"KRN",19,10983,"U")
START ALL BMXNET MONITORS
"KRN",19,10984,-1)
0^4
"KRN",19,10984,0)
BMXMENU^BMXNet Management^^M^^BMXZMENU^^^^^^^^1
"KRN",19,10984,1,0)
^^1^1^3040928^
"KRN",19,10984,1,1,0)
Menu contains options in the BMX namespace
"KRN",19,10984,10,0)
^19.01IP^3^3
"KRN",19,10984,10,1,0)
10986^EDIT^5
"KRN",19,10984,10,1,"^")
BMX MONITOR EDIT
"KRN",19,10984,10,2,0)
10983^STRT^10
"KRN",19,10984,10,2,"^")
BMX MONITOR START
"KRN",19,10984,10,3,0)
10985^STOP^15
"KRN",19,10984,10,3,"^")
BMX MONITOR STOP
"KRN",19,10984,20)
D MENU^BMXMON
"KRN",19,10984,99)
62291,35412
"KRN",19,10984,"U")
BMXNET MANAGEMENT
"KRN",19,10985,-1)
0^3
"KRN",19,10985,0)
BMX MONITOR STOP^Stop All BMXNet Monitors^^R^^^^^^^^
"KRN",19,10985,1,0)
^^1^1^3040928^
"KRN",19,10985,1,1,0)
Use this option to stop all BMXNet monitors.
"KRN",19,10985,25)
STOPALL^BMXMON
"KRN",19,10985,"U")
STOP ALL BMXNET MONITORS
"KRN",19,10986,-1)
0^1
"KRN",19,10986,0)
BMX MONITOR EDIT^Add/Edit BMXNet Monitor Entries^^E^^^^^^^^
"KRN",19,10986,30)
BMXMON(
"KRN",19,10986,31)
AEMQL
"KRN",19,10986,50)
BMXMON(
"KRN",19,10986,51)
[BMX MONITOR EDIT]
"KRN",19,10986,63)
"KRN",19,10986,99)
59806,44943
"KRN",19,10986,"U")
ADD/EDIT BMXNET MONITOR ENTRIE
"KRN",19.1,479,-1)
0^1
"KRN",19.1,479,0)
BMXZMENU
"KRN",8994,2396,-1)
0^21
"KRN",8994,2396,0)
BMX PATIENT DEMOG DATA GET^PDATA^BMXRPC1^1
"KRN",8994,2397,-1)
0^18
"KRN",8994,2397,0)
BMX LOOKUP^LOOKUP^BMXRPC^4
"KRN",8994,2398,-1)
0^12
"KRN",8994,2398,0)
BMX FIELD LIST^FLDLIST^BMXRPC2^4
"KRN",8994,2399,-1)
0^13
"KRN",8994,2399,0)
BMX FIND^FIND^BMXFIND^4
"KRN",8994,2400,-1)
0^28
"KRN",8994,2400,0)
BMX TABLE^TABLE^BMXFIND^4
"KRN",8994,2401,-1)
0^26
"KRN",8994,2401,0)
BMX SQL^SQL^BMXSQL^4
"KRN",8994,2402,-1)
0^31
"KRN",8994,2402,0)
BMX TLIST^TLIST^BMXSQL^4
"KRN",8994,2403,-1)
0^27
"KRN",8994,2403,0)
BMX SQL COLINFO^SQLCOL^BMXSQL^4
"KRN",8994,2404,-1)
0^14
"KRN",8994,2404,0)
BMX GET VARIABLE VALUE^VARVAL^BMXRPC3^1
"KRN",8994,2405,-1)
0^33
"KRN",8994,2405,0)
BMX USER^USER^BMXRPC3^1
"KRN",8994,2406,-1)
0^20
"KRN",8994,2406,0)
BMX NTUSER^NTUSER^BMXRPC3^1
"KRN",8994,2407,-1)
0^43
"KRN",8994,2407,0)
BMXSetFac^SETFCRS^BMXRPC3^1
"KRN",8994,2408,-1)
0^35
"KRN",8994,2408,0)
BMXGetFac^GETFC^BMXRPC3^1
"KRN",8994,2409,-1)
0^24
"KRN",8994,2409,0)
BMX SECURITY KEY^APSEC^BMXRPC3^1
"KRN",8994,2410,-1)
0^25
"KRN",8994,2410,0)
BMX SIGNATURE^SIGCHK^BMXRPC3^1
"KRN",8994,2411,-1)
0^19
"KRN",8994,2411,0)
BMX MULT LIST^MLTLIST^BMXRPC2^4
"KRN",8994,2412,-1)
0^36
"KRN",8994,2412,0)
BMXGetFacRS^GETFCRS^BMXRPC3^1
"KRN",8994,2413,-1)
0^41
"KRN",8994,2413,0)
BMXPatientLookupRS^PTLOOKRS^BMXRPC4^1
"KRN",8994,2414,-1)
0^40
"KRN",8994,2414,0)
BMXPatientInfoRS^PTINFORS^BMXRPC4^1
"KRN",8994,2415,-1)
0^15
"KRN",8994,2415,0)
BMX HEALTH SUMMARY^HS^BMXRPC5^4
"KRN",8994,2416,-1)
0^6
"KRN",8994,2416,0)
BMX DENTAL REPORT 1^BMXADE^BMXADE1^4
"KRN",8994,2417,-1)
0^44
"KRN",8994,2417,0)
BMXUserKeyRS^USRKEYRS^BMXRPC6^1
"KRN",8994,2418,-1)
0^42
"KRN",8994,2418,0)
BMXProviderLookupRS^PRVLKRS^BMXQA2^1
"KRN",8994,2419,-1)
0^22
"KRN",8994,2419,0)
BMX PDATA CHART^PDATA^BMXRPC6^4
"KRN",8994,2420,-1)
0^7
"KRN",8994,2420,0)
BMX DENTAL REPORT 2^BMXADE^BMXADE2^4
"KRN",8994,2421,-1)
0^37
"KRN",8994,2421,0)
BMXNRC^ZTM^BMXNRC^4
"KRN",8994,2422,-1)
0^38
"KRN",8994,2422,0)
BMXNetGetCodes^NTUGET^BMXRPC3^4
"KRN",8994,2423,-1)
0^39
"KRN",8994,2423,0)
BMXNetSetUser^NTUSET^BMXRPC3^4
"KRN",8994,2424,-1)
0^5
"KRN",8994,2424,0)
BMX DEMO^PDEMO^BMXRPC6^4
"KRN",8994,2425,-1)
0^4
"KRN",8994,2425,0)
BMX AV CODE^WINVAL^BMXRPC7^2
"KRN",8994,2426,-1)
0^17
"KRN",8994,2426,0)
BMX LOCK^BMXLOCK^BMXRPC8^1
"KRN",8994,2427,-1)
0^34
"KRN",8994,2427,0)
BMX VERSION INFO^BMXVER^BMXRPC8^4
"KRN",8994,2428,-1)
0^16
"KRN",8994,2428,0)
BMX IM HERE^IMHERE^BMXRPC8^1^P
"KRN",8994,2428,1,0)
^8994.01^2^2^3040304^^^
"KRN",8994,2428,1,1,0)
Returns a simple value to client. Used to establish continued existence
"KRN",8994,2428,1,2,0)
of the client to the server; resets the server READ timeout.
"KRN",8994,2429,-1)
0^32
"KRN",8994,2429,0)
BMX UPDATE^FILE^BMXADOF^1
"KRN",8994,2430,-1)
0^29
"KRN",8994,2430,0)
BMX TEST^TESTRPC^BMXRPC9^4
"KRN",8994,2431,-1)
0^23
"KRN",8994,2431,0)
BMX SCHEMA ONLY^SONLY^BMXRPC9^1
"KRN",8994,2432,-1)
0^1
"KRN",8994,2432,0)
BMX ADO SS^SS^BMXADO^4
"KRN",8994,2433,-1)
0^9
"KRN",8994,2433,0)
BMX EVENT RAISE^RAISEVNT^BMXMEVN^4
"KRN",8994,2434,-1)
0^10
"KRN",8994,2434,0)
BMX EVENT REGISTER^REGEVNT^BMXMEVN^4
"KRN",8994,2435,-1)
0^11
"KRN",8994,2435,0)
BMX EVENT UNREGISTER^UNREG^BMXMEVN^4
"KRN",8994,2436,-1)
0^8
"KRN",8994,2436,0)
BMX EVENT POLL^POLL^BMXMEVN^4
"KRN",8994,2437,-1)
0^30
"KRN",8994,2437,0)
BMX TIMER TEST^TTEST^BMXMEVN^4
"KRN",8994,2438,-1)
0^2
"KRN",8994,2438,0)
BMX ASYNC GET^ASYNCGET^BMXMEVN^4
"KRN",8994,2439,-1)
0^3
"KRN",8994,2439,0)
BMX ASYNC QUEUE^ASYNCQUE^BMXMEVN^4
"KRN",8994,2497,-1)
0^45
"KRN",8994,2497,0)
BMX UTF-8^UTF8^BMXRPC^1^P
"KRN",8994,2497,1,0)
^^4^4^3100907^
"KRN",8994,2497,1,1,0)
This RPC returns a single value of 1 if database supports UTF-8; 0 if
"KRN",8994,2497,1,2,0)
not. Only works on GT.M.
"KRN",8994,2497,1,3,0)
"KRN",8994,2497,1,4,0)
Doesn't take any parameters.
"MBREQ")
0
"ORD",3,19.1)
19.1;3;1;;KEY^XPDTA1;;;KEYF2^XPDIA1;;KEYDEL^XPDIA1
"ORD",3,19.1,0)
SECURITY KEY
"ORD",7,.402)
.402;7;;;EDEOUT^DIFROMSO(.402,DA,"",XPDA);FPRE^DIFROMSI(.402,"",XPDA);EPRE^DIFROMSI(.402,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.402,DA,"",XPDA);DEL^DIFROMSK(.402,"",%)
"ORD",7,.402,0)
INPUT TEMPLATE
"ORD",16,8994)
8994;16;1;;;;;;;RPCDEL^XPDIA1
"ORD",16,8994,0)
REMOTE PROCEDURE
"ORD",18,19)
19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA
"ORD",18,19,0)
OPTION
"PKG",210,-1)
1^1
"PKG",210,0)
BMXNET RPMS .NET UTILITIES^BMX^.NET CONNECTIVITY UTILITIES
"PKG",210,1,0)
^9.41A^2^2^3061031^^^^
"PKG",210,1,1,0)
BMXNet supports connection, authentication and data exchange between
"PKG",210,1,2,0)
Windows applications written for the .NET environment.
"PKG",210,20,0)
^9.402P^^
"PKG",210,22,0)
^9.49I^1^1
"PKG",210,22,1,0)
2.31^3110725
"PKG",210,22,1,1,0)
^^23^23^3110725
"PKG",210,22,1,1,1,0)
BMXNet .NET Connectivity utilities for RPMS.
"PKG",210,22,1,1,2,0)
Version 2.0 kids build to support BMXNet20.dll
"PKG",210,22,1,1,3,0)
"PKG",210,22,1,1,4,0)
Version 2.1 adds support to GT.M.
"PKG",210,22,1,1,5,0)
"PKG",210,22,1,1,6,0)
Version 2.2 adds a few bug fixes:
"PKG",210,22,1,1,7,0)
- Process Name is now set in BMXMON
"PKG",210,22,1,1,8,0)
- Timeout is now correct:
"PKG",210,22,1,1,9,0)
- 10 seconds for 1st connection
"PKG",210,22,1,1,10,0)
- 180 seconds for continuation
"PKG",210,22,1,1,11,0)
- Kernel Broker Timeout for regular use
"PKG",210,22,1,1,12,0)
- Divisions are now presented to the user if the user has more than one
"PKG",210,22,1,1,13,0)
division in his/her profile.
"PKG",210,22,1,1,14,0)
Version 2.2 requires BMXNet22.dll
"PKG",210,22,1,1,15,0)
"PKG",210,22,1,1,16,0)
Version 2.3 (Dec 12 2010)
"PKG",210,22,1,1,17,0)
Screens network errors and not log them into the error trap.
"PKG",210,22,1,1,18,0)
Process Name set causes an error on Cache. Now fixed.
"PKG",210,22,1,1,19,0)
Requires BMXNet23.dll
"PKG",210,22,1,1,20,0)
"PKG",210,22,1,1,21,0)
Version 2.31 (Jul 25 2011)
"PKG",210,22,1,1,22,0)
Error trap corrections in v 2.3 introduced a bug that causes an infinite
"PKG",210,22,1,1,23,0)
loop in the error trap causing a hard drive to fill up. This is fixed.
"PKG",210,"DEV")
IHS/ITSC/HWHITT
"PKG",210,"VERSION")
2.31
"PRE")
BMXE01
"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")
59
"RTN","BMXADE1")
0^59^B11418056
"RTN","BMXADE1",1,0)
BMXADE1 ; IHS/OIT/HMW - BMXNet ADO.NET PROVIDER ;
"RTN","BMXADE1",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXADE1",3,0)
;
"RTN","BMXADE1",4,0)
;
"RTN","BMXADE1",5,0)
;Dental Excel report demo
"RTN","BMXADE1",6,0)
;
"RTN","BMXADE1",7,0)
BMXADE(BMXGBL,BMXBEG,BMXEND) ;EP
"RTN","BMXADE1",8,0)
;Returns recordset containing services and minutes by reporting facility, patient's community and service unit
"RTN","BMXADE1",9,0)
;
"RTN","BMXADE1",10,0)
N BMXBEGDT,BMXENDDT,BMXTMP,BMXDT,BMXRD,BMXIEN,BMXNOD,BMXPAT,BMXCOM,BMXFAC,BMXSU,BMXCOMP,BMXSUP,BMXFACP,BMXSVC,BMXMIN,BMXFEE
"RTN","BMXADE1",11,0)
S U="^",BMXRD=$C(30)
"RTN","BMXADE1",12,0)
K ^BMXTEMP($J),^BMXTMP($J)
"RTN","BMXADE1",13,0)
S BMXGBL="^BMXTEMP("_$J_")"
"RTN","BMXADE1",14,0)
S ^BMXTEMP($J,0)="T00030FACILITY^T00030PT_COMMUNITY^T00030PT_SERVICE_UNIT^I00030SERVICES^I00030MINUTES^I00030FEE"_BMXRD
"RTN","BMXADE1",15,0)
S X=BMXBEG,%DT="P" D ^%DT S BMXBEGDT=Y
"RTN","BMXADE1",16,0)
S X=BMXEND,%DT="P" D ^%DT S BMXENDDT=Y
"RTN","BMXADE1",17,0)
I BMXENDDT<BMXBEGDT S BMXTMP=BMXENDDT,BMXENDDT=BMXBEGDT,BMXBEGDT=BMXTMP
"RTN","BMXADE1",18,0)
S BMXBEGDT=$P(BMXBEGDT,".")
"RTN","BMXADE1",19,0)
S BMXENDDT=$P(BMXENDDT,"."),$P(BMXENDDT,".",2)=99999
"RTN","BMXADE1",20,0)
;
"RTN","BMXADE1",21,0)
;$O Thru ADEPCD("AC" DATE X-REF
"RTN","BMXADE1",22,0)
;Temp global is (FAC,COMM)=SVCS^MINS
"RTN","BMXADE1",23,0)
;
"RTN","BMXADE1",24,0)
S BMXDT=BMXBEGDT F S BMXDT=$O(^ADEPCD("AC",BMXDT)) Q:'+BMXDT Q:BMXDT>BMXENDDT D
"RTN","BMXADE1",25,0)
. S BMXIEN=0 F S BMXIEN=$O(^ADEPCD("AC",BMXDT,BMXIEN)) Q:'+BMXIEN D
"RTN","BMXADE1",26,0)
. . Q:'$D(^ADEPCD(BMXIEN,0))
"RTN","BMXADE1",27,0)
. . S BMXNOD=^ADEPCD(BMXIEN,0)
"RTN","BMXADE1",28,0)
. . S BMXPAT=$P(BMXNOD,U)
"RTN","BMXADE1",29,0)
. . S BMXFACP=+$P(BMXNOD,U,3)
"RTN","BMXADE1",30,0)
. . S BMXCOMP=$$GETCOMP(BMXPAT)
"RTN","BMXADE1",31,0)
. . D CALCMIN(BMXIEN,.BMXSVC,.BMXMIN,.BMXFEE)
"RTN","BMXADE1",32,0)
. . Q:BMXSVC=0
"RTN","BMXADE1",33,0)
. . S:'$D(^BMXTMP($J,BMXFACP,BMXCOMP)) ^BMXTMP($J,BMXFACP,BMXCOMP)="0^0^0"
"RTN","BMXADE1",34,0)
. . S $P(^BMXTMP($J,BMXFACP,BMXCOMP),U)=$P(^(BMXCOMP),U)+BMXSVC
"RTN","BMXADE1",35,0)
. . S $P(^BMXTMP($J,BMXFACP,BMXCOMP),U,2)=$P(^(BMXCOMP),U,2)+BMXMIN
"RTN","BMXADE1",36,0)
. . S $P(^BMXTMP($J,BMXFACP,BMXCOMP),U,3)=$P(^(BMXCOMP),U,3)+BMXFEE
"RTN","BMXADE1",37,0)
. . Q
"RTN","BMXADE1",38,0)
. Q
"RTN","BMXADE1",39,0)
;
"RTN","BMXADE1",40,0)
;Traverse ^BMXTMP and fill in ^BMXTEMP
"RTN","BMXADE1",41,0)
S BMXI=0
"RTN","BMXADE1",42,0)
S BMXFACP=-1 F S BMXFACP=$O(^BMXTMP($J,BMXFACP)) Q:BMXFACP="" D
"RTN","BMXADE1",43,0)
. I BMXFACP=0 S BMXFAC="UNKNOWN"
"RTN","BMXADE1",44,0)
. E S BMXFAC=$P($G(^DIC(4,BMXFACP,0)),U) S:BMXFAC="" BMXFAC="UNKNOWN"
"RTN","BMXADE1",45,0)
. S BMXCOMP=-1 F S BMXCOMP=$O(^BMXTMP($J,BMXFACP,BMXCOMP)) Q:BMXCOMP="" D
"RTN","BMXADE1",46,0)
. . I BMXCOMP=0 S BMXCOM="UNKNOWN"
"RTN","BMXADE1",47,0)
. . E S BMXCOM=$P($G(^AUTTCOM(BMXCOMP,0)),U) S:BMXCOM="" BMXCOM="UNKNOWN"
"RTN","BMXADE1",48,0)
. . S BMXSU=+$P($G(^AUTTCOM(BMXCOMP,0)),U,5)
"RTN","BMXADE1",49,0)
. . I BMXSU=0 S BMXSU="UNKNOWN"
"RTN","BMXADE1",50,0)
. . E S BMXSU=$P($G(^AUTTSU(BMXSU,0)),U)
"RTN","BMXADE1",51,0)
. . S BMXI=BMXI+1
"RTN","BMXADE1",52,0)
. . S BMXSVC=$P(^BMXTMP($J,BMXFACP,BMXCOMP),U)
"RTN","BMXADE1",53,0)
. . S BMXMIN=$P(^BMXTMP($J,BMXFACP,BMXCOMP),U,2)
"RTN","BMXADE1",54,0)
. . S BMXFEE=$P(^BMXTMP($J,BMXFACP,BMXCOMP),U,3)
"RTN","BMXADE1",55,0)
. . S ^BMXTEMP($J,BMXI)=BMXFAC_U_BMXCOM_U_BMXSU_U_BMXSVC_U_BMXMIN_U_BMXFEE_BMXRD
"RTN","BMXADE1",56,0)
. . Q
"RTN","BMXADE1",57,0)
. Q
"RTN","BMXADE1",58,0)
S BMXI=BMXI+1
"RTN","BMXADE1",59,0)
S ^BMXTEMP($J,BMXI)=$C(31)
"RTN","BMXADE1",60,0)
Q
"RTN","BMXADE1",61,0)
;
"RTN","BMXADE1",62,0)
GETCOMP(BMXPAT) ;
"RTN","BMXADE1",63,0)
;Returns Patient Community Pointer
"RTN","BMXADE1",64,0)
I '$D(^AUPNPAT(BMXPAT,11)) Q 0
"RTN","BMXADE1",65,0)
Q +$P(^AUPNPAT(BMXPAT,11),U,17)
"RTN","BMXADE1",66,0)
;
"RTN","BMXADE1",67,0)
CALCMIN(BMXIEN,BMXSVC,BMXMIN,BMXFEE) ;
"RTN","BMXADE1",68,0)
;Returns count of lvl 1 - 6 services and minutes for entry BMXIEN
"RTN","BMXADE1",69,0)
;Uses ANMC rogue FEE field in AUTTADA to calculate FEE data
"RTN","BMXADE1",70,0)
N BMXA,BMXCOD,BMXALVL
"RTN","BMXADE1",71,0)
S BMXSVC=0,BMXMIN=0,BMXFEE=0
"RTN","BMXADE1",72,0)
Q:'$D(^ADEPCD(BMXIEN,"ADA"))
"RTN","BMXADE1",73,0)
S BMXA=0 F S BMXA=$O(^ADEPCD(BMXIEN,"ADA",BMXA)) Q:'+BMXA D
"RTN","BMXADE1",74,0)
. S BMXCOD=+^ADEPCD(BMXIEN,"ADA",BMXA,0)
"RTN","BMXADE1",75,0)
. Q:'$D(^AUTTADA(BMXCOD,0))
"RTN","BMXADE1",76,0)
. S BMXANOD=^AUTTADA(BMXCOD,0)
"RTN","BMXADE1",77,0)
. S BMXALVL=$P(BMXANOD,U,5)
"RTN","BMXADE1",78,0)
. Q:BMXALVL=0
"RTN","BMXADE1",79,0)
. Q:BMXALVL>6
"RTN","BMXADE1",80,0)
. S BMXSVC=BMXSVC+1
"RTN","BMXADE1",81,0)
. S BMXMIN=BMXMIN+$P(BMXANOD,U,4)
"RTN","BMXADE1",82,0)
. S BMXFEE=BMXFEE+$P(BMXANOD,U,12)
"RTN","BMXADE1",83,0)
Q
"RTN","BMXADE2")
0^60^B13063702
"RTN","BMXADE2",1,0)
BMXADE2 ; IHS/OIT/HMW - BMXNet ADO.NET PROVIDER ;
"RTN","BMXADE2",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXADE2",3,0)
;
"RTN","BMXADE2",4,0)
;
"RTN","BMXADE2",5,0)
;Dental Excel report demo
"RTN","BMXADE2",6,0)
;
"RTN","BMXADE2",7,0)
BMXADE(BMXGBL,BMXBEG,BMXEND) ;EP
"RTN","BMXADE2",8,0)
;Returns recordset containing services and minutes by reporting facility, Provider, and ADA Code
"RTN","BMXADE2",9,0)
;
"RTN","BMXADE2",10,0)
N BMXBEGDT,BMXENDDT,BMXTMP,BMXDT,BMXRD,BMXIEN,BMXNOD,BMXCOM,BMXFAC,BMXSU,BMXCOMP,BMXSUP,BMXFACP,BMXSVC,BMXMIN,BMXLVL,BMXFEE
"RTN","BMXADE2",11,0)
S U="^",BMXRD=$C(30)
"RTN","BMXADE2",12,0)
K ^BMXTEMP($J),^BMXTMP($J)
"RTN","BMXADE2",13,0)
S BMXGBL="^BMXTEMP("_$J_")"
"RTN","BMXADE2",14,0)
S ^BMXTEMP($J,0)="T00030FACILITY^T00030PROVIDER^T00030ADA_CODE^T00030LEVEL^I00030SERVICES^I00030MINUTES^I00030FEE"_BMXRD
"RTN","BMXADE2",15,0)
S X=BMXBEG,%DT="P" D ^%DT S BMXBEGDT=Y
"RTN","BMXADE2",16,0)
S X=BMXEND,%DT="P" D ^%DT S BMXENDDT=Y
"RTN","BMXADE2",17,0)
I BMXENDDT<BMXBEGDT S BMXTMP=BMXENDDT,BMXENDDT=BMXBEGDT,BMXBEGDT=BMXTMP
"RTN","BMXADE2",18,0)
S BMXBEGDT=$P(BMXBEGDT,".")
"RTN","BMXADE2",19,0)
S BMXENDDT=$P(BMXENDDT,"."),$P(BMXENDDT,".",2)=99999
"RTN","BMXADE2",20,0)
;
"RTN","BMXADE2",21,0)
;$O Thru ADEPCD("AC" DATE X-REF
"RTN","BMXADE2",22,0)
;Temp global is (FAC,PROV,CODE)=SVCS^MINS
"RTN","BMXADE2",23,0)
;
"RTN","BMXADE2",24,0)
S BMXDT=BMXBEGDT F S BMXDT=$O(^ADEPCD("AC",BMXDT)) Q:'+BMXDT Q:BMXDT>BMXENDDT D
"RTN","BMXADE2",25,0)
. S BMXIEN=0 F S BMXIEN=$O(^ADEPCD("AC",BMXDT,BMXIEN)) Q:'+BMXIEN D
"RTN","BMXADE2",26,0)
. . Q:'$D(^ADEPCD(BMXIEN,0))
"RTN","BMXADE2",27,0)
. . S BMXNOD=^ADEPCD(BMXIEN,0)
"RTN","BMXADE2",28,0)
. . S BMXFACP=+$P(BMXNOD,U,3)
"RTN","BMXADE2",29,0)
. . S BMXPRVP=+$P(BMXNOD,U,4)
"RTN","BMXADE2",30,0)
. . S BMXCODP=0 F S BMXCODP=$O(^ADEPCD(BMXIEN,"ADA","B",BMXCODP)) Q:'+BMXCODP D
"RTN","BMXADE2",31,0)
. . . D CALCMIN(BMXCODP,.BMXMIN)
"RTN","BMXADE2",32,0)
. . . D CALCFEE(BMXCODP,.BMXFEE)
"RTN","BMXADE2",33,0)
. . . S BMXCODPS=0,BMXSVC=0 F S BMXCODPS=$O(^ADEPCD(BMXIEN,"ADA","B",BMXCODP,BMXCODPS)) Q:'+BMXCODPS D
"RTN","BMXADE2",34,0)
. . . . S BMXSVC=BMXSVC+1
"RTN","BMXADE2",35,0)
. . . S:'$D(^BMXTMP($J,BMXFACP,BMXPRVP,BMXCODP)) ^BMXTMP($J,BMXFACP,BMXPRVP,BMXCODP)="0^0"
"RTN","BMXADE2",36,0)
. . . S $P(^BMXTMP($J,BMXFACP,BMXPRVP,BMXCODP),U)=$P(^(BMXCODP),U)+BMXSVC
"RTN","BMXADE2",37,0)
. . . S $P(^BMXTMP($J,BMXFACP,BMXPRVP,BMXCODP),U,2)=$P(^(BMXCODP),U,2)+(BMXSVC*BMXMIN)
"RTN","BMXADE2",38,0)
. . . S $P(^BMXTMP($J,BMXFACP,BMXPRVP,BMXCODP),U,3)=$P(^(BMXCODP),U,3)+(BMXSVC*BMXFEE)
"RTN","BMXADE2",39,0)
. . . Q
"RTN","BMXADE2",40,0)
. . Q
"RTN","BMXADE2",41,0)
. Q
"RTN","BMXADE2",42,0)
;
"RTN","BMXADE2",43,0)
;Traverse ^BMXTMP and fill in ^BMXTEMP
"RTN","BMXADE2",44,0)
S BMXI=0
"RTN","BMXADE2",45,0)
S BMXFACP=-1 F S BMXFACP=$O(^BMXTMP($J,BMXFACP)) Q:BMXFACP="" D
"RTN","BMXADE2",46,0)
. I BMXFACP=0 S BMXFAC="UNKNOWN"
"RTN","BMXADE2",47,0)
. E S BMXFAC=$P($G(^DIC(4,BMXFACP,0)),U) S:BMXFAC="" BMXFAC="UNKNOWN"
"RTN","BMXADE2",48,0)
. S BMXPRVP=-1 F S BMXPRVP=$O(^BMXTMP($J,BMXFACP,BMXPRVP)) Q:BMXPRVP="" D
"RTN","BMXADE2",49,0)
. . S BMXPRV=$P($G(^DIC(16,BMXPRVP,0)),U) S:BMXPRV="" BMXPRV="UNKNOWN"
"RTN","BMXADE2",50,0)
. . S BMXCODP=-1 F S BMXCODP=$O(^BMXTMP($J,BMXFACP,BMXPRVP,BMXCODP)) Q:'+BMXCODP D
"RTN","BMXADE2",51,0)
. . . D CODLVL(BMXCODP,.BMXCOD,.BMXLVL)
"RTN","BMXADE2",52,0)
. . . S BMXI=BMXI+1
"RTN","BMXADE2",53,0)
. . . S BMXSVC=$P(^BMXTMP($J,BMXFACP,BMXPRVP,BMXCODP),U)
"RTN","BMXADE2",54,0)
. . . S BMXMIN=$P(^BMXTMP($J,BMXFACP,BMXPRVP,BMXCODP),U,2)
"RTN","BMXADE2",55,0)
. . . S BMXFEE=$P(^BMXTMP($J,BMXFACP,BMXPRVP,BMXCODP),U,3)
"RTN","BMXADE2",56,0)
. . . S ^BMXTEMP($J,BMXI)=BMXFAC_U_BMXPRV_U_BMXCOD_U_BMXLVL_U_BMXSVC_U_BMXMIN_U_BMXFEE_BMXRD
"RTN","BMXADE2",57,0)
. . . Q
"RTN","BMXADE2",58,0)
. . Q
"RTN","BMXADE2",59,0)
. Q
"RTN","BMXADE2",60,0)
S BMXI=BMXI+1
"RTN","BMXADE2",61,0)
S ^BMXTEMP($J,BMXI)=$C(31)
"RTN","BMXADE2",62,0)
Q
"RTN","BMXADE2",63,0)
;
"RTN","BMXADE2",64,0)
CALCMIN(BMXCODP,BMXMIN) ;
"RTN","BMXADE2",65,0)
;Returns Minutes for code BMXCOD
"RTN","BMXADE2",66,0)
N BMXANOD
"RTN","BMXADE2",67,0)
S BMXMIN=0
"RTN","BMXADE2",68,0)
Q:'$D(^AUTTADA(BMXCODP,0))
"RTN","BMXADE2",69,0)
S BMXANOD=^AUTTADA(BMXCODP,0)
"RTN","BMXADE2",70,0)
;S BMXLVL=$P(BMXANOD,U,5)
"RTN","BMXADE2",71,0)
S BMXMIN=$P(BMXANOD,U,4)
"RTN","BMXADE2",72,0)
Q
"RTN","BMXADE2",73,0)
;
"RTN","BMXADE2",74,0)
CALCFEE(BMXCODP,BMXFEE) ;
"RTN","BMXADE2",75,0)
;Returns FEE for code BMXCOD. Only works for ANMC local fee field
"RTN","BMXADE2",76,0)
N BMXANOD
"RTN","BMXADE2",77,0)
S BMXFEE=0
"RTN","BMXADE2",78,0)
Q:'$D(^AUTTADA(BMXCODP,0))
"RTN","BMXADE2",79,0)
S BMXANOD=^AUTTADA(BMXCODP,0)
"RTN","BMXADE2",80,0)
S BMXFEE=+$P(BMXANOD,U,12)
"RTN","BMXADE2",81,0)
Q
"RTN","BMXADE2",82,0)
;
"RTN","BMXADE2",83,0)
CODLVL(BMXCODP,BMXCOD,BMXLVL) ;
"RTN","BMXADE2",84,0)
;Returns Name and Level of code at ADACODP
"RTN","BMXADE2",85,0)
N BMXANOD
"RTN","BMXADE2",86,0)
S BMXCOD="",BMXLVL=""
"RTN","BMXADE2",87,0)
Q:'$D(^AUTTADA(BMXCODP,0))
"RTN","BMXADE2",88,0)
S BMXANOD=^AUTTADA(BMXCODP,0)
"RTN","BMXADE2",89,0)
S BMXCOD=$P(BMXANOD,U)
"RTN","BMXADE2",90,0)
S BMXLVL=$P(BMXANOD,U,5)
"RTN","BMXADO")
0^61^B32349097
"RTN","BMXADO",1,0)
BMXADO ; IHS/CIHA/GIS - RPC CALL: GENERATE AN ADO SCHEMA STRING AND DATA SET ;
"RTN","BMXADO",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXADO",3,0)
; SS^BMXADO: RPC EP FROM WINDOWS/WEB APP TO GENERATE A SCHEMEA STRING (& OPTIONALLY, A DATA SET AS WELL)
"RTN","BMXADO",4,0)
; THE SCHEMA DEFINITION AND MAP IS STORED IN THE 'BMX ADO SCHEMA' FILE
"RTN","BMXADO",5,0)
; THIS ROUTINE GENERATES THE SCHEMA STRING. BMXADOV GENERATES THE DATA SET THAT GOES WITH THE SCHEMA STRING.
"RTN","BMXADO",6,0)
; IF THERE IS AN ERROR, XXX(1) WILL CONTAIN "ERROR|msg"_$C(30) WHERE 'msg' IS THE ERROR MESSAGE
"RTN","BMXADO",7,0)
; E.G."ERROR|Invalid schema IEN"
"RTN","BMXADO",8,0)
;
"RTN","BMXADO",9,0)
;
"RTN","BMXADO",10,0)
SSD(OUT,SIEN,DAS,VSTG,JSTG) ;Debug entry point
"RTN","BMXADO",11,0)
D DEBUG^%Serenji("SS^BMXADO(.OUT,SIEN,DAS,VSTG,JSTG)") ; DEBUGGER ENTRY POINT
"RTN","BMXADO",12,0)
Q
"RTN","BMXADO",13,0)
;
"RTN","BMXADO",14,0)
;
"RTN","BMXADO",15,0)
SS(OUT,SIEN,DAS,VSTG,JSTG) ; EP - RETURN THE SCHEMA STRING IN AN ARRAY
"RTN","BMXADO",16,0)
; OUT=OUTPUT VARIABLE (PASSED BY REFERENCE)
"RTN","BMXADO",17,0)
; THE OUTPUT ARRAY IS GENERATED FROM DATA IN THE 'BMX ADO SCHEMA' FILE AND THE FILEMAN DATABASE
"RTN","BMXADO",18,0)
; RECORDS ARE SEPARATED WITH $C(30). FIELDS ARE SEPARATED BY "^". FIELD PROPERTIES ARE SEPARATED BY "|".
"RTN","BMXADO",19,0)
; ONE RECORD PER OUTPUT NODE.
"RTN","BMXADO",20,0)
; 1ST RECORD IS THE "INTRODUCTION RECORD": "@@@meta@@@BMXIEN|FILE #|DA STRING"
"RTN","BMXADO",21,0)
; THE SECOND RECORD IS THE HEADER RECORD. THE REST ARE THE DATA RECORDS
"RTN","BMXADO",22,0)
; RECORD FORMAT: FILE#|FIELD#|DATA TYPE|LENGTH|FIELDNAME|READONLY|KEYFIELD|NULLOK_$C(30)
"RTN","BMXADO",23,0)
; SIEN=SCHEMA NAME OR IEN FROM BMX ADO SCHEMA FILE
"RTN","BMXADO",24,0)
; DAS= "DA" STRING: STRING FOR DEFINING PARENT FILES
"RTN","BMXADO",25,0)
; EXAMPLE: "4,8," CORRESPONDS TO DA(2), DA(1).
"RTN","BMXADO",26,0)
; PRIMARILY USED AS A "SEED" FOR RE-ENTRY - IF INDEX IS PRESENT.
"RTN","BMXADO",27,0)
; IF NOT A SEED, DO NOT INCLUDE THE BOTTOM LEVEL IEN: DA; E.G., "4,8,"
"RTN","BMXADO",28,0)
; DO NOT CONFUSE WITH "IENS STRING" OF FILEMAN SILENT CALLS
"RTN","BMXADO",29,0)
; VSTG=VIEW STRING INSTRUCTIONS (SEE BMXADOV FOR DETAILS)
"RTN","BMXADO",30,0)
; JSTG=JOIN STRING INSTRUCTIONS (SEE BMXADOVJ FOR DETAILS)
"RTN","BMXADO",31,0)
;
"RTN","BMXADO",32,0)
N X,Y,DIC,ERR
"RTN","BMXADO",33,0)
S OUT=$NA(^TMP("BMX ADO",$J)) K @OUT ; DEFINE THE OUTPUT ARRAY CLOSED REFERENCE
"RTN","BMXADO",34,0)
X ("S "_$C(68)_"UZ(0)=$C(64)") ; INSURE PRIVELEGES
"RTN","BMXADO",35,0)
S X="MERR^BMXADO",@^%ZOSF("TRAP") ; SET MUMPS ERROR TRAP
"RTN","BMXADO",36,0)
I '$L(SIEN) S ERR="Missing schema ID" D ERR(ERR) Q
"RTN","BMXADO",37,0)
I 'SIEN S DIC="^BMXADO(",DIC(0)="M",X=SIEN D ^DIC S SIEN=+Y I Y=-1 S ERR="Invalid schema ID" D ERR(ERR) Q
"RTN","BMXADO",38,0)
I '$D(^BMXADO(SIEN,0)) S ERR="Invalid/missing schema" D ERR(ERR) Q ; SCHEMA MUST EXIST
"RTN","BMXADO",39,0)
N FIEN,FLDIEN,TOT,STG,B,C,X,%,LEVEL,Y,SF
"RTN","BMXADO",40,0)
S FIEN=$P(^BMXADO(SIEN,0),U,2)
"RTN","BMXADO",41,0)
I '$D(^DD(FIEN,0)) S ERR="Invalid/missing file number in schema file" D ERR(ERR) Q ; INVALID FILE NUMBER
"RTN","BMXADO",42,0)
S SF=$$CKSUB(FIEN,DAS) I SF=-1 S ERR="Invalid DA string" D ERR(ERR) Q ; INVALID DA STRING
"RTN","BMXADO",43,0)
S C=",",B="|",TOT=0 ; THESE LOCALS, ALONG WITH KERNEL VARIABLES, ARE ALWAYS AVAILABLE TO ALL ROUTINES AND SUBROUTINES
"RTN","BMXADO",44,0)
JEP ; EP-RECURSION RE-ENTRY POINT FOR JOINS
"RTN","BMXADO",45,0)
I $G(SUB),$G(SF) S ERR="Invalid request" D ERR(ERR) Q ; CAN'T DO JOIN WITH A SUBFILE AS THE PRIMARY FILE
"RTN","BMXADO",46,0)
S TOT=TOT+1,@OUT@(TOT)="@@@meta@@@BMXIEN"_B_FIEN_B_DAS_U
"RTN","BMXADO",47,0)
I $G(SUB) S TOT=TOT+1,@OUT@(TOT)=FIEN_"|.0001|N|15|DA(1)|TRUE|FALSE|FALSE^"
"RTN","BMXADO",48,0)
I $G(SF) D SFH(SF) ; SUBFILE HEADERS
"RTN","BMXADO",49,0)
S TOT=TOT+1,@OUT@(TOT)=FIEN_"|.001|N|15|BMXIEN|TRUE|TRUE|FALSE^" ; KEY FIELD PART OF HEADER RECORD
"RTN","BMXADO",50,0)
S FLDIEN=0
"RTN","BMXADO",51,0)
F S FLDIEN=$O(^BMXADO(SIEN,1,FLDIEN)) Q:'FLDIEN S STG=$G(^BMXADO(SIEN,1,FLDIEN,0)) I $L(STG) D ; REST OF HEADER RECORD
"RTN","BMXADO",52,0)
. S X=FIEN_B_$P(STG,U)_B_$P(STG,U,2)_B_$P(STG,U,3)_B_$P(STG,U,4)_B
"RTN","BMXADO",53,0)
. S %=$S($P(STG,U,5):"TRUE",$P($G(^BMXADO(+$G(IEN),0)),U,3):"TRUE",1:"FALSE") S X=X_%_B ; READ ONLY
"RTN","BMXADO",54,0)
. S %=$S($P(STG,U,6):"TRUE",1:"FALSE") S X=X_%_B ; THIS IS A KEY FIELD
"RTN","BMXADO",55,0)
. S %=$S($P(STG,U,7):"TRUE",1:"FALSE") S X=X_%_U ; NULL VALUE IS OK (NOT MANDATORY FOR TRANSACTION)
"RTN","BMXADO",56,0)
. S TOT=TOT+1
"RTN","BMXADO",57,0)
. S @OUT@(TOT)=X
"RTN","BMXADO",58,0)
. Q
"RTN","BMXADO",59,0)
I TOT'>2 Q ; NOTHING TO PROCESS
"RTN","BMXADO",60,0)
S %=@OUT@(TOT) I $E(%,$L(%))=U S $E(%,$L(%))=$C(30),@OUT@(TOT)=% ; END OF RECORD MARKER
"RTN","BMXADO",61,0)
I $G(VSTG)="",$G(DFLD)=.001 S VSTG="~~~" ; SIMPLE LOOKUP INTO DETAILS FILE BY IEN
"RTN","BMXADO",62,0)
I '$L($G(VSTG)) Q ; REQUEST IS FOR SCHEMA ONLY - NO DATA
"RTN","BMXADO",63,0)
DATASET S VSTG=SIEN_"~"_DAS_"~"_VSTG
"RTN","BMXADO",64,0)
I $O(^TMP("BMX JOIN",$J,1,+$G(SDETAIL),0)) D JVIEW Q ; JOIN ITERATION ; NO SUPPORT FOR EXTENDED JOINS
"RTN","BMXADO",65,0)
D VIEW^BMXADOV(.OUT,VSTG,.TOT) ; APPEND A DATA SET TO A SCHEMA STRING
"RTN","BMXADO",66,0)
I '$L($G(JSTG)) S JSTG=$P(VSTG,"~",11,999) ; INCLUDED FOR BKWD COMPATIBILITY ;JOIN INSTRUCTIONS SPAN MULTIPLE ~ PIECES (11,999) BECAUSE OF POSSIBLE NESTED VSTG
"RTN","BMXADO",67,0)
I $L(JSTG) D JOIN^BMXADOVJ(SIEN,JSTG) ; ADD DATA SET(S) TO FULFIL THE JOIN REQUEST
"RTN","BMXADO",68,0)
Q
"RTN","BMXADO",69,0)
;
"RTN","BMXADO",70,0)
JVIEW ; JOIN VIEW - SET XCNT AND RESET THE VSTG
"RTN","BMXADO",71,0)
N XCNT,DA,NODE,%
"RTN","BMXADO",72,0)
S NODE=999999999999
"RTN","BMXADO",73,0)
F S NODE=$O(@OUT@(NODE),-1) Q:'NODE I @OUT@(NODE)["|.001|" Q
"RTN","BMXADO",74,0)
I 'NODE Q ; INVALID SCHEMA - JOIN CANCELLED
"RTN","BMXADO",75,0)
I '$L($P(VSTG,"~",3)),'$G(SUB),$G(DFLD)'=.001 Q ; THERE MUST BE AN INDEX OR SUBFILE FOR A JOIN TO TAKE PLACE
"RTN","BMXADO",76,0)
D JFLD^BMXADOVJ ; STUFF VALUES FOR JOIN FLDS INTO INTRO SEGMENT OF THE SCHEMA
"RTN","BMXADO",77,0)
S XCNT=NODE
"RTN","BMXADO",78,0)
S DA=0
"RTN","BMXADO",79,0)
F S DA=$O(^TMP("BMX JOIN",$J,1,SDETAIL,DA)) Q:'DA D D VIEW^BMXADOV(.OUT,VSTG,.TOT) ; APPEND JOINED DATA SETS TO A SCHEMA STRING
"RTN","BMXADO",80,0)
. I $P(VSTG,"~",3)="AA",$L($P(VSTG,"~",10)) D Q
"RTN","BMXADO",81,0)
.. S %=$P(VSTG,"~",10)
"RTN","BMXADO",82,0)
.. S $P(%,"|",1)=DA
"RTN","BMXADO",83,0)
.. S $P(VSTG,"~",10)=%
"RTN","BMXADO",84,0)
.. Q
"RTN","BMXADO",85,0)
. I $G(SUB) S DAS=DA_",",VSTG=SDETAIL_"~"_DA_",~~" Q ; SUBFILE ITERATOR
"RTN","BMXADO",86,0)
. I $P(VSTG,"~",3)="AA",$G(FIEN)=9000011 S $P(VSTG,"~",4,5)=DA_"~"_DA Q ; PROBLEM LIST ITERATOR
"RTN","BMXADO",87,0)
. S $P(VSTG,"~",4,5)=DA_"~"_DA ; SINGLE IEN ITERATOR
"RTN","BMXADO",88,0)
. Q
"RTN","BMXADO",89,0)
Q
"RTN","BMXADO",90,0)
;
"RTN","BMXADO",91,0)
SFH(DAS) ; SUBFILE HEADERS
"RTN","BMXADO",92,0)
N L,LEV,PCE,X,%,Z,FLD
"RTN","BMXADO",93,0)
S Z="000000000",L=$L(DAS,",")
"RTN","BMXADO",94,0)
F PCE=1:1:L-1 D
"RTN","BMXADO",95,0)
. S LEV=(L+1)-PCE
"RTN","BMXADO",96,0)
. S FLD="."_$E(Z,1,LEV+1)_1
"RTN","BMXADO",97,0)
. S TOT=TOT+1
"RTN","BMXADO",98,0)
. S @OUT@(TOT)=FIEN_B_FLD_"|I|10|BMXIEN"_(LEV-1)_"|TRUE|TRUE|FALSE"_U ; FIX
"RTN","BMXADO",99,0)
. Q
"RTN","BMXADO",100,0)
Q
"RTN","BMXADO",101,0)
;
"RTN","BMXADO",102,0)
CKSUB(FILE,DAS) ; CHECK THE DA STRING FOR VALIDITY AND MAKE THE DA ARRAY
"RTN","BMXADO",103,0)
N LEVEL,FIEN
"RTN","BMXADO",104,0)
S FIEN=FILE
"RTN","BMXADO",105,0)
F LEVEL=1:1 S FIEN=$G(^DD(FIEN,0,"UP")) Q:'FIEN ; COUNT THE LEVELS
"RTN","BMXADO",106,0)
I LEVEL'=$L($G(DAS),",") Q -1 ; LEVEL MATCHES DA STRING
"RTN","BMXADO",107,0)
I LEVEL=1 Q "" ; INVALID DA STRING
"RTN","BMXADO",108,0)
Q DAS
"RTN","BMXADO",109,0)
;
"RTN","BMXADO",110,0)
LINE(FILE) ; GET FIELD VALUES
"RTN","BMXADO",111,0)
N LINE,NODE,STG,DIR,FLD,PF,SET,X,DS,DP
"RTN","BMXADO",112,0)
S LINE=""
"RTN","BMXADO",113,0)
S NODE=2,Y="" F S NODE=$O(ARR(NODE)) Q:'NODE S STG=ARR(NODE) I $L(STG) D I Y=U Q
"RTN","BMXADO",114,0)
. S FLD=$P(STG,B,2) I 'FLD S Y=U Q
"RTN","BMXADO",115,0)
. I $P(STG,B,6)="TRUE" Q ; READ ONLY
"RTN","BMXADO",116,0)
. S DIR("A")=$P(STG,B,5) I '$L(DIR("A")) S Y=U Q
"RTN","BMXADO",117,0)
. S X=$P($G(^DD(+$G(FILE),FLD,0)),U,2)
"RTN","BMXADO",118,0)
. I X["P" D Q
"RTN","BMXADO",119,0)
.. S PF=+$P(X,"P",2) I 'PF S Y=U Q
"RTN","BMXADO",120,0)
.. S DIR(0)="P^"_PF_":EQMZ"
"RTN","BMXADO",121,0)
.. D DIR
"RTN","BMXADO",122,0)
.. Q
"RTN","BMXADO",123,0)
. I X["S" D Q
"RTN","BMXADO",124,0)
.. S DIR(0)="S^"_$P(^DD(FILE,FLD,0),U,3)
"RTN","BMXADO",125,0)
.. D DIR
"RTN","BMXADO",126,0)
.. Q
"RTN","BMXADO",127,0)
. I X["D" D Q
"RTN","BMXADO",128,0)
.. S DS=$P(^DD(FILE,FLD,0),U,5)
"RTN","BMXADO",129,0)
.. I DS'["%DT=""" S DIR(0)="D^::EX" D DIR Q
"RTN","BMXADO",130,0)
.. S DP=$P(DS,"%DT="_$C(34),2) S DP=$P(DP,$C(34,32),1)
"RTN","BMXADO",131,0)
.. S DIR(0)="D^::"_DP
"RTN","BMXADO",132,0)
.. D DIR
"RTN","BMXADO",133,0)
.. Q
"RTN","BMXADO",134,0)
. S DIR="F"
"RTN","BMXADO",135,0)
. D DIR
"RTN","BMXADO",136,0)
. Q
"RTN","BMXADO",137,0)
Q LINE
"RTN","BMXADO",138,0)
;
"RTN","BMXADO",139,0)
DIR D ^DIR
"RTN","BMXADO",140,0)
I Y?1."^" S Y=U Q
"RTN","BMXADO",141,0)
I Y?1.N1"^".E S Y="`"_+Y
"RTN","BMXADO",142,0)
S LINE=LINE_U_Y
"RTN","BMXADO",143,0)
Q
"RTN","BMXADO",144,0)
;
"RTN","BMXADO",145,0)
MERR ; MUMPS ERROR TRAP
"RTN","BMXADO",146,0)
N X
"RTN","BMXADO",147,0)
X ("S X=$"_"ZE")
"RTN","BMXADO",148,0)
S X="MUMPS error: """_X_""""
"RTN","BMXADO",149,0)
D ERR(X)
"RTN","BMXADO",150,0)
Q
"RTN","BMXADO",151,0)
;
"RTN","BMXADO",152,0)
ERR(ERR) ;EP - BMX ADO SCHEMA ERROR PROCESSOR
"RTN","BMXADO",153,0)
N X
"RTN","BMXADO",154,0)
S X="ERROR|"_ERR_$C(30)
"RTN","BMXADO",155,0)
S @OUT@(1)=X
"RTN","BMXADO",156,0)
Q
"RTN","BMXADO",157,0)
;
"RTN","BMXADO2")
0^62^B10227201
"RTN","BMXADO2",1,0)
BMXADO2 ; IHS/CIHA/GIS - BMX ADO RECORDSET UTILS ;
"RTN","BMXADO2",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXADO2",3,0)
;
"RTN","BMXADO2",4,0)
;
"RTN","BMXADO2",5,0)
GEN(BMXY,BMXF) ;EP - Generate an ADO Schema string from a list of fields
"RTN","BMXADO2",6,0)
;BMXY Is an out-parameter called by reference.
"RTN","BMXADO2",7,0)
;On return, BMXY will be a zero-based one-dimensional array each node of which will
"RTN","BMXADO2",8,0)
;contain the schema corresponding to the fields info in BMXF
"RTN","BMXADO2",9,0)
;
"RTN","BMXADO2",10,0)
;BMXF is an in-parameter called by reference.
"RTN","BMXADO2",11,0)
;On input, BMXF will contain the field info on which to build the schema string.
"RTN","BMXADO2",12,0)
;
"RTN","BMXADO2",13,0)
;Field info in BMXF is arranged in a zero-based one-dimensional array.
"RTN","BMXADO2",14,0)
;Node 0 of BMXF contains the KEYFIELDNAME^FILENUMBER^READONLY
"RTN","BMXADO2",15,0)
;where KEYFIELDNAME is the name of the unique key field in the database and
"RTN","BMXADO2",16,0)
;FILENUMBER is the FileMan file number and
"RTN","BMXADO2",17,0)
;READONLY denotes whether the entire recordset is updateable.
"RTN","BMXADO2",18,0)
;
"RTN","BMXADO2",19,0)
;Each subsequent node of the BMXF arrray contains field info in the form
"RTN","BMXADO2",20,0)
;1FILE#^2FIELD#^3LENGTH^4DATATYPE^5ALIAS^6READONLY^7KEYFIELD^8NULLOK
"RTN","BMXADO2",21,0)
;If FILE# AND FIELD# are defined, the LENGTH and DATATYPE will be taken from the FileMan data dictionary
"RTN","BMXADO2",22,0)
;If ALIAS is defined, the schema string will use ALIAS as the column name
"RTN","BMXADO2",23,0)
;READONLY, KEYFIELD and NULLOK are binary fields. Note that there should be only one field
"RTN","BMXADO2",24,0)
;in the recordset having KEYFIELD=TRUE
"RTN","BMXADO2",25,0)
;
"RTN","BMXADO2",26,0)
;New column info format is @@@meta@@@KEYFIELD|FILE#
"RTN","BMXADO2",27,0)
; For each field: ^1FILE#|2FIELD#|3DATATYPE|4LENGTH|5FIELDNAME|6READONLY|7KEYFIELD|8NULL ALLOWED
"RTN","BMXADO2",28,0)
;example:
"RTN","BMXADO2",29,0)
;BMXY(0)="@@@meta@@@BMXIEN|2160010^"
"RTN","BMXADO2",30,0)
;BMXY(1)="2160010|.001|I|10|BMXIEN|TRUE|TRUE|FALSE^"
"RTN","BMXADO2",31,0)
;
"RTN","BMXADO2",32,0)
S BMXY(0)="@@@meta@@@"_$G(BMXF(0))
"RTN","BMXADO2",33,0)
N BMXI,BMXS,BMXFM,BMXDD,BMXTYP,BMXLEN,BMXLEN2,BMXNAM,BMXKEY,BMXREAD,BMXNULL
"RTN","BMXADO2",34,0)
S BMXI=0
"RTN","BMXADO2",35,0)
F S BMXI=$O(BMXF(BMXI)) Q:'+BMXI D
"RTN","BMXADO2",36,0)
. N BMXFM,BMXDD,BMXTYP,BMXLEN,BMXLEN2,BMXNAM,BMXKEY,BMXREAD,BMXNULL
"RTN","BMXADO2",37,0)
. S (BMXDD,BMXTYP,BMXLEN,BMXLEN2,BMXNAM,BMXKEY,BMXREAD,BMXNULL)=""
"RTN","BMXADO2",38,0)
. S BMXFM=0 ;Flag indicating whether BMXF(BMXI) is a FileMan field
"RTN","BMXADO2",39,0)
. S BMXY(BMXI)=""
"RTN","BMXADO2",40,0)
. I BMXF(BMXI) S BMXY(BMXI)=$P(BMXF(BMXI),U,1,2) S BMXFM=1
"RTN","BMXADO2",41,0)
. I BMXFM D ;Look in ^DD for attributes
"RTN","BMXADO2",42,0)
. . S BMXDD=$G(^DD($P(BMXF(BMXI),U),$P(BMXF(BMXI),U,2),0))
"RTN","BMXADO2",43,0)
. . ;column name
"RTN","BMXADO2",44,0)
. . S BMXNAM=$P(BMXDD,U)
"RTN","BMXADO2",45,0)
. . S BMXNAM=$TR(BMXNAM," ","_")
"RTN","BMXADO2",46,0)
. . ;Data type
"RTN","BMXADO2",47,0)
. . I $P(BMXDD,U,2)["P" S BMXDD=$$PTYPE(BMXDD)
"RTN","BMXADO2",48,0)
. . S BMXTYP=$P(BMXDD,U,2)
"RTN","BMXADO2",49,0)
. . S BMXTYP=$S(BMXTYP["F":"T",BMXTYP["S":"T",BMXTYP["D":"D")
"RTN","BMXADO2",50,0)
. . I BMXTYP["N" S BMXTYP=$S($P(BMXTYP,",",2)>0:"N",1:"I")
"RTN","BMXADO2",51,0)
. . ;default columnn lengths based on type
"RTN","BMXADO2",52,0)
. . I BMXTYP="N"!(BMXTYP="I") S BMXLEN=$P(BMXDD,U,2),BMXLEN=$P(BMXLEN,","),BMXLEN=$E(BMXLEN,3,$L(BMXLEN))
"RTN","BMXADO2",53,0)
. . I BMXTYP="I" S BMXLEN2=$P(BMXDD,U,2),BMXLEN2=$P(BMXLEN,",",2),BMXLEN=BMXLEN+BMXLEN2+1
"RTN","BMXADO2",54,0)
. . I BMXTYP="T" S BMXLEN=0
"RTN","BMXADO2",55,0)
. . I BMXTYP="D" S BMXLEN=30
"RTN","BMXADO2",56,0)
. . S BMXNULL="TRUE" S:$P(BMXDD,U,2)["R" BMXNULL="FALSE"
"RTN","BMXADO2",57,0)
. ;Look in BMXF for user-specified attributes
"RTN","BMXADO2",58,0)
. S:$P(BMXF(BMXI),U,5)]"" BMXNAM=$P(BMXF(BMXI),U,5) ;Alias
"RTN","BMXADO2",59,0)
. ;Set KEY, NULL and READONLY
"RTN","BMXADO2",60,0)
. S BMXNULL="TRUE",BMXREAD="TRUE",BMXKEY="FALSE"
"RTN","BMXADO2",61,0)
. I $P(BMXF(BMXI),U,7)="TRUE" S BMXKEY="TRUE",BMXNULL="FALSE",BMXREAD="TRUE"
"RTN","BMXADO2",62,0)
. E S:$P(BMXF(BMXI),U,8)]"" BMXNULL=$P(BMXF(BMXI),U,8) S:$P(BMXF(BMXI),U,6)]"" BMXREAD=$P(BMXF(BMXI),U,6)
"RTN","BMXADO2",63,0)
. ;Set BMXY node
"RTN","BMXADO2",64,0)
. S $P(BMXY(BMXI),"|",3)=BMXTYP
"RTN","BMXADO2",65,0)
. S $P(BMXY(BMXI),"|",4)=BMXLEN
"RTN","BMXADO2",66,0)
. S $P(BMXY(BMXI),"|",5)=BMXNAM
"RTN","BMXADO2",67,0)
. S $P(BMXY(BMXI),"|",6)=BMXREAD
"RTN","BMXADO2",68,0)
. S $P(BMXY(BMXI),"|",7)=BMXKEY
"RTN","BMXADO2",69,0)
. S $P(BMXY(BMXI),"|",8)=BMXNULL
"RTN","BMXADO2",70,0)
;
"RTN","BMXADO2",71,0)
Q
"RTN","BMXADO2",72,0)
PTYPE(BMXDD) ;
"RTN","BMXADO2",73,0)
;Traverse pointer chain to retrieve data type of pointed-to field
"RTN","BMXADO2",74,0)
N BMXFILE
"RTN","BMXADO2",75,0)
I $P(BMXDD,U,2)'["P" Q BMXDD
"RTN","BMXADO2",76,0)
S BMXFILE=$P(BMXDD,U,2)
"RTN","BMXADO2",77,0)
S BMXFILE=+$P(BMXFILE,"P",2)
"RTN","BMXADO2",78,0)
S BMXDD=$G(^DD(BMXFILE,".01",0))
"RTN","BMXADO2",79,0)
S BMXDD=$$PTYPE(BMXDD)
"RTN","BMXADO2",80,0)
Q BMXDD
"RTN","BMXADOF")
0^63^B90964967
"RTN","BMXADOF",1,0)
BMXADOF ; IHS/CIHA/GIS - RPC CALL FOR EXTENDED FUNCTIONALITY OF BMXNet UTILITIES ;
"RTN","BMXADOF",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXADOF",3,0)
; THIS IS THE ADO RECORDSET FILER: ADO -> FILEMAN
"RTN","BMXADOF",4,0)
; VISIT FILE UPDATES REPRESENT A SPECIAL CASE HTAT IS MANAGED IN BMXADOF1
"RTN","BMXADOF",5,0)
; INCLUDES TRANSACTION CONTROLS
"RTN","BMXADOF",6,0)
;
"RTN","BMXADOF",7,0)
;
"RTN","BMXADOF",8,0)
;
"RTN","BMXADOF",9,0)
N DAS,FILE,DATA,OUT S DAS=7,FILE=19707.82,DATA="2.02|120/83" D FILE(.OUT,FILE,DAS,DATA) W !,OUT Q
"RTN","BMXADOF",10,0)
;
"RTN","BMXADOF",11,0)
FILED(OUT,FILE,DAS,DATA) ; RPC CALL: UNIVERSAL FILEMAN RECORD UPDATER UTILITY
"RTN","BMXADOF",12,0)
D DEBUG^%Serenji("FILE^BMXADOF(.OUT,FILE,DAS,DATA)") ; DEBUGGER ENTRY POINT
"RTN","BMXADOF",13,0)
; K ^GREG S ^GREG("OUT")=$G(OUT),^("FILE")=$G(FILE),^("DAS")=$G(DAS),^("DATA")=$G(DATA) D FILE(.OUT,FILE,DAS,DATA)
"RTN","BMXADOF",14,0)
Q
"RTN","BMXADOF",15,0)
;
"RTN","BMXADOF",16,0)
FILEX(OUT,FILE,DAS,DATA) ; EP - RPC CALL: INSURES THAT BMXIEN IS VALID - MOJO ONLY
"RTN","BMXADOF",17,0)
I '$L($G(DATA)) D
"RTN","BMXADOF",18,0)
. S DATA="",%=""
"RTN","BMXADOF",19,0)
. F S %=$O(DATA(%)) Q:'% S DATA=DATA_DATA(%) ; CONVERT DATA ARRAY INTO A DATA STRING
"RTN","BMXADOF",20,0)
. Q
"RTN","BMXADOF",21,0)
I '$L(DATA) Q
"RTN","BMXADOF",22,0)
I DATA["999|" S DAS=+$P(DATA,"999|",2) I 'DAS S DAS="" ; FORCE NEW ENTRY
"RTN","BMXADOF",23,0)
D FILE(.OUT,FILE,$G(DAS),DATA)
"RTN","BMXADOF",24,0)
Q
"RTN","BMXADOF",25,0)
;
"RTN","BMXADOF",26,0)
FILE(OUT,FILE,DAS,DATA) ;EP - RPC CALL: UNIVERSAL FILEMAN RECORD UPDATER UTILITY
"RTN","BMXADOF",27,0)
;
"RTN","BMXADOF",28,0)
; OUT = OUTBOUND MESSAGE RETURNED TO CALLINING APP. 'OK'=SUCCESSFUL TRANSACTION, 'OK|5' NEW RECORD DAS=5 ADDED
"RTN","BMXADOF",29,0)
; IF TRANSACTION FAILS, AN ERROR MESSAGE IS PASSED
"RTN","BMXADOF",30,0)
; FILE = VALID FILEMAN FILE OR SUB-FILE NUMBER - WHERE UPDATE IS TO OCCUR
"RTN","BMXADOF",31,0)
; DAS = THE DA STRING - TYPICALLY THE FILE INTERNAL ENTRY NUMBER OF THE RECORD TO BE UPDATED
"RTN","BMXADOF",32,0)
; IF THIS IS A SUB-FILE, DAS MUST BE PRECEDED BY PARENT DAS(S) IN COMMA SEPARATED STRING - TOP TO BOTTOM ORDER
"RTN","BMXADOF",33,0)
; DAS MAY BE PRECEDED BY '+' = ALL FIELDS ARE MANDATORY (REQD FOR TRANSACTION) OR '-' = DELETE THIS ENTRY
"RTN","BMXADOF",34,0)
; IF DAS STRING = NULL OR = '+', THIS MEANS ADD A NEW RECORD WITH DATA SUPPLIED IN DATA PARAMETER
"RTN","BMXADOF",35,0)
; EXAMPLES OF DAS STRINGS: '1' (EDIT RECORD #1), '5,2,-7' (DELETE RECORD #7 IN 3RD LEVEL SUBFILE)
"RTN","BMXADOF",36,0)
; DATA = DATA STRING OR ARRAY REFERENCE. DATA CAN BE PASSED USING THE .PARAM SYNTAX
"RTN","BMXADOF",37,0)
; DATA STRING FORMAT: FIELD#|VALUE_$C(30)_FIELD#|VALUE_$C(30)_...FIELD#|VALUE_$C(30)
"RTN","BMXADOF",38,0)
; $C(30) [AKA EOR] IS THE DATA ELEMENT SEPARATOR
"RTN","BMXADOF",39,0)
; $C(30) IS USED AS THE DATA DELIMITER BECAUSE OTHER CHARACTERS LIKE '^' COULD APPEAR IN THE VALUE PIECE!
"RTN","BMXADOF",40,0)
; EA FIELD# MAY BE PRECEED BY '+' = MANDATORY (REQD FOR TRANSACTION) OR '-' = DELETE THE VALUE OF THIS FIELD
"RTN","BMXADOF",41,0)
; EXAMPLE: ".03|1/5/46"_EOR_"-.02|"_EOR_"+.09|139394444"_EOR NOTE -.02| IS SAME AS .02|@ OR .02|
"RTN","BMXADOF",42,0)
; '+' IN FRONT OF THE DAS IS THE SAME AS PUTTING A '+' IN FRONT OF EVERY FIELD# IN THE DATA STRING
"RTN","BMXADOF",43,0)
;
"RTN","BMXADOF",44,0)
;
"RTN","BMXADOF",45,0)
;
"RTN","BMXADOF",46,0)
N VENDUZ,VUZ
"RTN","BMXADOF",47,0)
M VENDUZ=DUZ S VUZ=$C(68,85,90)
"RTN","BMXADOF",48,0)
N OREF,CREF,DIC,DIE,DA,DR,X,Y,%,I,FLD,CNT,FNO,VAL,@VUZ,TFLG,DFLG,TOT,UFLG,XTFLG,GTFLG,GDFLG,LVLS,IENS
"RTN","BMXADOF",49,0)
I $G(FILE)=9000010 N AUPNPAT,AUPNDOB,AUPNDOD,AUPNVSIT,AUPNTALK,APCDOVRR S (APCDOVRR,AUPNTALK)=1 ; THE VISIT FILE IS UPDATED IN THIS TRANSACTION
"RTN","BMXADOF",50,0)
X ("M "_$C(68,85,90)_"=VENDUZ S "_$C(68,85,90)_"(0)="_$C(34,64,34)) K VENDUZ ; ELININATES PERMISSION PROBLEMS
"RTN","BMXADOF",51,0)
S OUT="",FLD="",GTFLG=0,GDFLG=0
"RTN","BMXADOF",52,0)
S X="MERR^BMXADOF",@^%ZOSF("TRAP") ; SET MUMPS ERROR TRAP
"RTN","BMXADOF",53,0)
I '$D(^DD(+$G(FILE))) S OUT="Invalid file number" Q ; FILE # MUST BE VALID
"RTN","BMXADOF",54,0)
S DAS=$G(DAS) I $E(DAS)="," S DAS=$E(DAS,2,99) ; ACCURATE IF NON SUB-FILE DAS STRING DOSN'T CONTAIN A ","
"RTN","BMXADOF",55,0)
S LVLS=$L(DAS,",")
"RTN","BMXADOF",56,0)
S %=FILE F CNT=1:1 S %=$G(^DD(%,0,"UP")) I '% Q ; COUNT FILE/SUB-FILE LEVELS IN THE DATA DICTIONARY
"RTN","BMXADOF",57,0)
I LVLS'=CNT S OUT="Invalid DAS string" Q ; LEVELS IN DAS STRING MUST MATCH LEVELS IN THE DATA DICTIONARY
"RTN","BMXADOF",58,0)
I $E(DAS)="-" S DAS=$E(DAS,2,99),GDFLG=1 ; GLOBAL DELETE FLAG
"RTN","BMXADOF",59,0)
I $E(DAS)="+" S DAS=$E(DAS,2,99),GTFLG=1 ; GLOBAL TRANSACTION FLAG, ROLLBACK IF ANY FIELD FAILS TO UPDATE
"RTN","BMXADOF",60,0)
I LVLS>1 F I=1:1:LVLS D I DAS="ERR" S OUT="Invalid DAS string" Q ; MAKE DAS ARRAY. MIRRORS THE DA() ARRAY
"RTN","BMXADOF",61,0)
. I I=LVLS S DAS=$P(DAS,",",I) Q ; SET DAS OF SUBFILE
"RTN","BMXADOF",62,0)
. S %=$P(DAS,",",I) I '% S DAS="ERR" Q
"RTN","BMXADOF",63,0)
. S DAS(LVLS-I)=% ; SET DAS(S) OF PARENT FILE(S). LIKE DA(), THE LARGER THE DAS SUBSCRIPT, THE HIGHER THE LEVEL
"RTN","BMXADOF",64,0)
. Q
"RTN","BMXADOF",65,0)
I DAS="ERR" S OUT="Update cancelled. Invalid DAS string" Q
"RTN","BMXADOF",66,0)
I DAS="Add"!(DAS="ADD") S DAS=""
"RTN","BMXADOF",67,0)
S %=$E(DAS) I %="-" S GDFLG=1,DAS=$E(DAS,2,99) ; YET ANOTHER WAY TO SET GLOBAL DELETE FLAG
"RTN","BMXADOF",68,0)
S %=$$REF(FILE,.DAS) ; GET OPEN REF, CLOSED REF, AND IENS STRING
"RTN","BMXADOF",69,0)
S OREF=$P(%,"|"),CREF=$P(%,"|",2),IENS=$P(%,"|",3) I $L(OREF),$L(CREF)
"RTN","BMXADOF",70,0)
E S OUT="Update cancelled. Invalid file definition/global reference" Q ; ERROR REPORT
"RTN","BMXADOF",71,0)
I DAS,'$D(@CREF@(DAS)) S OUT="Update cancelled. Invalid DAS" Q ; IF THERE IS AN DAS, IT MUST BE VALID
"RTN","BMXADOF",72,0)
I '$G(DAS),FILE=9000010,'$$VVAR^BMXADOF2(DATA) Q ; VISIT FILE ADD REQUIRES THAT SPECIAL VARIABLES BE PRESENT AND VALID
"RTN","BMXADOF",73,0)
I 'GDFLG,DAS,DATA[".01|@" S GDFLG=1 ; ALTERNATE WAY TO SET GLOBAL DELETE FLAG: REMOVE .01 FIELD
"RTN","BMXADOF",74,0)
I GDFLG,'DAS S OUT="Deletion cancelled. Missing DAS" Q ; CAN'T DO DELETE WITHOUT AN DAS
"RTN","BMXADOF",75,0)
I GDFLG D DIK(OREF,DAS) S OUT="Record deleted|"_DAS Q ; DELETE AND QUIT
"RTN","BMXADOF",76,0)
S UFLG=$S($G(DAS):"E",1:"A") ; SET UPDATE FLAG: ADD OR EDIT
"RTN","BMXADOF",77,0)
I '$L($G(DATA)) D I '$L($G(DATA)) S OUT="Update cancelled. Missing/invalid data string" Q ; COMPRESS DATA ARRAY INTO A SINGLE STRING
"RTN","BMXADOF",78,0)
. S DATA="",%=""
"RTN","BMXADOF",79,0)
. F S %=$O(DATA(%)) Q:'% S DATA=DATA_DATA(%) ; CONVERT DATA ARRAY INTO A DATA STRING
"RTN","BMXADOF",80,0)
. Q
"RTN","BMXADOF",81,0)
S %=$L(DATA) S %=$E(DATA,%-1,%) D ; CHECK FOR PROPER TERMINATION OF DATA STRING
"RTN","BMXADOF",82,0)
. I %=$C(30,31) Q ; PROPER TERMINATION
"RTN","BMXADOF",83,0)
. I $E(%,2)=$C(30) S DATA=DATA_$C(31) Q
"RTN","BMXADOF",84,0)
. I $E(%,2)=$C(31) S DATA=$E(DATA,1,$L(DATA-1))_$C(30,31)
"RTN","BMXADOF",85,0)
. S DATA=DATA_$C(30,31)
"RTN","BMXADOF",86,0)
. Q
"RTN","BMXADOF",87,0)
S TOT=$L(DATA,$C(30)) I 'TOT S OUT="Update cancelled. Missing data string" Q
"RTN","BMXADOF",88,0)
SPEC S DATA=$$SPEC^BMXADOFS(FILE,DATA,UFLG) ; BASED ON FILE IEN, SPECIAL MODS MAY BE MADE TO THE DATA STRING
"RTN","BMXADOF",89,0)
S TOT=$L(DATA,$C(30)) I 'TOT S OUT="Update cancelled. SPEC analysis failed." Q
"RTN","BMXADOF",90,0)
F CNT=1:1:TOT S %=$P(DATA,$C(30),CNT) I $L(%) S DATA(CNT)=% ; BUILD PRIMARY FIELD ARRAY
"RTN","BMXADOF",91,0)
S %=$G(DATA(1)) I %=""!(%=$C(31)) S OUT="Update cancelled. Missing data string" Q
"RTN","BMXADOF",92,0)
S %=DATA(CNT) I %[$C(31) S %=$P(%,$C(31),1),DATA(CNT)=% ; STRIP OFF END OF FILE MARKER
"RTN","BMXADOF",93,0)
F CNT=1:1:TOT S X=$G(DATA(CNT)) I $L(X) D ; BUILD SECONDARY FIELD ARRAY
"RTN","BMXADOF",94,0)
. S TFLG=0,DFLG=0
"RTN","BMXADOF",95,0)
. I $E(X)="+" S TFLG=1,X=$E(X,2,999),$P(FLD,U)=1
"RTN","BMXADOF",96,0)
. I $E(X)="-" S DFLG=1,X=$E(X,2,999)
"RTN","BMXADOF",97,0)
. S FNO=$P(X,"|"),VAL=$P(X,"|",2)
"RTN","BMXADOF",98,0)
. I '$D(^DD(FILE,+$G(FNO),0)) S:$L(OUT) OUT=OUT_"~" S OUT=OUT_FNO_"|Invalid field number" Q
"RTN","BMXADOF",99,0)
. I DFLG,VAL'="" S:$L(OUT) OUT=OUT_"~" S OUT=OUT_FNO_"|Invalid deletion syntax" Q ; CANT DELETE IF A VALUE IS SENT
"RTN","BMXADOF",100,0)
. I VAL="@" S DFLG=1 ; SYNC DFLG AND VAL
"RTN","BMXADOF",101,0)
. S FLD(FNO)=VAL_U_TFLG_U_DFLG
"RTN","BMXADOF",102,0)
. I FNO=.01,TFLG S $P(FLD,U,2)=1
"RTN","BMXADOF",103,0)
. Q
"RTN","BMXADOF",104,0)
I $P($G(FLD(.01)),U,3),UFLG="A" S OUT="Record deletion cancelled. Missing DAS" Q ; CAN'T DELETE A RECORD WITHOUT A VALID DAS
"RTN","BMXADOF",105,0)
I $P($G(FLD(.01)),U,3)!($G(GDFLG)) S UFLG="D" ; DELETION
"RTN","BMXADOF",106,0)
DELREC I UFLG="D" D DIK(OREF,DAS) S OUT="OK" Q ; DELETE THE RECORD
"RTN","BMXADOF",107,0)
I UFLG="A",'$L($P($G(FLD(.01)),U)) S OUT="Record addition cancelled. Missing .01 field" Q ; CAN'T ADD A RECORD WITHOUT A VALID .01 FIELD
"RTN","BMXADOF",108,0)
DINUM I UFLG="A",$G(^DD(FILE,.01,0))["DINUM=X" D ; IF DINUM'D RECORD EXISTS, SWITCH TO MOD MODE
"RTN","BMXADOF",109,0)
. S %=FLD(.01)
"RTN","BMXADOF",110,0)
. I $E(%)="`" S %=+$E(%,2,99)
"RTN","BMXADOF",111,0)
. I '$D(@CREF@(%,0)) Q ; OK TO ADD BRAND NEW RECORD BUT EXISTING RECORDS MUST BE EDITED
"RTN","BMXADOF",112,0)
. K FLD(.01)
"RTN","BMXADOF",113,0)
. S DAS=%,UFLG="E"
"RTN","BMXADOF",114,0)
. Q
"RTN","BMXADOF",115,0)
ADDREC I UFLG="A" D ADD(OREF) Q ; ADD A NEW ENTRY TO A FILE
"RTN","BMXADOF",116,0)
EDITREC I UFLG="E" D EDIT(OREF,DAS) Q ; EDIT AN EXISTING RECORD
"RTN","BMXADOF",117,0)
Q
"RTN","BMXADOF",118,0)
;
"RTN","BMXADOF",119,0)
DIK(DIK,DA) ; DELETE A RECORD
"RTN","BMXADOF",120,0)
; PATCHED BY GIS 9/28/04 TO FIX PROBLEMS WITH SUBFILE DELETION
"RTN","BMXADOF",121,0)
I '$G(DAS(1)) G DIK1 ; CHECK FOR SUBFILE DELETION
"RTN","BMXADOF",122,0)
N DA,IENS,I,DIK
"RTN","BMXADOF",123,0)
I '$G(FILE) Q
"RTN","BMXADOF",124,0)
S I=0,IENS=DAS_","
"RTN","BMXADOF",125,0)
M DA=DAS
"RTN","BMXADOF",126,0)
F S I=$O(DAS(I)) Q:'I S IENS=IENS_DAS(I)_","
"RTN","BMXADOF",127,0)
S DIK=$$ROOT^DILFD(FILE,IENS) I '$L(DIK) Q
"RTN","BMXADOF",128,0)
DIK1 D ^DIK
"RTN","BMXADOF",129,0)
D ^XBFMK
"RTN","BMXADOF",130,0)
Q
"RTN","BMXADOF",131,0)
;
"RTN","BMXADOF",132,0)
ADD(DIC) ; ADD A NEW ENTRY TO A FILE
"RTN","BMXADOF",133,0)
N X,Y,%,DA,DN,UP,SB,DNODE,ERR
"RTN","BMXADOF",134,0)
S X=$P($G(FLD(.01)),U) I '$L(X) S OUT="Unable to add a new record" Q
"RTN","BMXADOF",135,0)
S X=$$POINT(FILE,.01,X) ; ADD ACCENT GRAV IF NECESSARY
"RTN","BMXADOF",136,0)
S X=""""_X_"""" ; FORCE A NEW ENTRY
"RTN","BMXADOF",137,0)
S DIC(0)="L"
"RTN","BMXADOF",138,0)
I $O(DAS(0)) D I $G(ERR) S Y=-1 G AFAIL ; GET DIC("P") IF NECESSARY
"RTN","BMXADOF",139,0)
. S %=0 F S %=$O(DAS(%)) Q:'% S DA(%)=DAS(%) ; CREATE THE DA ARRAY
"RTN","BMXADOF",140,0)
. S UP=$G(^DD(FILE,0,"UP")) I 'UP S ERR=1 Q
"RTN","BMXADOF",141,0)
. S SB=$O(^DD(UP,"SB",FILE,0)) I 'SB S ERR=1 Q
"RTN","BMXADOF",142,0)
. S DIC("P")=$P($G(^DD(UP,SB,0)),U,2) I '$L(DIC("P")) S ERR=1 Q
"RTN","BMXADOF",143,0)
. S DN=DIC_"1,0)" I $D(DN) Q
"RTN","BMXADOF",144,0)
. S @DN=(U_DIC("P")_U_U) ; CREATE THE DICTIONARY NODE
"RTN","BMXADOF",145,0)
. Q
"RTN","BMXADOF",146,0)
ADIC D ^DIC
"RTN","BMXADOF",147,0)
AFAIL I Y=-1 S OUT="Unable to add a new record" G AX
"RTN","BMXADOF",148,0)
I $O(FLD(0)) D EDIT(DIC,+Y) Q
"RTN","BMXADOF",149,0)
S OUT="OK"_"|"_+Y
"RTN","BMXADOF",150,0)
AX D ^XBFMK
"RTN","BMXADOF",151,0)
Q
"RTN","BMXADOF",152,0)
;
"RTN","BMXADOF",153,0)
EDIT(DIE,DA) ; EDIT AN EXISTING RECORD
"RTN","BMXADOF",154,0)
N DR,RFLG,ERR,FNO,VAL,TFLG,RESULT,MSG,DIERR,DISYS,SF,APCDALVR
"RTN","BMXADOF",155,0)
S FNO=0,DR="",APCDALVR=""
"RTN","BMXADOF",156,0)
I UFLG="A" S OUT="OK New record added|"_DA
"RTN","BMXADOF",157,0)
F S FNO=$O(FLD(FNO)) Q:'FNO S X=FLD(FNO) I $L(X) D I $G(RFLG) Q ; CHECK EA FIELD AND BUILD THE DR STRING AND ERROR STRING
"RTN","BMXADOF",158,0)
. S VAL(FNO)=$P(X,U),TFLG=$P(X,U,2) I '$L(VAL(FNO)) Q
"RTN","BMXADOF",159,0)
. S SF=$$WP(FILE,FNO)
"RTN","BMXADOF",160,0)
. I SF D WORD(FILE,DA,FNO,CREF,VAL(FNO)) Q ; WORD PROCESSING FIELDS MANAGED SEPARATELY
"RTN","BMXADOF",161,0)
. S VAL(FNO)=$$POINT(FILE,FNO,VAL(FNO)) ; ADD ACCENT GRAV IF NECESSARY
"RTN","BMXADOF",162,0)
. K ERR,RESULT
"RTN","BMXADOF",163,0)
. I VAL(FNO)="@"!(VAL(FNO)="") S RESULT="@"
"RTN","BMXADOF",164,0)
. I FNO=.01,UFLG="A" S:$E(VAL(.01))="`" VAL(.01)=$E(VAL(.01),2,999) Q ; NO NEED TO EDIT THE .01 FIELD OF A RECORD THAT HAS JUST BEEN CREATED
"RTN","BMXADOF",165,0)
. I FILE\1=9000010,$L($P(FILE,".",2))=2,UFLG="E",(FNO=.02!(FNO=.03)) Q ; CAN'T EDIT EXISTING PT AND VISIT FIELDS OF V FILES
"RTN","BMXADOF",166,0)
. I FILE\1=9000010,$L($P(FILE,".",2))=2,UFLG="A",FNO=.03,VAL(.03)?1"`"1.N S %=+$E(VAL(.03),2,99) I $D(^AUPNVSIT(%,0)) S RESULT=% G E1
"RTN","BMXADOF",167,0)
. I FILE=9000011,FNO=.07,VAL(.07)?1.N S RESULT=VAL(.07) G E1 ; THE VALIDITY CHECK FAILS - SO BYPASS THIS
"RTN","BMXADOF",168,0)
CHK . I VAL(FNO)'="@" D CHK^DIE(FILE,FNO,"",VAL(FNO),.RESULT,.ERR)
"RTN","BMXADOF",169,0)
E1 . I RESULT=U D Q
"RTN","BMXADOF",170,0)
.. S MSG=$G(ERR("DIERR",1,"TEXT",1),"Failed FileMan data validation")
"RTN","BMXADOF",171,0)
.. I $L(OUT) S OUT=OUT_"~"
"RTN","BMXADOF",172,0)
.. I TFLG!GTFLG S RFLG=1,OUT=FNO_"|"_MSG Q
"RTN","BMXADOF",173,0)
.. S OUT=OUT_FNO_"|"_MSG
"RTN","BMXADOF",174,0)
.. Q
"RTN","BMXADOF",175,0)
. S VAL(FNO)=RESULT
"RTN","BMXADOF",176,0)
. I $L(DR) S DR=DR_";"
"RTN","BMXADOF",177,0)
. I RESULT="@" S DR=DR_FNO_"////@" Q ; DELETE THIS VALUE
"RTN","BMXADOF",178,0)
. S DR=DR_FNO_"////^S X=VAL("_FNO_")" ; BUILD DR STRING
"RTN","BMXADOF",179,0)
. Q
"RTN","BMXADOF",180,0)
I $G(RFLG) D:UFLG="A" DIK(DIE,DA) S OUT="Record update cancelled"_"|"_OUT G EX ; TRANSACTION ROLLBACK FLAG IS SET, ENTRY DELETED (ADD MODE) OR UPDATE CANCELLED (EDIT MODE)
"RTN","BMXADOF",181,0)
S %=0 F S %=$O(DAS(%)) Q:'% S DA(%)=DAS(%) ; JUST IN CASE THIS IS A MILTIPLE, CREATE THE DA ARRAY
"RTN","BMXADOF",182,0)
DIE L +@CREF@(DA):2 I $T D ^DIE L -@CREF@(DA) G:OUT["valid" EX S OUT="OK" S:UFLG="A" OUT=OUT_"|"_DA G EX ; SUCCESS!!!!
"RTN","BMXADOF",183,0)
S OUT="Update cancelled. File locked" ; FILE LOCKED. UNABLE TO UPDATE
"RTN","BMXADOF",184,0)
I $L(FLD),UFLG="A" D DIK(DIE,DA) ; ROLLBACK THE NEW RECORD
"RTN","BMXADOF",185,0)
EX D ^XBFMK ; CLEANUP
"RTN","BMXADOF",186,0)
Q
"RTN","BMXADOF",187,0)
;
"RTN","BMXADOF",188,0)
REF(FILE,DAS) ; GIVEN A FILE/SUBFILE NUMBER & DAS ARRAY, RETURN THE FM GLOBAL REFERENCE INFO: OREF|CREF|IENS
"RTN","BMXADOF",189,0)
N OREF,CREF,IENS,I,X
"RTN","BMXADOF",190,0)
S IENS=$$IENS^DILF(.DAS) I '$L(IENS) Q ""
"RTN","BMXADOF",191,0)
S OREF=$$ROOT^DILFD(FILE,IENS) I '$L(OREF) Q ""
"RTN","BMXADOF",192,0)
S CREF=$$CREF^DILF(OREF) I '$L(CREF) Q ""
"RTN","BMXADOF",193,0)
Q (OREF_"|"_CREF_"|"_IENS)
"RTN","BMXADOF",194,0)
;
"RTN","BMXADOF",195,0)
POINT(FILE,FNO,VAL) ; ADD ACCENT GRAV IF NECESSARY
"RTN","BMXADOF",196,0)
I $E(VAL)="`" Q VAL
"RTN","BMXADOF",197,0)
I $P($G(^DD(FILE,FNO,0)),U,2)["P",VAL=+VAL,VAL\1=VAL S VAL="`"_VAL
"RTN","BMXADOF",198,0)
Q VAL
"RTN","BMXADOF",199,0)
;
"RTN","BMXADOF",200,0)
WP(FILE,FLD) ; RETURN THE SUBFILE NUMBER IF IT IS A WORD PROCESSING FIELD
"RTN","BMXADOF",201,0)
N SF,DTYPE
"RTN","BMXADOF",202,0)
S SF=$P($G(^DD(+$G(FILE),+$G(FLD),0)),U,2) I 'SF Q 0
"RTN","BMXADOF",203,0)
S DTYPE=$P($G(^DD(SF,.01,0)),U,2)
"RTN","BMXADOF",204,0)
I DTYPE["W" Q SF
"RTN","BMXADOF",205,0)
Q 0
"RTN","BMXADOF",206,0)
;
"RTN","BMXADOF",207,0)
WORD(FILE,DA,FLD,CREF,VAL) ; SUFF TEXT ENTRY INTO THE WP MULTIPLE FIELD
"RTN","BMXADOF",208,0)
N SS,TOT,A,B,I
"RTN","BMXADOF",209,0)
S SS=+$P($G(^DD(FILE,FLD,0)),U,4) I SS="" Q
"RTN","BMXADOF",210,0)
I VAL="@"!(VAL="") K @CREF@(DA,SS) Q ; DELETE THE WP RECORD: REMOVE DICTIONARY NODE AND DATA
"RTN","BMXADOF",211,0)
S TOT=0
"RTN","BMXADOF",212,0)
F Q:'$L(VAL) D
"RTN","BMXADOF",213,0)
. S A=$E(VAL,1,80),VAL=$E(VAL,81,999999) ; PEEL OFF AN 80 CHARACTER DATA BLOCK FROM THE FRONT OF THE TEXT STRING
"RTN","BMXADOF",214,0)
. I $L(A) S TOT=TOT+1,B(TOT)=A ; BUILD THE TEMP ARRAY
"RTN","BMXADOF",215,0)
. Q
"RTN","BMXADOF",216,0)
I '$D(B(1)) Q ; NOTHING TO STORE SO QUIT
"RTN","BMXADOF",217,0)
S @CREF@(DA,SS,0)="^^"_TOT_U_TOT_U_DT ; SET DICTIONARY NODE
"RTN","BMXADOF",218,0)
F I=1:1:TOT S @CREF@(DA,SS,I,0)=B(I) ; SET DATA NODES
"RTN","BMXADOF",219,0)
Q
"RTN","BMXADOF",220,0)
;
"RTN","BMXADOF",221,0)
MERR ; MUMPS ERROR TRAP
"RTN","BMXADOF",222,0)
N ERR,X
"RTN","BMXADOF",223,0)
X ("S X=$"_"ZE")
"RTN","BMXADOF",224,0)
S ERR="M ERROR: "_X
"RTN","BMXADOF",225,0)
S ^GREG("ERR")=ERR
"RTN","BMXADOF",226,0)
S OUT=ERR
"RTN","BMXADOF",227,0)
Q
"RTN","BMXADOF",228,0)
;
"RTN","BMXADOF1")
0^64^B12833341
"RTN","BMXADOF1",1,0)
BMXADOF1 ; IHS/CIHA/GIS - RPC CALL FOR EXTENDED FUNCTIONALITY OF BMXNet UTILITIES ;
"RTN","BMXADOF1",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXADOF1",3,0)
; UPDATE FILEMAN WITH AN ADO RECORD SET FROM A WINDOWS/WEB APPLICATION
"RTN","BMXADOF1",4,0)
;
"RTN","BMXADOF1",5,0)
;
"RTN","BMXADOF1",6,0)
D BAFM(.OUT,$NA(^TMP("BMX ADO",6))) ; W !!! ZW OUT K OUT Q
"RTN","BMXADOF1",7,0)
;
"RTN","BMXADOF1",8,0)
BAFM(OUT,CREF) ; EP- RPC: PASS DATA FROM A STD BROKER ADO ARRAY TO FILEMAN AND RETURN THE ACK MSG IN 'OUT' ARRAY
"RTN","BMXADOF1",9,0)
I '$L($G(CREF)) Q ; REFERENCE MUST EXIST
"RTN","BMXADOF1",10,0)
I '$D(@CREF) Q ; DATASET MUST EXIST
"RTN","BMXADOF1",11,0)
N NODE,STG,DATA,SCHEMA,X,ECNT,CNT
"RTN","BMXADOF1",12,0)
S OUT="DONE",ECNT=0,CNT=0
"RTN","BMXADOF1",13,0)
PEEL S NODE=0,STG="" ; PEEL DATA OFF THE ARRAY AND FILE IT
"RTN","BMXADOF1",14,0)
F S NODE=$O(@CREF@(NODE)) Q:'NODE D ; LOOP THRU THE NODES TO BUILD A STRING.
"RTN","BMXADOF1",15,0)
. S X=@CREF@(NODE) I X="" Q
"RTN","BMXADOF1",16,0)
. S STG=STG_X
"RTN","BMXADOF1",17,0)
. I STG[$C(30) D S STG="" Q ; WHEN YOU HIT $C(30), PROCESS THE CURRENT STRING, AND THEN START A NEW STRING.
"RTN","BMXADOF1",18,0)
.. S STG=$TR(STG,$C(30),"") ; REMOVE THE EOR CHARACTER $C(30) FROM THE END OF THE STRING
"RTN","BMXADOF1",19,0)
.. I STG["@@@meta@@@" S SCHEMA=STG Q ; GET SCHEMA STRING. THEN KEEP LOOPING TO GET THE DATA STRINGS
"RTN","BMXADOF1",20,0)
.. D PREP(.OUT,SCHEMA,STG) ; PREP DATA STRING FOR FILING, AND THEN FILE THE DATA
"RTN","BMXADOF1",21,0)
.. Q
"RTN","BMXADOF1",22,0)
. Q
"RTN","BMXADOF1",23,0)
K @CREF ; CLEAN UP
"RTN","BMXADOF1",24,0)
I ECNT=0 S OUT(0)="OK" Q ; SUMMARY NODE OF THE OUTPUT ARRAY
"RTN","BMXADOF1",25,0)
S OUT(0)=ECNT_" error(s) detected in this transaction"
"RTN","BMXADOF1",26,0)
Q
"RTN","BMXADOF1",27,0)
;
"RTN","BMXADOF1",28,0)
PREP(OUT,SCHEMA,DATA) ; PREPARE DATA FOR THE ADO FILER
"RTN","BMXADOF1",29,0)
N TOP,LEV,C,B,%,DA,DAS,PCE,MAX,S,D,FILE,DSTG,MAND,FLD,VAL,MSG
"RTN","BMXADOF1",30,0)
S C=",",B="|",DAS=""
"RTN","BMXADOF1",31,0)
S %=$P(SCHEMA,U,2) S TOP=$P(%,B,2)
"RTN","BMXADOF1",32,0)
S LEV=$L(TOP)-3 I LEV=2 S DAS=+DATA_C
"RTN","BMXADOF1",33,0)
S SCHEMA=$P(SCHEMA,U,2,999)
"RTN","BMXADOF1",34,0)
S MAX=$L(SCHEMA,U)
"RTN","BMXADOF1",35,0)
S FILE=+SCHEMA I '$D(^DD(FILE,0)) S ERR="Update failed. Missing/invalid file number" D ERR(ERR) Q
"RTN","BMXADOF1",36,0)
SPEC ; CHECK FOR SPECIAL CASES
"RTN","BMXADOF1",37,0)
I FILE=9000011,SCHEMA'["|.05|" G DSTG
"RTN","BMXADOF1",38,0)
I FILE=9000010.07,SCHEMA'["|.04|" G DSTG
"RTN","BMXADOF1",39,0)
I FILE=9000010.18,SCHEMA'["|.04|" G DSTG
"RTN","BMXADOF1",40,0)
I FILE=9000013,SCHEMA'["|.04|" G DSTG
"RTN","BMXADOF1",41,0)
I FILE=9000014,SCHEMA'["|.04|" G DSTG
"RTN","BMXADOF1",42,0)
I FILE'=9000010.07,FILE'=9000011,FILE'=9000013,FILE'=9000014,FILE'=9000010.18
"RTN","BMXADOF1",43,0)
E I '$$NARR^BMXADOF2 Q ; GET IEN OF PROVIDER NARRATIVE AND SUBSTITUE THIS VALUE IN THE DATA STG
"RTN","BMXADOF1",44,0)
DSTG ; BUILD THE ADD/UPDATE STRING FOR THE EBCU FILER
"RTN","BMXADOF1",45,0)
S DA=+DATA,DAS=DAS_DA,DSTG=""
"RTN","BMXADOF1",46,0)
F PCE=2:1:MAX D
"RTN","BMXADOF1",47,0)
. S S=$P(SCHEMA,U,PCE),VAL=$P(DATA,U,PCE)
"RTN","BMXADOF1",48,0)
. I $P(S,B,6)="TRUE" Q ; READ ONLY
"RTN","BMXADOF1",49,0)
. S FLD=$P(S,B,2) I 'FLD Q ; INVALID SCHEMA PIECE
"RTN","BMXADOF1",50,0)
. I $E(FLD,1,3)=".00" Q ; IEN NOT DATA
"RTN","BMXADOF1",51,0)
. I FLD["ID" Q ; DON'T FILE THE IDENTIFIERS
"RTN","BMXADOF1",52,0)
. I SCHEMA[(B_FLD_"IEN"),FLD'["IEN",$L(VAL) Q ; WAIT FOR THE LOOKUP VALUE, BYPASS CURRENT FIELD
"RTN","BMXADOF1",53,0)
. S FLD=+FLD
"RTN","BMXADOF1",54,0)
. I $P(S,B,8)'="TRUE" S FLD="+"_FLD ; MANDATORY FIELD
"RTN","BMXADOF1",55,0)
. E I VAL="" S FLD="-"_FLD ; DELETE THE VALUE
"RTN","BMXADOF1",56,0)
. I FLD?.1E1".01" D Q ; MAKE SURE THAT THE .01 FIELD IS FIRST!
"RTN","BMXADOF1",57,0)
.. I $L(DSTG) S DSTG=FLD_B_VAL_$C(30)_DSTG Q ; APPEND .01 FIELD TO THE FRONT OF AN EXISTING UPDATE STRING
"RTN","BMXADOF1",58,0)
.. S DSTG=FLD_B_VAL ; START A NEW UPDATE STRING WITH THE .01 FIELD
"RTN","BMXADOF1",59,0)
.. Q
"RTN","BMXADOF1",60,0)
. I $L(DSTG) S DSTG=DSTG_$C(30) ; $C(30) IS THE "COLUMN" DELIMITER FOR DATA TO BE ENETERED IN THE TABLE
"RTN","BMXADOF1",61,0)
. S DSTG=DSTG_FLD_B_VAL ; "|" IS THE DATA ELEMENT DELIMITER, SEPARATING FIELD NAME AND FIELD VALUE
"RTN","BMXADOF1",62,0)
. Q
"RTN","BMXADOF1",63,0)
FILE D FILE^BMXADOF(.MSG,FILE,DAS,DSTG) ; THE DATA STRING IS PREPARED. NOW SEND IT TO THE EBCU FILER.
"RTN","BMXADOF1",64,0)
I $E(MSG,1,2)'="OK" S ECNT=ECNT+1
"RTN","BMXADOF1",65,0)
S CNT=CNT+1 S OUT(CNT)=MSG
"RTN","BMXADOF1",66,0)
; S DSTG=$TR(DSTG,$C(30),"}") W !,DSTG ; TEMP OUTPUT - REMOVE THIS LINE AFTER TESTING COMPLETED!
"RTN","BMXADOF1",67,0)
Q
"RTN","BMXADOF1",68,0)
;
"RTN","BMXADOF1",69,0)
ERR(ERR) ;
"RTN","BMXADOF1",70,0)
I '$L($G(ERR)) Q
"RTN","BMXADOF1",71,0)
S ECNT=$G(ECNT)+1
"RTN","BMXADOF1",72,0)
S CNT=CNT+1
"RTN","BMXADOF1",73,0)
S OUT(CNT)=ERR
"RTN","BMXADOF1",74,0)
Q
"RTN","BMXADOF1",75,0)
;
"RTN","BMXADOF2")
0^65^B7123769
"RTN","BMXADOF2",1,0)
BMXADOF2 ; IHS/CIHA/GIS - RPC CALL FOR EXTENDED FUNCTIONALITY OF BMXNet UTILITIES ;
"RTN","BMXADOF2",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXADOF2",3,0)
; THIS ROUTINE CONTAINS SPECIAL ENTRY POINTS FOR UPDATING RPMS
"RTN","BMXADOF2",4,0)
;
"RTN","BMXADOF2",5,0)
;
"RTN","BMXADOF2",6,0)
;
"RTN","BMXADOF2",7,0)
VVAR(DATA) ; EP-CHECK SPECIAL VARIABLES REQUIRED FOR UPDATING THE VISIT FILE
"RTN","BMXADOF2",8,0)
I '$L(DATA) S OUT="Update cancelled. Missing data string" Q 0
"RTN","BMXADOF2",9,0)
N X,I,Y,VDATE,%DT
"RTN","BMXADOF2",10,0)
K AUPNPAT,AUPNDOB,AUPNDOD,AUPNVSIT ; THE VARS ARE NOT NEW'D SINCE THEY WILL BE USED BY THE CALLING ROUTINE
"RTN","BMXADOF2",11,0)
S AUPNTALK=1,AUPNOVRR=1
"RTN","BMXADOF2",12,0)
S X=DATA S X=$TR(X,($C(30)_"+"),$C(30)) S X=$TR(X,($C(30)_"-"),$C(30)) S X=$TR(X,($C(30)_"`"),$C(30)) S DATA=X ; STRIP OFF TRANSACTION FLAGS FROM FIELD NUMBERS
"RTN","BMXADOF2",13,0)
S X=$P(DATA,"|",2),X=$P(X,$C(30)),VDATE=-1
"RTN","BMXADOF2",14,0)
I $E(X,1,7)?7N S VDATE=X
"RTN","BMXADOF2",15,0)
E S %DT="T" D ^%DT S VDATE=Y
"RTN","BMXADOF2",16,0)
I VDATE=-1 S OUT="Update cancelled. Visit timestamp misssing/invalid" Q 0
"RTN","BMXADOF2",17,0)
S Y=+$P(DATA,($C(30)_".05|"),2) I 'Y S OUT="Update cancelled. Patient data missing" Q 0 ; FAILED TO FIND THE PATIENT IEN
"RTN","BMXADOF2",18,0)
S AUPNPAT=Y
"RTN","BMXADOF2",19,0)
S AUPNDOB=$P($G(^DPT(AUPNPAT,0)),U,3) I 'AUPNDOB S OUT="Update cancelled. Missing DOB" Q 0
"RTN","BMXADOF2",20,0)
I AUPNDOB>VDATE S OUT="Update cancelled. Patient born afer visit date???" Q 0
"RTN","BMXADOF2",21,0)
S AUPNDOD=$P($G(^DPT(AUPNPAT,.35)),U)
"RTN","BMXADOF2",22,0)
I AUPNDOD,AUPNDOD<VDATE S OUT="Update cancelled. Patient died before this visit date" Q
"RTN","BMXADOF2",23,0)
Q 1
"RTN","BMXADOF2",24,0)
;
"RTN","BMXADOF2",25,0)
NARR() ;EP - GET IEN OF PROVIDER NARR & UPDATE DATA STG FOR PROBLEM FILE
"RTN","BMXADOF2",26,0)
N PCE,NARR,NIEN,IPCE,%,I,NN,DIC,X,Y,FLD,FIEN
"RTN","BMXADOF2",27,0)
S PCE=0,FIEN=+SCHEMA,NIEN=""
"RTN","BMXADOF2",28,0)
F I=3:1:$L(SCHEMA,U) D I PCE Q
"RTN","BMXADOF2",29,0)
. S %=$P(SCHEMA,U,I)
"RTN","BMXADOF2",30,0)
. S FLD=$P(%,"|",2)
"RTN","BMXADOF2",31,0)
. I 'FLD Q
"RTN","BMXADOF2",32,0)
. I $P($G(^DD(FIEN,FLD,0)),U,2)["P9999999.27" S PCE=I
"RTN","BMXADOF2",33,0)
. Q
"RTN","BMXADOF2",34,0)
I 'PCE Q ""
"RTN","BMXADOF2",35,0)
S NARR=$P(DATA,U,PCE) I NARR="" Q ""
"RTN","BMXADOF2",36,0)
S NIEN=$$XMATCH(NARR)
"RTN","BMXADOF2",37,0)
I 'NIEN D ; CREATE A NEW ENTRY IN THE PROVIDER NARRATIVE FILE
"RTN","BMXADOF2",38,0)
. S DIC=9999999.27
"RTN","BMXADOF2",39,0)
. S DIC(0)="L"
"RTN","BMXADOF2",40,0)
. S X=""""_NARR_""""
"RTN","BMXADOF2",41,0)
. D ^DIC I Y=-1 Q
"RTN","BMXADOF2",42,0)
. S NIEN=+Y
"RTN","BMXADOF2",43,0)
. Q
"RTN","BMXADOF2",44,0)
I 'NIEN Q ""
"RTN","BMXADOF2",45,0)
S $P(DATA,U,PCE)="`"_NIEN ; STUFF THE NARRATIVE LOOKUP VALUE INTO THE DATA STRING
"RTN","BMXADOF2",46,0)
Q NIEN
"RTN","BMXADOF2",47,0)
;
"RTN","BMXADOF2",48,0)
XMATCH(NARR) ; IF THERE IS AN EXACT MATCH IN THE PROVIDER NARRATIVE FILE, RETURN THE IEN
"RTN","BMXADOF2",49,0)
N IX,X,Y,%
"RTN","BMXADOF2",50,0)
S IX=$E(NARR,1,30)
"RTN","BMXADOF2",51,0)
S %=$O(^AUTNPOV("B",IX,0))
"RTN","BMXADOF2",52,0)
I '% Q ""
"RTN","BMXADOF2",53,0)
I %,'$O(^AUTNPOV("B",IX,%)) Q %
"RTN","BMXADOF2",54,0)
S Y=""
"RTN","BMXADOF2",55,0)
S %=0 F S %=$O(^AUTNPOV("B",IX,%)) Q:'% S X=$P($G(^AUTNPOV(%,0)),U) I X=NARR S Y=% Q
"RTN","BMXADOF2",56,0)
Q Y
"RTN","BMXADOF2",57,0)
;
"RTN","BMXADOFD")
0^66^B8876207
"RTN","BMXADOFD",1,0)
BMXADOFD ; IHS/CIHA/GIS - RPC CALL FOR EXTENDED FUNCTIONALITY OF BMXNet UTILITIES ;
"RTN","BMXADOFD",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXADOFD",3,0)
; THIS IS THE ADO RECORDSET FILER: ADO -> FILEMAN
"RTN","BMXADOFD",4,0)
; CONTAINS SPECIAL ENTRY POINT FOR RPMS DATA ENTRY
"RTN","BMXADOFD",5,0)
;
"RTN","BMXADOFD",6,0)
;
"RTN","BMXADOFD",7,0)
;
"RTN","BMXADOFD",8,0)
; D SS^BMXADO(.XXX,53,"","~~~~~VMEAS~BMXADOFD~1.244A||PU\60|WT\175|HT\70") Q
"RTN","BMXADOFD",9,0)
; D SS^BMXADO(.XXX,58,"X","AC~53~53~~~NOTES~BMXADOFD~53") Q
"RTN","BMXADOFD",10,0)
N FILE,DAS,DATA S FILE=9000010.07,DAS="+"
"RTN","BMXADOFD",11,0)
S DATA=".01|`8718"_$C(30)_".02|`1"_$C(30)_".03|`71168"_$C(30)_".04|DM--2"_$C(30,31)
"RTN","BMXADOFD",12,0)
D FILE^BMXADOF(.XXX,FILE,DAS,DATA) Q
"RTN","BMXADOFD",13,0)
;
"RTN","BMXADOFD",14,0)
VMEAS(DATA,IENS,MAX,OUT,TOT) ; VIEW MEASUREMENTS: CUSTOM ITERATOR
"RTN","BMXADOFD",15,0)
; DATA=VCN|ALL|MTYPE1\VAL1|MTYPE2\VAL2|...|MTYPEn\VALn
"RTN","BMXADOFD",16,0)
N VAL,CNT,P,S,PTIEN,VIEN,%,X,Y,TYPE,N,ALL,STG,MEAS,MIEN,IX
"RTN","BMXADOFD",17,0)
S P="|",S="\",N=0
"RTN","BMXADOFD",18,0)
I '$G(TOT) Q ""
"RTN","BMXADOFD",19,0)
I '$L(OUT) Q ""
"RTN","BMXADOFD",20,0)
S VIEN=$P(DATA,P) I '$L(VCN) Q ""
"RTN","BMXADOFD",21,0)
S PTIEN=$P($G(^AUPNVSIT(VIEN,0)),U,5) I 'PTIEN Q ""
"RTN","BMXADOFD",22,0)
F CNT=2:1 S X=$P(DATA,P,CNT) Q:'$L(X) D ; CREATE PRELIMINARY DATA ARRAYS
"RTN","BMXADOFD",23,0)
. S VAL=$P(X,S,2) ; VALUE MUST EXIST
"RTN","BMXADOFD",24,0)
. I '$L(VAL) Q
"RTN","BMXADOFD",25,0)
. S TYPE=$P(X,S) ; TYPE MUST EXIST
"RTN","BMXADOFD",26,0)
. I '$L(TYPE) Q
"RTN","BMXADOFD",27,0)
. S MIEN=$O(^AUTTMSR("B",TYPE,0)) I 'MIEN Q
"RTN","BMXADOFD",28,0)
. S MEAS=$P($G(^AUTTMSR(MIEN,0)),U,2) I '$L(MEAS) Q
"RTN","BMXADOFD",29,0)
. S N=N+1
"RTN","BMXADOFD",30,0)
. S VAL(N)=VAL
"RTN","BMXADOFD",31,0)
. S TYPE(N)=MIEN_U_TYPE_U_MEAS
"RTN","BMXADOFD",32,0)
. S IX(MIEN)=N
"RTN","BMXADOFD",33,0)
. Q
"RTN","BMXADOFD",34,0)
MG S N=0 F S N=$O(VAL(N)) Q:'N D
"RTN","BMXADOFD",35,0)
. S TOT=TOT+1
"RTN","BMXADOFD",36,0)
. S @OUT@(TOT)=+TYPE(N)_U_$P(TYPE(N),U,2)_U_"`"_PTIEN_U_"`"_VIEN_U_VAL(N)_U_$P(TYPE(N),U,3)_$C(30)
"RTN","BMXADOFD",37,0)
. Q
"RTN","BMXADOFD",38,0)
Q ""
"RTN","BMXADOFD",39,0)
;
"RTN","BMXADOFD",40,0)
ICDVAL(CODE) ; EP-RPC-VERIFY ICD CODE BY RETURNING ITS IEN
"RTN","BMXADOFD",41,0)
I '$L($G(CODE)) Q ""
"RTN","BMXADOFD",42,0)
N IEN
"RTN","BMXADOFD",43,0)
S IEN=$O(^ICD9("BA",CODE_" ",0))
"RTN","BMXADOFD",44,0)
I 'IEN Q ""
"RTN","BMXADOFD",45,0)
Q IEN
"RTN","BMXADOFD",46,0)
;
"RTN","BMXADOFD",47,0)
FACNIEN(PIEN,FIEN) ;EP - GIVEN A PROBLEM IEN AND FACILITY IEN, RETURN THE FACILITY-NOTE IEN
"RTN","BMXADOFD",48,0)
I '$D(^AUPNPROB(+$G(PIEN),0)) Q ""
"RTN","BMXADOFD",49,0)
I '$D(^DIC(4,+$G(FIEN),0)) Q ""
"RTN","BMXADOFD",50,0)
N NFIEN
"RTN","BMXADOFD",51,0)
S FNIEN=$O(^AUPNPROB(PIEN,11,"B",FIEN,0)) I FNIEN Q FNIEN ; IF AN FNIEN EXISTS RETURN IT
"RTN","BMXADOFD",52,0)
; OTHERWISE-CREATE THE FM STUB NODES FOR THE FACILITY SUBFILE
"RTN","BMXADOFD",53,0)
S FNIEN=$O(^AUPNPROB(PIEN,11,999999),-1)+1
"RTN","BMXADOFD",54,0)
S ^AUPNPROB(PIEN,11,FNIEN,0)=FIEN
"RTN","BMXADOFD",55,0)
S ^AUPNPROB(PIEN,11,FNIEN,11,0)="^9000011.1111IA^^"
"RTN","BMXADOFD",56,0)
S ^AUPNPROB(PIEN,11,"B",FIEN,FNIEN)=""
"RTN","BMXADOFD",57,0)
Q FNIEN
"RTN","BMXADOFD",58,0)
;
"RTN","BMXADOFD",59,0)
NEXTPBN(DFN,FIEN) ; RETURN THE NEXT AVAILABLE PROBLEM NUMBER FOR A PATIENT AT THE FACILITY
"RTN","BMXADOFD",60,0)
N MAX,PIEN,X,Y
"RTN","BMXADOFD",61,0)
S MAX=0,PIEN=0
"RTN","BMXADOFD",62,0)
F S PIEN=$O(^AUPNPROB("AC",DFN,PIEN)) Q:'PIEN D ; FIND ALL PROBLEMS FOR THIS PATIENT
"RTN","BMXADOFD",63,0)
. S X=$G(^AUPNPROB(PIEN,0)) I '$L(X) Q ""
"RTN","BMXADOFD",64,0)
. I $P(X,U,6)'=FIEN Q ; ONLY CHECK NUMBERS AT THIS FACILITY
"RTN","BMXADOFD",65,0)
. S Y=$P(X,U,7)
"RTN","BMXADOFD",66,0)
. I Y>MAX S MAX=Y ; GET THE HIGHEST NUMBER THUS FAR
"RTN","BMXADOFD",67,0)
. Q
"RTN","BMXADOFD",68,0)
S MAX=(MAX\1)+1 ; GET NEXT AVAILABLE INTEGER
"RTN","BMXADOFD",69,0)
Q MAX
"RTN","BMXADOFD",70,0)
;
"RTN","BMXADOFD",71,0)
NN W $$NEXTNOTE(221,4585) Q
"RTN","BMXADOFD",72,0)
NEXTNOTE(PIEN,FIEN) ; RETRUN THE NEXT NOTE NUMBER FOR A PROBLEM AND FACILITY
"RTN","BMXADOFD",73,0)
I '$D(^AUPNPROB(+$G(PIEN),0)) Q ""
"RTN","BMXADOFD",74,0)
I '$D(^DIC(4,+$G(FIEN),0)) Q ""
"RTN","BMXADOFD",75,0)
N MAX,NIEN,FNIEN,X,Y
"RTN","BMXADOFD",76,0)
S MAX=0,NIEN=0
"RTN","BMXADOFD",77,0)
S FNIEN=$$FACNIEN^BMXADOFD(PIEN,FIEN) I 'FNIEN Q ""
"RTN","BMXADOFD",78,0)
F S NIEN=$O(^AUPNPROB(PIEN,11,FNIEN,11,NIEN)) Q:'NIEN D
"RTN","BMXADOFD",79,0)
. S X=$G(^AUPNPROB(PIEN,11,FNIEN,11,NIEN,0)) I '$L(X) Q
"RTN","BMXADOFD",80,0)
. S Y=+X
"RTN","BMXADOFD",81,0)
. I Y>MAX S MAX=Y
"RTN","BMXADOFD",82,0)
. Q
"RTN","BMXADOFD",83,0)
S MAX=MAX+1
"RTN","BMXADOFD",84,0)
Q MAX
"RTN","BMXADOFS")
0^67^B38538227
"RTN","BMXADOFS",1,0)
BMXADOFS ; IHS/CIHA/GIS - RPC CALL FOR EXTENDED FUNCTIONALITY OF BMXNet UTILITIES ;
"RTN","BMXADOFS",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXADOFS",3,0)
; THIS IS THE ADO RECORDSET FILER: ADO -> FILEMAN
"RTN","BMXADOFS",4,0)
; CONTAINS SPECIAL CODE RELATED TO FILING PROPLEMS, POVS, FAMILY HX, PERSONAL HX AND NOTES.
"RTN","BMXADOFS",5,0)
;
"RTN","BMXADOFS",6,0)
;
"RTN","BMXADOFS",7,0)
;
"RTN","BMXADOFS",8,0)
PAT ; TEST PROBLEM ADD
"RTN","BMXADOFS",9,0)
S DATA=".01|`8257"_$C(30)_".02|`53"_$C(30)_".03|"_DT_$C(30)_".05|C-POX"_$C(30)_".06|`4585"_$C(30)_".12|I"_$C(30,31)
"RTN","BMXADOFS",10,0)
D FILE^BMXADOF(.XXX,9000011,"",DATA) W !,XXX K XXX,DATA Q
"RTN","BMXADOFS",11,0)
;
"RTN","BMXADOFS",12,0)
PET ; TEST PROB EDIT
"RTN","BMXADOFS",13,0)
S DATA=".01|250.00"_$C(30)_".03|"_DT_$C(30)_".05|HI MOM"_$C(30)_".12|I"_$C(30,31)
"RTN","BMXADOFS",14,0)
D FILE^BMXADOF(.XXX,9000011,"1757",DATA) W !,XXX K XXX,DATA Q
"RTN","BMXADOFS",15,0)
;
"RTN","BMXADOFS",16,0)
TDP ; TEST PROBLEM DELETE
"RTN","BMXADOFS",17,0)
S DATA=$C(31)
"RTN","BMXADOFS",18,0)
D FILE^BMXADOF(.XXX,9000011,"-1757",DATA) W !,XXX K XXX,DATA Q
"RTN","BMXADOFS",19,0)
;
"RTN","BMXADOFS",20,0)
TPOV ; ADD POV TEST
"RTN","BMXADOFS",21,0)
S DATA=".01|`8718"_$C(30)_".02|`53"_$C(30)_".03|`3909"_$C(30)_".04|DM---I"_$C(30)_".12|P"_$C(30,31)
"RTN","BMXADOFS",22,0)
D FILE^BMXADOF(.XXX,9000010.07,"",DATA) W !,XXX K XXX,DATA Q
"RTN","BMXADOFS",23,0)
;
"RTN","BMXADOFS",24,0)
TH ; HX TEST
"RTN","BMXADOFS",25,0)
S DATA=".01|250.00"_$C(30)_".02|`53"_$C(30)_".03|JUL 15,2004"_$C(30)_".04|FAMILY HX OF LUNG CA"_$C(30,31)
"RTN","BMXADOFS",26,0)
D FILE^BMXADOF(.XXX,9000014,"",DATA) W !,XXX K XXX,DATA Q
"RTN","BMXADOFS",27,0)
;
"RTN","BMXADOFS",28,0)
TNOTE ; TEST ADDING A NOTE TO A PROBLEM
"RTN","BMXADOFS",29,0)
N DATA,XXX,PROBIEN,FACNIEN,FACIEN,DAS
"RTN","BMXADOFS",30,0)
S PROBIEN=3,FACIEN=4587
"RTN","BMXADOFS",31,0)
S FACNIEN=$$FACNIEN(PROBIEN,FACIEN) ; YOU MUST SPECIFY THE PROBLEM IEN AND THE FACILITY IEN
"RTN","BMXADOFS",32,0)
S DAS=PROBIEN_","_FACNIEN_","
"RTN","BMXADOFS",33,0)
S DATA=".03|NEW NOTE #2"_$C(30,31) ; THE DATA STRING JUST CONTAINS THE NOTE FIELD.
"RTN","BMXADOFS",34,0)
; THE OTHER FIELDS (INCLUDING .01) ARE ADDED BY BMXADOF
"RTN","BMXADOFS",35,0)
D FILE^BMXADOF(.XXX,9000011.1111,DAS,DATA) W !,XXX
"RTN","BMXADOFS",36,0)
Q
"RTN","BMXADOFS",37,0)
;
"RTN","BMXADOFS",38,0)
; -----------------------------------------------------------------------------------------------------
"RTN","BMXADOFS",39,0)
;
"RTN","BMXADOFS",40,0)
SPEC(FILE,DATA,UFLG) ;EP - SPECIAL DATA MODS FOR SPECIFIC FILES
"RTN","BMXADOFS",41,0)
I FILE=9000010.07 S DATA=$$POV(DATA) Q DATA
"RTN","BMXADOFS",42,0)
I FILE=9000011 S DATA=$$PROB(DATA,$G(UFLG)) Q DATA
"RTN","BMXADOFS",43,0)
I FILE=9000013!(FILE=9000014) S DATA=$$HX(DATA) Q DATA
"RTN","BMXADOFS",44,0)
I FILE=9000011.1111 S DATA=$$NOTE(DATA,$G(DAS(2)),$G(DAS(1))) Q DATA
"RTN","BMXADOFS",45,0)
; I FILE=9000010.18,DATA'["|.04|" G DSTG
"RTN","BMXADOFS",46,0)
Q DATA
"RTN","BMXADOFS",47,0)
;
"RTN","BMXADOFS",48,0)
HX(DATA) ; INPUT STRING TRANSFORM FOR PHX AND FHX
"RTN","BMXADOFS",49,0)
N NARR,NIEN,%,A,B,X,Y,%DT
"RTN","BMXADOFS",50,0)
I DATA[".01|`" G HNARR
"RTN","BMXADOFS",51,0)
S DATA=$$ICD(DATA,.01) I DATA="" Q ""
"RTN","BMXADOFS",52,0)
HNARR I DATA'[".04|'" G HDT
"RTN","BMXADOFS",53,0)
S DATA=$$NARR(DATA,.04)
"RTN","BMXADOFS",54,0)
HDT I DATA'[".03|" Q DATA
"RTN","BMXADOFS",55,0)
S X=+$P(DATA,".03|",2) I X?7N Q DATA
"RTN","BMXADOFS",56,0)
S %DT="" D ^%DT
"RTN","BMXADOFS",57,0)
I Y'?7N Q DATA
"RTN","BMXADOFS",58,0)
S A=$P(DATA,".03|")
"RTN","BMXADOFS",59,0)
S B=$P(DATA,".03|",2) S B=$P(B,$C(30),2)
"RTN","BMXADOFS",60,0)
S DATA=A_".03|"_Y
"RTN","BMXADOFS",61,0)
I $L(B) S DATA=DATA_$C(30)_B
"RTN","BMXADOFS",62,0)
Q DATA
"RTN","BMXADOFS",63,0)
;
"RTN","BMXADOFS",64,0)
POV(DATA) ; POV INPUT STRING TRANSFORM
"RTN","BMXADOFS",65,0)
N NARR,NIEN,%
"RTN","BMXADOFS",66,0)
I DATA[".01|`" G PVNARR
"RTN","BMXADOFS",67,0)
S DATA=$$ICD(DATA,.01) I DATA="" Q ""
"RTN","BMXADOFS",68,0)
PVNARR I DATA'[".04|'" Q DATA
"RTN","BMXADOFS",69,0)
S DATA=$$NARR(DATA,.04)
"RTN","BMXADOFS",70,0)
Q DATA
"RTN","BMXADOFS",71,0)
;
"RTN","BMXADOFS",72,0)
PROB(DATA,UFLG) ; PROBLEM LIST INPUT STRING TRANSFORM
"RTN","BMXADOFS",73,0)
N NARR,NIEN,%,PNUM,FACIEN,DFN,X,A,B
"RTN","BMXADOFS",74,0)
PNARR I DATA'[".05|" G PICD
"RTN","BMXADOFS",75,0)
S %=$P(DATA,".05|",2)
"RTN","BMXADOFS",76,0)
S NARR=$P(%,$C(30))
"RTN","BMXADOFS",77,0)
I NARR'?1"`"1.N S DATA=$$NARR(DATA,.05) ; STUFF THE NARR LOOKUP VALUE IN THE DATA STRING
"RTN","BMXADOFS",78,0)
I '$L(DATA) Q ""
"RTN","BMXADOFS",79,0)
PICD S %=$P(DATA,"|") I %'=.01,DATA'[($C(30)_".01|") G PNUM
"RTN","BMXADOFS",80,0)
S DATA=$$ICD(DATA,.01) I DATA="" Q ""
"RTN","BMXADOFS",81,0)
PNUM I $G(UFLG)="E" Q DATA ; STOP HERE IF IN EDIT MODE
"RTN","BMXADOFS",82,0)
I $P(DATA,($C(30)_".07|"),2) G TODAY ; GET NEXT PROB NUM
"RTN","BMXADOFS",83,0)
S DFN=+$P(DATA,".02|`",2)
"RTN","BMXADOFS",84,0)
I 'DFN S DATA="" Q ""
"RTN","BMXADOFS",85,0)
S FACIEN=+$P(DATA,".06|`",2)
"RTN","BMXADOFS",86,0)
I 'FACIEN Q ""
"RTN","BMXADOFS",87,0)
S PNUM=$$NEXTPBN(DFN,FACIEN)
"RTN","BMXADOFS",88,0)
I 'PNUM Q ""
"RTN","BMXADOFS",89,0)
S X=$L(DATA,$C(30))
"RTN","BMXADOFS",90,0)
S A=$P(DATA,$C(30),1,X-1),B=$P(DATA,$C(30),X)
"RTN","BMXADOFS",91,0)
S DATA=A_$C(30)_".07|"_PNUM_$C(30)_B
"RTN","BMXADOFS",92,0)
TODAY I $P(DATA,($C(30)_".08|"),2) Q DATA ; GET TODAY'S DATE
"RTN","BMXADOFS",93,0)
S X=$L(DATA,$C(30))
"RTN","BMXADOFS",94,0)
S A=$P(DATA,$C(30),1,X-1),B=$P(DATA,$C(30),X)
"RTN","BMXADOFS",95,0)
S DATA=A_$C(30)_".08|"_$G(DT)_$C(30)_B
"RTN","BMXADOFS",96,0)
Q DATA
"RTN","BMXADOFS",97,0)
;
"RTN","BMXADOFS",98,0)
NOTE(DATA,PIEN,FNIEN) ; GIVEN A DATA STRING CONTAINING THE NOTE, THE PROBLEM IEN, AND THE FAC-NOTE IEN:
"RTN","BMXADOFS",99,0)
; ADD NOTE # AND STATUS TO THE DATA STRING
"RTN","BMXADOFS",100,0)
I $G(DATA)'[".03|" Q ""
"RTN","BMXADOFS",101,0)
I '$D(^AUPNPROB(+$G(PIEN),11,+$G(FNIEN),0)) Q ""
"RTN","BMXADOFS",102,0)
N NUM
"RTN","BMXADOFS",103,0)
I DATA'[".04|" S DATA=".04|A"_$C(30)_DATA
"RTN","BMXADOFS",104,0)
I DATA'[".01|" D
"RTN","BMXADOFS",105,0)
. S NUM=$$NEXTNOTE(PIEN,FNIEN)
"RTN","BMXADOFS",106,0)
. I 'NUM Q
"RTN","BMXADOFS",107,0)
. S DATA=".01|"_NUM_$C(30)_DATA
"RTN","BMXADOFS",108,0)
Q DATA
"RTN","BMXADOFS",109,0)
;
"RTN","BMXADOFS",110,0)
TI N XXX S XXX=$$ICD(".01|250.00"_$C(30)_".02|123"_$C(30)_".03|ABC",.01) W !,$TR(XXX,$C(30),"{") Q
"RTN","BMXADOFS",111,0)
ICD(DATA,FLD) ; VERIFY ICD CODE AND GET LOOKUP VALUE
"RTN","BMXADOFS",112,0)
I '$G(FLD) Q ""
"RTN","BMXADOFS",113,0)
I '$L($G(DATA)) Q ""
"RTN","BMXADOFS",114,0)
N %,A,B
"RTN","BMXADOFS",115,0)
S %=$P(DATA,"|")
"RTN","BMXADOFS",116,0)
I %=FLD D Q DATA
"RTN","BMXADOFS",117,0)
. S %=$P(DATA,"|",2)
"RTN","BMXADOFS",118,0)
. S %=$P(%,$C(30))
"RTN","BMXADOFS",119,0)
. I %?1"`"1.N Q
"RTN","BMXADOFS",120,0)
. S %=$O(^ICD9("BA",%_" ",0))
"RTN","BMXADOFS",121,0)
. I '% S DATA="" Q
"RTN","BMXADOFS",122,0)
. S A=$P(DATA,"|")
"RTN","BMXADOFS",123,0)
. S B=$P(DATA,"|",2,999)
"RTN","BMXADOFS",124,0)
. S B=$P(B,$C(30),2,999)
"RTN","BMXADOFS",125,0)
. S DATA=A_"|`"_%
"RTN","BMXADOFS",126,0)
. I $L(B) S DATA=DATA_$C(30)_B
"RTN","BMXADOFS",127,0)
. Q
"RTN","BMXADOFS",128,0)
S %=$P(DATA,($C(30)_FLD_"|"),2) D
"RTN","BMXADOFS",129,0)
. S %=$P(%,$C(30))
"RTN","BMXADOFS",130,0)
. I %?1"`"1.N Q DATA
"RTN","BMXADOFS",131,0)
. S %=$O(^ICD9("BA",%_" ",0))
"RTN","BMXADOFS",132,0)
. I '% S DATA="" Q
"RTN","BMXADOFS",133,0)
. S A=$P(DATA,($C(30)_FLD_"|"))
"RTN","BMXADOFS",134,0)
. S B=$P(DATA,($C(30)_FLD_"|"),2,999)
"RTN","BMXADOFS",135,0)
. S B=$P(B,$C(30),2,999)
"RTN","BMXADOFS",136,0)
. S DATA=A_$C(30)_FLD_"|`"_%
"RTN","BMXADOFS",137,0)
. I $L(B) S DATA=DATA_$C(30)_B
"RTN","BMXADOFS",138,0)
. Q
"RTN","BMXADOFS",139,0)
Q DATA
"RTN","BMXADOFS",140,0)
;
"RTN","BMXADOFS",141,0)
NARR(DATA,FLD) ; SUBSTITUTE A LOOKUP VALUE FOR NARRATIVE DATA IN THE DATA STRING
"RTN","BMXADOFS",142,0)
N A,B,C,X,Y,DIC,Z
"RTN","BMXADOFS",143,0)
I '$G(FLD) Q ""
"RTN","BMXADOFS",144,0)
I '$L($G(DATA)) Q ""
"RTN","BMXADOFS",145,0)
S Z=FLD_"|"
"RTN","BMXADOFS",146,0)
S A=$P(DATA,Z)
"RTN","BMXADOFS",147,0)
S B=$P(DATA,Z,2)
"RTN","BMXADOFS",148,0)
S NARR=$P(B,$C(30))
"RTN","BMXADOFS",149,0)
S NARR=$$UP^XLFSTR(NARR) ; CONVERT ALL NARRATIVE TO UPPERCASE
"RTN","BMXADOFS",150,0)
S C=$P(B,$C(30),2,999)
"RTN","BMXADOFS",151,0)
S DIC="^AUTNPOV(",DIC(0)="L",X=NARR
"RTN","BMXADOFS",152,0)
D ^DIC I Y=-1 Q ""
"RTN","BMXADOFS",153,0)
S DATA=A_FLD_"|`"_+Y
"RTN","BMXADOFS",154,0)
I $L(C) S DATA=DATA_$C(30)_C
"RTN","BMXADOFS",155,0)
D ^XBFMK
"RTN","BMXADOFS",156,0)
Q DATA
"RTN","BMXADOFS",157,0)
;
"RTN","BMXADOFS",158,0)
FACNIEN(PIEN,FIEN) ; GIVEN A PROBLEM IEN AND FACILITY IEN, RETURN THE FACILITY-NOTE IEN
"RTN","BMXADOFS",159,0)
I '$D(^AUPNPROB(+$G(PIEN),0)) Q ""
"RTN","BMXADOFS",160,0)
I '$D(^DIC(4,+$G(FIEN),0)) Q ""
"RTN","BMXADOFS",161,0)
N FNIEN
"RTN","BMXADOFS",162,0)
S FNIEN=$O(^AUPNPROB(PIEN,11,"B",FIEN,0)) I FNIEN Q FNIEN ; IF AN FNIEN EXISTS RETURN IT
"RTN","BMXADOFS",163,0)
; OTHERWISE-CREATE THE FM STUB NODES FOR THE FACILITY SUBFILE
"RTN","BMXADOFS",164,0)
S FNIEN=$O(^AUPNPROB(PIEN,11,999999),-1)+1
"RTN","BMXADOFS",165,0)
S ^AUPNPROB(PIEN,11,FNIEN,0)=FIEN
"RTN","BMXADOFS",166,0)
S ^AUPNPROB(PIEN,11,FNIEN,11,0)="^9000011.1111IA^^"
"RTN","BMXADOFS",167,0)
S ^AUPNPROB(PIEN,11,"B",FIEN,FNIEN)=""
"RTN","BMXADOFS",168,0)
Q FNIEN
"RTN","BMXADOFS",169,0)
;
"RTN","BMXADOFS",170,0)
NEXTPBN(DFN,FIEN) ; RETURN THE NEXT AVAILABLE PROBLEM NUMBER FOR A PATIENT AT THE FACILITY
"RTN","BMXADOFS",171,0)
N MAX,PIEN,X,Y
"RTN","BMXADOFS",172,0)
S MAX=0,PIEN=0
"RTN","BMXADOFS",173,0)
F S PIEN=$O(^AUPNPROB("AC",DFN,PIEN)) Q:'PIEN D ; FIND ALL PROBLEMS FOR THIS PATIENT
"RTN","BMXADOFS",174,0)
. S X=$G(^AUPNPROB(PIEN,0)) I '$L(X) Q ""
"RTN","BMXADOFS",175,0)
. I $P(X,U,6)'=FIEN Q ; ONLY CHECK NUMBERS AT THIS FACILITY
"RTN","BMXADOFS",176,0)
. S Y=$P(X,U,7)
"RTN","BMXADOFS",177,0)
. I Y>MAX S MAX=Y ; GET THE HIGHEST NUMBER THUS FAR
"RTN","BMXADOFS",178,0)
. Q
"RTN","BMXADOFS",179,0)
S MAX=(MAX\1)+1 ; GET NEXT AVAILABLE INTEGER
"RTN","BMXADOFS",180,0)
Q MAX
"RTN","BMXADOFS",181,0)
;
"RTN","BMXADOFS",182,0)
NN W $$NEXTNOTE(3,1) Q
"RTN","BMXADOFS",183,0)
NEXTNOTE(PIEN,FNIEN) ; RETRUN THE NEXT NOTE NUMBER FOR A PROBLEM AND FACILITY-NOTE IEN
"RTN","BMXADOFS",184,0)
I '$D(^AUPNPROB(+$G(PIEN),11,+$G(FNIEN),0)) Q ""
"RTN","BMXADOFS",185,0)
N MAX,NIEN,X,Y
"RTN","BMXADOFS",186,0)
S MAX=0,NIEN=0
"RTN","BMXADOFS",187,0)
F S NIEN=$O(^AUPNPROB(PIEN,11,FNIEN,11,NIEN)) Q:'NIEN D
"RTN","BMXADOFS",188,0)
. S X=$G(^AUPNPROB(PIEN,11,FNIEN,11,NIEN,0)) I '$L(X) Q
"RTN","BMXADOFS",189,0)
. S Y=+X
"RTN","BMXADOFS",190,0)
. I Y>MAX S MAX=Y
"RTN","BMXADOFS",191,0)
. Q
"RTN","BMXADOFS",192,0)
S MAX=MAX+1
"RTN","BMXADOFS",193,0)
Q MAX
"RTN","BMXADOFS",194,0)
;
"RTN","BMXADOFS",195,0)
PIENN(PIEN) ; GIVEN A PROBLEM IEN, RETURN PROBLEM NARRATIVE (ICD)
"RTN","BMXADOFS",196,0)
N X,IIEN,NIEN,NARR,ICD
"RTN","BMXADOFS",197,0)
S X=$G(^AUPNPROB(PIEN,0)) I '$L(X) Q ""
"RTN","BMXADOFS",198,0)
S IIEN=$P(X,U) I 'IIEN Q ""
"RTN","BMXADOFS",199,0)
S NIEN=$P(X,U,5) I 'NIEN Q ""
"RTN","BMXADOFS",200,0)
S ICD=$P($G(^ICD9(IIEN,0)),U) I '$L(ICD) Q ""
"RTN","BMXADOFS",201,0)
S NARR=$P($G(^AUTNPOV(NIEN,0)),U) I '$L(NARR) Q ""
"RTN","BMXADOFS",202,0)
S X=NARR_" ("_ICD_")"
"RTN","BMXADOFS",203,0)
Q X
"RTN","BMXADOFS",204,0)
;
"RTN","BMXADOI")
0^68^B6267463
"RTN","BMXADOI",1,0)
BMXADOI ; IHS/CIHA/GIS - RPC CALL: GENERATE DATA FOR AN ADO DATASET ;
"RTN","BMXADOI",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXADOI",3,0)
; CUSTOM IDENTIFIERS
"RTN","BMXADOI",4,0)
;
"RTN","BMXADOI",5,0)
;
"RTN","BMXADOI",6,0)
;
"RTN","BMXADOI",7,0)
DEMOID(DA) ; EP-RETURN RPMS DEMOGRAPHIC INFO FOR IDENTIFIER FIELD
"RTN","BMXADOI",8,0)
N SEX,DOB,CHART,AGE,TRIBE,CC,X,Y,%,STG,FMDOB,NAME,S,SSN,CSTG,LOC,ABB
"RTN","BMXADOI",9,0)
I '$D(^DPT(+$G(DA),0)) Q ""
"RTN","BMXADOI",10,0)
S S=" "
"RTN","BMXADOI",11,0)
S X=$G(^DPT(DA,0)),SEX=$P(X,U,2),Y=$P(X,U,3),NAME=$P(X,U),SSN=$P(X,U,9)
"RTN","BMXADOI",12,0)
I '$L(NAME) Q ""
"RTN","BMXADOI",13,0)
I Y,$G(DT) S AGE=(DT-Y)\10000
"RTN","BMXADOI",14,0)
I Y X ^DD("DD") S DOB=Y
"RTN","BMXADOI",15,0)
S LOC=0,CSTG=""
"RTN","BMXADOI",16,0)
F S LOC=$O(^AUPNPAT(DA,41,"B",LOC)) Q:'LOC D ; GET ALL THE CHART NUMBERS
"RTN","BMXADOI",17,0)
. S CHART=$O(^AUPNPAT(DA,41,"B",LOC,0)) I '$L(CHART) Q
"RTN","BMXADOI",18,0)
. S ABB=$P($G(^AUTTLOC(LOC,0)),U,7) I '$L(ABB) Q
"RTN","BMXADOI",19,0)
. I $L(CSTG) S CSTG=CSTG_", "
"RTN","BMXADOI",20,0)
. S CSTG=CSTG_ABB_" #"_CHART
"RTN","BMXADOI",21,0)
. Q
"RTN","BMXADOI",22,0)
I $G(DUZ(2)) S CHART=$P($G(^AUPNPAT(DA,41,DUZ(2),0)),U,2)
"RTN","BMXADOI",23,0)
S %=$P($G(^AUPNPAT(DA,11)),U,8) I % S TRIBE=$P($G(^AUTTTRI(%,0)),U)
"RTN","BMXADOI",24,0)
S CC=$P($G(^AUPNPAT(DA,11)),U,18)
"RTN","BMXADOI",25,0)
S STG=NAME
"RTN","BMXADOI",26,0)
I $L(CSTG) S STG=STG_CSTG_" --"
"RTN","BMXADOI",27,0)
I $G(AGE),$L(SEX) S STG=STG_S_AGE_" y/o "_SEX
"RTN","BMXADOI",28,0)
I '$G(AGE),$L(SEX) S STG=STG_S_SEX
"RTN","BMXADOI",29,0)
I $L($G(DOB)) S STG=STG_S_DOB
"RTN","BMXADOI",30,0)
I $L($G(SSN)) S STG=STG_S_$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)
"RTN","BMXADOI",31,0)
I $L($G(TRIBE)) S STG=STG_S_TRIBE
"RTN","BMXADOI",32,0)
I $L($G(CC)) S STG=STG_S_CC
"RTN","BMXADOI",33,0)
Q STG
"RTN","BMXADOI",34,0)
;
"RTN","BMXADOI",35,0)
DATE(DATE) ; TEST TRIGGER
"RTN","BMXADOI",36,0)
Q DATE
"RTN","BMXADOI",37,0)
;
"RTN","BMXADOI",38,0)
NAME(VIEN) ; RETURN THE PATIENT'S NAME
"RTN","BMXADOI",39,0)
I '$G(VIEN) Q ""
"RTN","BMXADOI",40,0)
N DFN
"RTN","BMXADOI",41,0)
S DFN=$P($G(^AUPNVSIT(VIEN,0)),U,5) I 'DFN Q ""
"RTN","BMXADOI",42,0)
Q $$GET1^DIQ(2,DFN_",",.01)
"RTN","BMXADOI",43,0)
;
"RTN","BMXADOI",44,0)
SEX(VIEN) ; RETURN THE PATIENT'S SEX
"RTN","BMXADOI",45,0)
I '$G(VIEN) Q ""
"RTN","BMXADOI",46,0)
N DFN
"RTN","BMXADOI",47,0)
S DFN=$P($G(^AUPNVSIT(VIEN,0)),U,5) I 'DFN Q ""
"RTN","BMXADOI",48,0)
Q $$GET1^DIQ(2,DFN_",",.02)
"RTN","BMXADOI",49,0)
;
"RTN","BMXADOI",50,0)
HRN(VIEN) ; RETURN THE CHART NUMBER FOR VISIT TRIGGER
"RTN","BMXADOI",51,0)
I '$G(VIEN) Q ""
"RTN","BMXADOI",52,0)
N DFN,LOC
"RTN","BMXADOI",53,0)
S DFN=$P($G(^AUPNVSIT(VIEN,0)),U,5) I 'DFN Q ""
"RTN","BMXADOI",54,0)
S LOC=$P($G(^AUPNVSIT(VIEN,0)),U,6) I 'LOC Q ""
"RTN","BMXADOI",55,0)
Q $$HRN^AUPNPAT(DFN,LOC,2)
"RTN","BMXADOI",56,0)
;
"RTN","BMXADOI",57,0)
DOB(VIEN) ; RETURN THE PATIENT'S DOB
"RTN","BMXADOI",58,0)
I '$G(VIEN) Q ""
"RTN","BMXADOI",59,0)
N DFN,LOC
"RTN","BMXADOI",60,0)
S DFN=$P($G(^AUPNVSIT(VIEN,0)),U,5) I 'DFN Q ""
"RTN","BMXADOI",61,0)
Q $$DOB^AUPNPAT(DFN,"E")
"RTN","BMXADOI",62,0)
;
"RTN","BMXADOI",63,0)
SSN(VIEN) ; RETURN THE PATIENTS DOB
"RTN","BMXADOI",64,0)
I '$G(VIEN) Q ""
"RTN","BMXADOI",65,0)
N DFN,LOC
"RTN","BMXADOI",66,0)
S DFN=$P($G(^AUPNVSIT(VIEN,0)),U,5) I 'DFN Q ""
"RTN","BMXADOI",67,0)
Q $$SSN^AUPNPAT(DFN)
"RTN","BMXADOI",68,0)
;
"RTN","BMXADOI",69,0)
VISDATE(VIEN) ; RETURN THE DATE OF THE VISIT
"RTN","BMXADOI",70,0)
I '$G(VIEN) Q ""
"RTN","BMXADOI",71,0)
N FMDT
"RTN","BMXADOI",72,0)
S FMDT=+$G(^AUPNVSIT(VIEN,0))\1 I 'FMDT Q ""
"RTN","BMXADOI",73,0)
S %=$$FMTE^XLFDT(FMDT,1)
"RTN","BMXADOI",74,0)
G TD1
"RTN","BMXADOI",75,0)
;
"RTN","BMXADOI",76,0)
TODAY(VIEN) ; RETURN TODAY'S DATE
"RTN","BMXADOI",77,0)
I '$G(DT) Q ""
"RTN","BMXADOI",78,0)
S %=$$FMTE^XLFDT(DT,1)
"RTN","BMXADOI",79,0)
TD1 S %=$$UP^XLFSTR(%)
"RTN","BMXADOI",80,0)
S %=$P(%," ",1,2)_$P(%," ",3)
"RTN","BMXADOI",81,0)
Q %
"RTN","BMXADOI",82,0)
;
"RTN","BMXADOS")
0^69^B78902997
"RTN","BMXADOS",1,0)
BMXADOS ; IHS/CIHA/GIS - UPDATE THE BMX ADO SCHEMA FILE ; 12/7/10 4:07pm
"RTN","BMXADOS",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXADOS",3,0)
; ENABLES NAVIGATION TO SUBFILES PRIOR TO UPDATING THE SCHEMA FILE ENTRY
"RTN","BMXADOS",4,0)
;
"RTN","BMXADOS",5,0)
; Change log:
"RTN","BMXADOS",6,0)
; Sam Habiel - 3101212 v2.21
"RTN","BMXADOS",7,0)
; - Changed the quit from the line in ASTG b/c it couldn't compile in GT.M
"RTN","BMXADOS",8,0)
; F PCE=1:1:LEV S FNO=+$P(STG,",",PCE) D I '$L(STG) Q "" **OLD**
"RTN","BMXADOS",9,0)
; F PCE=1:1:LEV S FNO=+$P(STG,",",PCE) D Q:'$L(STG) ; v 2.21 SMH
"RTN","BMXADOS",10,0)
;
"RTN","BMXADOS",11,0)
;
"RTN","BMXADOS",12,0)
;
"RTN","BMXADOS",13,0)
UPDATE ; UPDATE THE SCHEMA FILE
"RTN","BMXADOS",14,0)
N DIC,X,Y,%,STOP,FIEN,FNAME,SNAME,SIEN
"RTN","BMXADOS",15,0)
UDIC S DIC("A")="Enter schema name: " ; EP FROM VENPCCTU
"RTN","BMXADOS",16,0)
S DIC(0)="AEQLM",DIC="^BMXADO("
"RTN","BMXADOS",17,0)
D ^DIC I Y=-1 G FIN
"RTN","BMXADOS",18,0)
SCHEMA S SNAME=$P(Y,U,2),SIEN=+Y
"RTN","BMXADOS",19,0)
S FIEN=$$FILE(SIEN) I 'FIEN G FIN
"RTN","BMXADOS",20,0)
I FIEN'=$P($G(^BMXADO(SIEN,0)),U,2) S DIE=DIC,DA=SIEN,DR=".02////^S X=FIEN" D ^DIE
"RTN","BMXADOS",21,0)
F D FLD(FIEN,SIEN) I $G(STOP) Q ; GET FIELD INFO
"RTN","BMXADOS",22,0)
FIN D ^XBFMK
"RTN","BMXADOS",23,0)
Q
"RTN","BMXADOS",24,0)
;
"RTN","BMXADOS",25,0)
FLD(FIEN,SIEN) ; GET THE FIELD
"RTN","BMXADOS",26,0)
N DIC,X,Y,DIE,DA,DR,FLDIEN,FLDNAME,FLDTYPE,FDEF,TRANS
"RTN","BMXADOS",27,0)
N %,%Y,HDR,DTYPE,LEN,FARR,I,TOT,PAUSE,PFLAG,IFLAG,IMSG,STG,READ
"RTN","BMXADOS",28,0)
D FLIST(.FARR,FIEN,0)
"RTN","BMXADOS",29,0)
S TOT=$O(FARR(9999),-1) I 'TOT S STOP=1 Q
"RTN","BMXADOS",30,0)
W !,"Select a field from this "_$S($D(^DD(FIEN,0,"UP")):"sub-",1:"")_"file: "
"RTN","BMXADOS",31,0)
S I=0 F S I=$O(FARR(I)) Q:'I S PAUSE=$$PAUSE(I) Q:PAUSE'="" W I,?3,FARR(I)
"RTN","BMXADOS",32,0)
I $G(PAUSE)=U S STOP=1 Q
"RTN","BMXADOS",33,0)
I $G(PAUSE) S Y=PAUSE G FLD1
"RTN","BMXADOS",34,0)
S DIR(0)="NO^1:"_TOT_":",DIR("A")="Select a field from the list" K DA D ^DIR K DIR
"RTN","BMXADOS",35,0)
I 'Y S STOP=1 Q
"RTN","BMXADOS",36,0)
FLD1 S %=FARR(+Y)
"RTN","BMXADOS",37,0)
S FLDIEN=+$P(%," [",2),FLDNAME=$P(%," [")
"RTN","BMXADOS",38,0)
I $$FDEL(SIEN,FLDIEN) Q ; FIELD DELETED
"RTN","BMXADOS",39,0)
S X=$$FDEF(FIEN,FLDIEN) I '$L(X) W " ??" Q
"RTN","BMXADOS",40,0)
S DTYPE=$E(X),LEN=+$E(X,2,6)
"RTN","BMXADOS",41,0)
S DIR(0)="F^1:30",DIR("A")="Column header",DIR("B")=FLDNAME D ^DIR K DIR
"RTN","BMXADOS",42,0)
S HDR=Y,TRANS=0
"RTN","BMXADOS",43,0)
S %=$P($G(^DD(FIEN,FLDIEN,0)),U,2) ; CHECK FM DD TO SEE IF FIELD IS REQUIRED
"RTN","BMXADOS",44,0)
I %["R" W !,"FileMan requires a non-null value for this field" S %=2
"RTN","BMXADOS",45,0)
E W !,"Is null allowed" S %=$S(FLDIEN=.01:2,1:1) D YN^DICN I %Y?1."^" Q
"RTN","BMXADOS",46,0)
I %=2 S TRANS=1 ; NON NULL VALUE REQUIRED TO COMPLETE THE TRANSACTION OR THERE WILL BE ROLLBACK
"RTN","BMXADOS",47,0)
I $G(PFLAG) D ; IF POINTER, ASK IF USER WANTS TO AUTOMATICALLY INSERT THE LOOKUP VALUE FIELD IN THE SCHEMA
"RTN","BMXADOS",48,0)
. W !,"This field is a pointer value (IEN)."
"RTN","BMXADOS",49,0)
. W !,"Want to automatically insert the lookup value in the schema"
"RTN","BMXADOS",50,0)
. S %=2 D YN^DICN W ! I %=1 S PFLAG=2
"RTN","BMXADOS",51,0)
. Q
"RTN","BMXADOS",52,0)
IFLG I $G(IFLAG) D ; NON-POINTER .01 FIELD. ASK IF USER WANTS TO REFERENCE IDENTIFIER EP
"RTN","BMXADOS",53,0)
. W !,"Want to display identifiers with this field"
"RTN","BMXADOS",54,0)
. S %=2 D YN^DICN W ! I %'=1 Q
"RTN","BMXADOS",55,0)
. S IMSG="Respond with a valid entry point in the format 'TAG^ROUTINE'."
"RTN","BMXADOS",56,0)
. W !,"Entry Point to generate Identifiers: " R Y:$G(DTIME,60) E Q
"RTN","BMXADOS",57,0)
. I Y?1."^" Q
"RTN","BMXADOS",58,0)
. I Y?1."?" W !,IMSG S IFLAG(0)="!" Q
"RTN","BMXADOS",59,0)
. I Y'?1U.7UN1"^"1U.7UN S IFLAG(0)="!" W " ??"
"RTN","BMXADOS",60,0)
. I $L(Y)>2 S IFLAG(0)=Y,IFLAG=2
"RTN","BMXADOS",61,0)
. Q
"RTN","BMXADOS",62,0)
I $G(IFLAG(0))="!" W !,IMSG K IPFLAG(0),IMSG W !!! G IFLG
"RTN","BMXADOS",63,0)
S DA(1)=SIEN,DIC="^BMXADO("_DA(1)_",1,"
"RTN","BMXADOS",64,0)
S DIC("P")=90093.991,DIC(0)="L",X=FLDIEN
"RTN","BMXADOS",65,0)
I '$D(^BMXADO(SIEN,1,0)) S ^BMXADO(SIEN,1,0)="^90093.991^^"
"RTN","BMXADOS",66,0)
D ^DIC I Y=-1 Q
"RTN","BMXADOS",67,0)
S READ=($P($G(^DD(FIEN,FLDIEN,0)),U,2)["C") ; COMPUTED FIELDS ARE READ ONLY!
"RTN","BMXADOS",68,0)
S DIE=DIC,DA=+Y
"RTN","BMXADOS",69,0)
S DR=".02///^S X=DTYPE;.03///^S X=LEN;.04///^S X=HDR;.05///^S X=READ;.06///0;.07///^S X=('TRANS)"
"RTN","BMXADOS",70,0)
D ^DIE
"RTN","BMXADOS",71,0)
I $G(IFLAG)=2 D ID
"RTN","BMXADOS",72,0)
I $G(PFLAG)'=2 Q
"RTN","BMXADOS",73,0)
LKUP ; AUTOMATICALLY ADD A LOOKUP FIELD TO THE SCHEMA
"RTN","BMXADOS",74,0)
S X=FLDIEN_"IEN"
"RTN","BMXADOS",75,0)
D ^DIC I Y=-1 Q
"RTN","BMXADOS",76,0)
W !,"The LOOKUP field '"_X_"' has been added to the schema",!
"RTN","BMXADOS",77,0)
S HDR=HDR_"_IEN",DTYPE="I",LEN="00009"
"RTN","BMXADOS",78,0)
S DIE=DIC,DA=+Y
"RTN","BMXADOS",79,0)
S DR=".02///^S X=DTYPE;.03///^S X=LEN;.04///^S X=HDR;.05///^S X=READ;.06///0;.07///^S X=('TRANS)"
"RTN","BMXADOS",80,0)
D ^DIE
"RTN","BMXADOS",81,0)
Q
"RTN","BMXADOS",82,0)
;
"RTN","BMXADOS",83,0)
ID ; AUTOMATICALLY ADD AN IDENTIFIER REFERENCE
"RTN","BMXADOS",84,0)
N X,Y,DIE,DR,DA,REF
"RTN","BMXADOS",85,0)
S X=".01ID",DA(1)=SIEN
"RTN","BMXADOS",86,0)
S REF=IFLAG(0) I '$L(REF) Q
"RTN","BMXADOS",87,0)
D ^DIC I Y=-1 Q
"RTN","BMXADOS",88,0)
W !,"The identifier field '"_X_"' has been added to the schema",!
"RTN","BMXADOS",89,0)
S HDR=HDR_"_ID",DTYPE="T",LEN="00017"
"RTN","BMXADOS",90,0)
S DIE=DIC,DA=+Y
"RTN","BMXADOS",91,0)
S DR=".02///^S X=DTYPE;.03///^S X=LEN;.04///^S X=HDR;.05///^S X=READ;.06///0;.07///^S X=('TRANS);1///^S X=REF"
"RTN","BMXADOS",92,0)
D ^DIE
"RTN","BMXADOS",93,0)
Q
"RTN","BMXADOS",94,0)
;
"RTN","BMXADOS",95,0)
FDEL(SIEN,FIELD) ; DELETE AN EXISTING ENTRY FROM THE 'FIELD' MULTIPLE. RETURN '1' IF THE RECORD WAS DELETED
"RTN","BMXADOS",96,0)
N FIEN,DA,DIK
"RTN","BMXADOS",97,0)
S FIEN=$O(^BMXADO(SIEN,1,"B",FIELD,0)) I 'FIEN Q 0 ; THIS IS A NEW ENTRY
"RTN","BMXADOS",98,0)
W !,"This field already is attached to the schema. Want to delete it"
"RTN","BMXADOS",99,0)
S %=2 D YN^DICN
"RTN","BMXADOS",100,0)
I %'=1 Q 0
"RTN","BMXADOS",101,0)
S DA(1)=SIEN,DIK="^BMXADO("_DA(1)_",1,",DA=FIEN
"RTN","BMXADOS",102,0)
D ^DIK
"RTN","BMXADOS",103,0)
S FIEN=$O(^BMXADO(SIEN,1,"B",(FIELD_"IEN"),0))
"RTN","BMXADOS",104,0)
I FIEN S DA=FIEN D ^DIK ; DELETE LOOKUP VALUE FIELD AS WELL
"RTN","BMXADOS",105,0)
W " Done!",!
"RTN","BMXADOS",106,0)
Q 1
"RTN","BMXADOS",107,0)
;
"RTN","BMXADOS",108,0)
FDEF(FILE,FIELD) ;EP - GIVEN A FILEMAN FILE AND FIELD, RETURN THE DATA DEFINITION IN ADO FORMAT
"RTN","BMXADOS",109,0)
N %,X,Y,Z,STG,I,DTYPE,FNAME,LEN,DNAME
"RTN","BMXADOS",110,0)
I '$D(^DD(+$G(FILE),+$G(FIELD),0)) Q ""
"RTN","BMXADOS",111,0)
S STG=$G(^DD(FILE,FIELD,0)) I '$L(STG) Q "" ; GET DATA DEF STRING
"RTN","BMXADOS",112,0)
DTYPE S %="DNSFWCPVM",X=$P(STG,U,2),DTYPE="" ; GET DATA TYPE
"RTN","BMXADOS",113,0)
F I=1:1:$L(%) S Y=$E(%,I) I X[Y S DTYPE=Y Q
"RTN","BMXADOS",114,0)
I DTYPE="" Q ""
"RTN","BMXADOS",115,0)
FNAME S DNAME=$P(STG,U) I '$L(DNAME) Q "" ; FIELD NAME
"RTN","BMXADOS",116,0)
DDA ; ADO FORMAT
"RTN","BMXADOS",117,0)
I DTYPE="D" D Q "D"_LEN_DNAME
"RTN","BMXADOS",118,0)
. S LEN="00021"
"RTN","BMXADOS",119,0)
. I STG["S %DT=" S %=$P(STG,"S %DT=",2),%=$P(%,$C(34))
"RTN","BMXADOS",120,0)
. I $G(FLDIEN)=.01 S IFLAG=1
"RTN","BMXADOS",121,0)
. I %["S" S LEN="00019" Q
"RTN","BMXADOS",122,0)
. I %["T" S LEN="00018" Q
"RTN","BMXADOS",123,0)
. Q
"RTN","BMXADOS",124,0)
I DTYPE="N",STG["1N.N" D Q:'LEN "" Q "I"_LEN_DNAME ; INTEGER
"RTN","BMXADOS",125,0)
. S %=+$P(STG,"K:+X'=X!(X>",2)
"RTN","BMXADOS",126,0)
. S Y=$L(%)
"RTN","BMXADOS",127,0)
. S LEN=$E("00000",1,5-$L(Y))_Y
"RTN","BMXADOS",128,0)
. Q
"RTN","BMXADOS",129,0)
I DTYPE="N" D Q:'LEN "" Q "N"_LEN_DNAME ; NUMBER (COULD HAVE A DECIMAL VALUE)
"RTN","BMXADOS",130,0)
. S %=+$P(STG,"!(X?.E1"".""",2)
"RTN","BMXADOS",131,0)
. S X=+$P(STG,"K:+X'=X!(X>",2)
"RTN","BMXADOS",132,0)
. S Y=%+($L(+X))
"RTN","BMXADOS",133,0)
. S LEN=$E("00000",1,5-$L(Y))_Y
"RTN","BMXADOS",134,0)
. Q
"RTN","BMXADOS",135,0)
I DTYPE="F" D Q:'LEN "" Q "T"_LEN_DNAME
"RTN","BMXADOS",136,0)
. S Y=+$P(STG,"K:$L(X)>",2)
"RTN","BMXADOS",137,0)
. S LEN=$E("00000",1,5-$L(Y))_Y
"RTN","BMXADOS",138,0)
. I 'LEN S LEN="00030"
"RTN","BMXADOS",139,0)
. I $G(FLDIEN)=.01 S IFLAG=1
"RTN","BMXADOS",140,0)
. Q
"RTN","BMXADOS",141,0)
I DTYPE="S" D Q:'LEN "" Q "T"_LEN_DNAME
"RTN","BMXADOS",142,0)
. S X=$P(STG,U,3),Y=0
"RTN","BMXADOS",143,0)
. F I=1:1:$L(X,":") S Z=$P(X,":",2),Z=$P(Z,";"),%=$L(Z) I %>Y S Y=%
"RTN","BMXADOS",144,0)
. S LEN=$E("00000",1,5-$L(Y))_Y
"RTN","BMXADOS",145,0)
. Q
"RTN","BMXADOS",146,0)
I DTYPE="P" S PFLAG=1 Q "T00030"_DNAME
"RTN","BMXADOS",147,0)
I DTYPE="W" Q "T05000"_DNAME
"RTN","BMXADOS",148,0)
I DTYPE="V" Q ""
"RTN","BMXADOS",149,0)
Q "T00250"_DNAME
"RTN","BMXADOS",150,0)
;
"RTN","BMXADOS",151,0)
FILE(SIEN) ; GET THE FILE OR SUBFILE NUMBER
"RTN","BMXADOS",152,0)
N FNO,FIEN,DIC,X,Y,%,FILE,NSTG,GBL,FNAME,SUB,FARR,TOT,I
"RTN","BMXADOS",153,0)
S (FILE,FNO)=$P(^BMXADO(SIEN,0),U,2)
"RTN","BMXADOS",154,0)
OLD I FNO D I $G(FIEN) Q FIEN
"RTN","BMXADOS",155,0)
. S NSTG=$O(^DD(FNO,0,"NM",""))
"RTN","BMXADOS",156,0)
. F S FNO=$G(^DD(FNO,0,"UP")) Q:'FNO S NSTG=$O(^DD(FNO,0,"NM",""))_"/"_NSTG
"RTN","BMXADOS",157,0)
OLD1 . W !,$S(NSTG["/":"Sub-",1:""),"File #",FILE," (",NSTG,") is linked to this schema."
"RTN","BMXADOS",158,0)
. W !,"Want to keep it" S %=1
"RTN","BMXADOS",159,0)
. D YN^DICN I %'=2 W:%=1 " OK" S FIEN=FILE Q
"RTN","BMXADOS",160,0)
. W !!,"If you change or delete this file number,",!,"all the information in this schema will be deleted."
"RTN","BMXADOS",161,0)
. W !,"Are you sure you want to do this" S %=2 D YN^DICN
"RTN","BMXADOS",162,0)
. I %'=1 W !! G OLD1
"RTN","BMXADOS",163,0)
. S GBL="^BMXADO("_SIEN_")"
"RTN","BMXADOS",164,0)
. K @GBL@(1),@GBL@(2)
"RTN","BMXADOS",165,0)
. S $P(@GBL@(0),U,2)=""
"RTN","BMXADOS",166,0)
. W !,"This schema definition has been deleted. You may redefine it now"
"RTN","BMXADOS",167,0)
. Q
"RTN","BMXADOS",168,0)
NEW S DIC=1,DIC(0)="AEQM" D ^DIC I Y=-1 Q ""
"RTN","BMXADOS",169,0)
S FNO=+Y,FNAME=$P(Y,U,2)
"RTN","BMXADOS",170,0)
NEW1 D SC(.FARR,FNO,1)
"RTN","BMXADOS",171,0)
S TOT=$O(FARR(999999),-1) I 'TOT Q FNO ; NO SUBFILES FOUND
"RTN","BMXADOS",172,0)
W !!,"The ",FNAME," file contains the following sub-file" I TOT>1 W "s"
"RTN","BMXADOS",173,0)
W !
"RTN","BMXADOS",174,0)
S I=0 F S I=$O(FARR(I)) Q:'I S PAUSE=$$PAUSE(I) Q:PAUSE'="" W I,?3,FARR(I)
"RTN","BMXADOS",175,0)
I $G(PAUSE)=U Q ""
"RTN","BMXADOS",176,0)
I $G(PAUSE) S Y=PAUSE G NEW2
"RTN","BMXADOS",177,0)
W !!,"Is the schema linked to a sub-file in this list"
"RTN","BMXADOS",178,0)
S %=2 D YN^DICN I %=2 Q FNO
"RTN","BMXADOS",179,0)
S DIR(0)="NO^1:"_TOT_":",DIR("A")="Select a sub-file from the list" K DA D ^DIR K DIR
"RTN","BMXADOS",180,0)
I 'Y Q ""
"RTN","BMXADOS",181,0)
NEW2 Q +$P(FARR(+Y)," (",2)
"RTN","BMXADOS",182,0)
;
"RTN","BMXADOS",183,0)
PAUSE(I) ; SCROLL CHECK
"RTN","BMXADOS",184,0)
N %
"RTN","BMXADOS",185,0)
W !
"RTN","BMXADOS",186,0)
I (I#20) Q ""
"RTN","BMXADOS",187,0)
W "Select a number from the list (1-",(I-1),") or press <ENTER> to continue: "
"RTN","BMXADOS",188,0)
R %:$G(DTIME,60) E Q ""
"RTN","BMXADOS",189,0)
I %?1."^" Q U
"RTN","BMXADOS",190,0)
I $L(%),$D(FARR(I)) Q %
"RTN","BMXADOS",191,0)
I $L(%) W " ??" H 2
"RTN","BMXADOS",192,0)
W $C(13),?79,$C(13)
"RTN","BMXADOS",193,0)
Q ""
"RTN","BMXADOS",194,0)
;
"RTN","BMXADOS",195,0)
SC(OUT,FILE,MODE) ;EP - SUB CRAWLER. GIVEN A FILE NUMBER RETURN ALL OF ITS DESCENDANT FILES IN AN ARRAY
"RTN","BMXADOS",196,0)
I '$D(^DD(FILE,"SB")) Q ; NO DESCENDANTS
"RTN","BMXADOS",197,0)
N TOT,FNO,FNAME,FIEN,LEVEL,NODE,SARR,STG,X,%,UP,ARR
"RTN","BMXADOS",198,0)
S FIEN=FILE,TOT=0
"RTN","BMXADOS",199,0)
D PASS1
"RTN","BMXADOS",200,0)
I '$O(ARR(0)) Q
"RTN","BMXADOS",201,0)
SC2 ; SECOND PASS. BUILD THE INTERMEDIATE ARRAY
"RTN","BMXADOS",202,0)
S FNO=0 F S FNO=$O(ARR(FNO)) Q:'FNO D
"RTN","BMXADOS",203,0)
. I $P($G(^DD(FNO,.01,0)),U,2)["W" K ARR(FNO) Q ; WORD PROCESSING FIELDS DO NOT COUNT
"RTN","BMXADOS",204,0)
. S STG=FNO,UP=FNO
"RTN","BMXADOS",205,0)
. F S UP=$G(^DD(UP,0,"UP")) Q:'UP S STG=UP_","_STG ; BUILD DESCENDANT STRING
"RTN","BMXADOS",206,0)
. I $G(MODE) S STG=$$ASTG(STG)
"RTN","BMXADOS",207,0)
. S STG=$P(STG,",",2,99) ; DONT NEED TOP LEVEL FILE
"RTN","BMXADOS",208,0)
. I '$L(STG) Q ; SOMETHING IS SCREWED UP
"RTN","BMXADOS",209,0)
. S LEVEL=$L(STG,",")
"RTN","BMXADOS",210,0)
. S FNAME=$O(^DD(FNO,0,"NM",""))
"RTN","BMXADOS",211,0)
. S X="SARR("_STG_")"
"RTN","BMXADOS",212,0)
. S @X=FNAME_U_LEVEL_U_FNO
"RTN","BMXADOS",213,0)
. K ARR(FNO)
"RTN","BMXADOS",214,0)
. Q
"RTN","BMXADOS",215,0)
SC3 ; 3RD PASS. BUILD OUTPUT ARAY
"RTN","BMXADOS",216,0)
S NODE="SARR"
"RTN","BMXADOS",217,0)
F S NODE=$Q(@NODE) Q:NODE="" D
"RTN","BMXADOS",218,0)
. S X=@NODE
"RTN","BMXADOS",219,0)
. S TOT=TOT+1
"RTN","BMXADOS",220,0)
. S FNAME=$P(X,U)
"RTN","BMXADOS",221,0)
. S LEVEL=$P(X,U,2)
"RTN","BMXADOS",222,0)
. S FNO=$P(X,U,3)
"RTN","BMXADOS",223,0)
. S OUT(TOT)=$E(" ",1,LEVEL)_FNAME_" ("_FNO_")"
"RTN","BMXADOS",224,0)
. Q
"RTN","BMXADOS",225,0)
Q
"RTN","BMXADOS",226,0)
;
"RTN","BMXADOS",227,0)
PASS1 ; PASS 1. BUILD THE ARRAY OF ALL SUBFILES
"RTN","BMXADOS",228,0)
N FNO S FNO=0
"RTN","BMXADOS",229,0)
F S FNO=$O(^DD(FIEN,"SB",FNO)) Q:'FNO D
"RTN","BMXADOS",230,0)
. S ARR(FNO)=""
"RTN","BMXADOS",231,0)
. I '$D(^DD(FNO,"SB")) Q
"RTN","BMXADOS",232,0)
. N FIEN S FIEN=FNO
"RTN","BMXADOS",233,0)
. D PASS1 ; RECURSION!!
"RTN","BMXADOS",234,0)
. Q
"RTN","BMXADOS",235,0)
Q
"RTN","BMXADOS",236,0)
;
"RTN","BMXADOS",237,0)
ASTG(STG) ; CONVERT STRING FROM FILE NUMBERS TO FILE NAMES
"RTN","BMXADOS",238,0)
N PCE,LEV,FNO,NAME
"RTN","BMXADOS",239,0)
S LEV=$L(STG,",")
"RTN","BMXADOS",240,0)
F PCE=1:1:LEV S FNO=+$P(STG,",",PCE) D Q:'$L(STG) ; v 2.21 SMH
"RTN","BMXADOS",241,0)
. S NAME=$O(^DD(FNO,0,"NM",""))
"RTN","BMXADOS",242,0)
. I $E(NAME)="*" S NAME=$E(NAME,2,99)
"RTN","BMXADOS",243,0)
. I '$L(NAME) S STG="" Q
"RTN","BMXADOS",244,0)
. S $P(STG,",",PCE)=""""_NAME_""""
"RTN","BMXADOS",245,0)
. Q
"RTN","BMXADOS",246,0)
Q STG
"RTN","BMXADOS",247,0)
;
"RTN","BMXADOS",248,0)
FLIST(OUT,FILE,MODE) ;EP - GIVEN A FILE RETURN THE FILEDS IN AN ARRAY MODE=0: NUMERIC ORDER, MODE=1: ALPHA ORDER
"RTN","BMXADOS",249,0)
; ONLY NON MULTIPLES AND WORD PROCESSING FIELDS ARE LISTED
"RTN","BMXADOS",250,0)
N FLD,TOT,NAME,ARR,SS,%,WP
"RTN","BMXADOS",251,0)
S FLD=0,TOT=0
"RTN","BMXADOS",252,0)
F1 F S FLD=$O(^DD(FILE,FLD)) Q:'FLD D ; PASS 1
"RTN","BMXADOS",253,0)
. S STG=$G(^DD(FILE,FLD,0)) I '$L(STG) Q
"RTN","BMXADOS",254,0)
. S %=$P(STG,U,2)
"RTN","BMXADOS",255,0)
. I %,$P($G(^DD(%,.01,0)),U,2)'["W" Q ; EXCLUDE ALL MULTIPLE FIELDS EXCEPT WORD PROCESSING FIELDS
"RTN","BMXADOS",256,0)
. S WP=0 I % S WP=1
"RTN","BMXADOS",257,0)
. S NAME=$P(STG,U)
"RTN","BMXADOS",258,0)
. S SS=FLD
"RTN","BMXADOS",259,0)
. I $G(MODE)=1 S %=NAME S:$E(%)="*" %=$E(%,2,99) S SS=%
"RTN","BMXADOS",260,0)
. S ARR(SS)=FLD_U_NAME_U_WP
"RTN","BMXADOS",261,0)
. Q
"RTN","BMXADOS",262,0)
F2 S SS=""
"RTN","BMXADOS",263,0)
F S SS=$O(ARR(SS)) Q:SS="" D
"RTN","BMXADOS",264,0)
. S TOT=TOT+1
"RTN","BMXADOS",265,0)
. S %=ARR(SS)
"RTN","BMXADOS",266,0)
. S OUT(TOT)=$P(%,U,2)_" ["_+%_"]"_$S($P(%,U,3):" (word processing)",1:"")
"RTN","BMXADOS",267,0)
. K ARR(SS)
"RTN","BMXADOS",268,0)
. Q
"RTN","BMXADOS",269,0)
Q
"RTN","BMXADOS",270,0)
;
"RTN","BMXADOS1")
0^70^B9622665
"RTN","BMXADOS1",1,0)
BMXADOS1 ; IHS/CIHA/GIS - UPDATE THE BMX ADO SCHEMA FILE GUI VERSION ;
"RTN","BMXADOS1",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXADOS1",3,0)
; RPC CALLS
"RTN","BMXADOS1",4,0)
;
"RTN","BMXADOS1",5,0)
;
"RTN","BMXADOS1",6,0)
;
"RTN","BMXADOS1",7,0)
DISP(OUT) ; TEMP DISPLAY
"RTN","BMXADOS1",8,0)
N I,X
"RTN","BMXADOS1",9,0)
S I=0 W !
"RTN","BMXADOS1",10,0)
F S I=$O(@OUT@(I)) Q:'I S X=@OUT@(I) S X=$TR(X,$C(30),"}") S X=$TR(X,$C(31),"{") W !,X
"RTN","BMXADOS1",11,0)
Q
"RTN","BMXADOS1",12,0)
;
"RTN","BMXADOS1",13,0)
SCHEMA(NAME) ; GIVEN SCHEMA NAME, RETURN THE IEN
"RTN","BMXADOS1",14,0)
N IEN
"RTN","BMXADOS1",15,0)
S IEN=$O(^BMXADO("B",NAME,0))
"RTN","BMXADOS1",16,0)
Q IEN
"RTN","BMXADOS1",17,0)
;
"RTN","BMXADOS1",18,0)
FILE ; RETURN A LIST OF FILES
"RTN","BMXADOS1",19,0)
N OUT,%,SIEN
"RTN","BMXADOS1",20,0)
S SIEN=$$SCHEMA("FILEMAN FILES")
"RTN","BMXADOS1",21,0)
D SS^BMXADO(.OUT,SIEN,"","B~B~C~")
"RTN","BMXADOS1",22,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOS1",23,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOS1",24,0)
Q
"RTN","BMXADOS1",25,0)
;
"RTN","BMXADOS1",26,0)
SF ; RETURN A LIST OF SUBFILES
"RTN","BMXADOS1",27,0)
N OUT,%,SIEN
"RTN","BMXADOS1",28,0)
S SIEN=$$SCHEMA("SUBFILES")
"RTN","BMXADOS1",29,0)
D SS^BMXADO(.OUT,SIEN,"","~~~~~SFIT~BMXADOS1~2~")
"RTN","BMXADOS1",30,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOS1",31,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOS1",32,0)
Q
"RTN","BMXADOS1",33,0)
;
"RTN","BMXADOS1",34,0)
FLD ; RETURN LIST OF FIELDS FOR A FILE OR SUBFILE
"RTN","BMXADOS1",35,0)
N OUT,%,SIEN
"RTN","BMXADOS1",36,0)
S SIEN=$$SCHEMA("FIELDS")
"RTN","BMXADOS1",37,0)
D SS^BMXADO(.OUT,SIEN,"","~~~~~FLDIT~BMXADOS1~2~")
"RTN","BMXADOS1",38,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOS1",39,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOS1",40,0)
Q
"RTN","BMXADOS1",41,0)
;
"RTN","BMXADOS1",42,0)
SCH ; RETURN A LIST OF SCHEMAS
"RTN","BMXADOS1",43,0)
N OUT,%,SIEN
"RTN","BMXADOS1",44,0)
S SIEN=$$SCHEMA("SCHEMAS")
"RTN","BMXADOS1",45,0)
D SS^BMXADO(.OUT,SIEN,"","B~~~")
"RTN","BMXADOS1",46,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOS1",47,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOS1",48,0)
Q
"RTN","BMXADOS1",49,0)
;
"RTN","BMXADOS1",50,0)
SD ; RETURN THE SCHEMA DEFINITION
"RTN","BMXADOS1",51,0)
N OUT,%,SIEN
"RTN","BMXADOS1",52,0)
S SIEN=$$SCHEMA("SCHEMA DEFINITION")
"RTN","BMXADOS1",53,0)
D SS^BMXADO(.OUT,SIEN,"52,","~~~")
"RTN","BMXADOS1",54,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOS1",55,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOS1",56,0)
Q
"RTN","BMXADOS1",57,0)
;
"RTN","BMXADOS1",58,0)
FLDIT(PARAM,IENS,MAX,OUT,TOT) ; CUSTOM ITERATOR TO DISPLAY FIELDS
"RTN","BMXADOS1",59,0)
N SFARR,CNT,DEL,NUM,NAME,DDT,DLEN,DHDR,DRO,DKEY,DNA,X,Y
"RTN","BMXADOS1",60,0)
D FLIST^BMXADOS(.SFARR,PARAM)
"RTN","BMXADOS1",61,0)
S CNT=0,DEL=" ["
"RTN","BMXADOS1",62,0)
F S CNT=$O(SFARR(CNT)) Q:'CNT D
"RTN","BMXADOS1",63,0)
. S X=SFARR(CNT) I '$L(X) Q
"RTN","BMXADOS1",64,0)
. S NAME=$P(X,DEL)
"RTN","BMXADOS1",65,0)
. ; F Q:$E(NAME)'=" " S NAME=$E(NAME,2,999)
"RTN","BMXADOS1",66,0)
. I '$L(NAME) Q
"RTN","BMXADOS1",67,0)
. S NUM=+$P(X,DEL,2) I 'NUM Q
"RTN","BMXADOS1",68,0)
. S TOT=TOT+1
"RTN","BMXADOS1",69,0)
. S Y=$$FDEF^BMXADOS(PARAM,NUM) I '$L(Y) Q ; ""
"RTN","BMXADOS1",70,0)
. S DDT=$E(Y),DLEN=+$E(Y,2,6),DHDR=$E(Y,7,99)
"RTN","BMXADOS1",71,0)
. S DRO="NO" S DKEY="NO" S DNA="YES"
"RTN","BMXADOS1",72,0)
. S ^TMP("BMX ADO",$J,TOT)=NUM_U_NAME_U_DDT_U_DLEN_U_DHDR_U_DRO_U_DKEY_U_DNA_$C(30)
"RTN","BMXADOS1",73,0)
Q ""
"RTN","BMXADOS1",74,0)
;
"RTN","BMXADOS1",75,0)
FNIT(PARAM,IENS,MAX,OUT,TOT) ; CUSTOM ITERATOR TO DISPLAY FILE OR SUBFILE NAME GIVEN FILE NUMBER
"RTN","BMXADOS1",76,0)
N NUM,NAME
"RTN","BMXADOS1",77,0)
S NUM=+PARAM
"RTN","BMXADOS1",78,0)
S NAME=""
"RTN","BMXADOS1",79,0)
Q:'$D(^DD(NUM,0,"NM")) ""
"RTN","BMXADOS1",80,0)
S NAME=$O(^DD(NUM,0,"NM",0))
"RTN","BMXADOS1",81,0)
S TOT=TOT+1
"RTN","BMXADOS1",82,0)
S ^TMP("BMX ADO",$J,TOT)=NUM_U_NAME_$C(30)
"RTN","BMXADOS1",83,0)
Q ""
"RTN","BMXADOS1",84,0)
;
"RTN","BMXADOS1",85,0)
SFIT(PARAM,IENS,MAX,OUT,TOT) ; CUSTOM ITERATOR TO DISPLAY SUBFILES
"RTN","BMXADOS1",86,0)
N SFARR,CNT,DEL,NUM,NAME
"RTN","BMXADOS1",87,0)
D SC^BMXADOS(.SFARR,PARAM)
"RTN","BMXADOS1",88,0)
S CNT=0,DEL=" ("
"RTN","BMXADOS1",89,0)
F S CNT=$O(SFARR(CNT)) Q:'CNT D
"RTN","BMXADOS1",90,0)
. S X=SFARR(CNT) I '$L(X) Q
"RTN","BMXADOS1",91,0)
. S NAME=$P(X,DEL)
"RTN","BMXADOS1",92,0)
. ; F Q:$E(NAME)'=" " S NAME=$E(NAME,2,999)
"RTN","BMXADOS1",93,0)
. I '$L(NAME) Q
"RTN","BMXADOS1",94,0)
. S NUM=+$P(X,DEL,2) I 'NUM Q
"RTN","BMXADOS1",95,0)
. S TOT=TOT+1
"RTN","BMXADOS1",96,0)
. S ^TMP("BMX ADO",$J,TOT)=NUM_U_NAME_$C(30)
"RTN","BMXADOS1",97,0)
Q ""
"RTN","BMXADOS1",98,0)
;
"RTN","BMXADOS1",99,0)
SFT(FNAME) ; TRIGGER "YES" TO INDICATE THAT A SUBFILE IS PRESENT WITHIN A FILE
"RTN","BMXADOS1",100,0)
I '$L($G(FNAME)) Q ""
"RTN","BMXADOS1",101,0)
N FIEN
"RTN","BMXADOS1",102,0)
S FIEN=$O(^DIC("B",FNAME,0))
"RTN","BMXADOS1",103,0)
I 'FIEN Q ""
"RTN","BMXADOS1",104,0)
I '$O(^DD(FIEN,"SB",0)) Q ""
"RTN","BMXADOS1",105,0)
Q "+"
"RTN","BMXADOS1",106,0)
;
"RTN","BMXADOV")
0^71^B22947698
"RTN","BMXADOV",1,0)
BMXADOV ; CIHA/CIHA/GIS - RPC CALL: GENERATE DATA FOR AN ADO DATASET
"RTN","BMXADOV",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXADOV",3,0)
;
"RTN","BMXADOV",4,0)
;
"RTN","BMXADOV",5,0)
;
"RTN","BMXADOV",6,0)
; VSTG = VIEW STRING: SCHEMA NAME OR IEN~DAS~INDEX~START~STOP~MAX~FORMAT~TAG~ROUTINE~PARAM~JOIN
"RTN","BMXADOV",7,0)
; SCHEMA NAME/IEN: FROM THE BMX ADO SCHEMA FILE
"RTN","BMXADOV",8,0)
; DAS: THE DA STRING. HIGHEST LEVEL IS FIRST, FOLLOWED BY SUBFILE IENS. CAN BE CONVERTED TO AN 'IENS' STRING.
"RTN","BMXADOV",9,0)
; IF THE LAST ',' PIECE OF DAS IS DEFINED, THAT IS USED AS THE CURRENT STARTING SEED POINT FOR THE ITERATOR
"RTN","BMXADOV",10,0)
; THE NEXT INDEX VALUE AFTER THE SEED POINT WILL BE THE FIRST ENTRY SELECTED FOR THE CURRENT TRANSACTION
"RTN","BMXADOV",11,0)
; INDEX: THE INDEX THAT RUNS THE ITERATOR. IF NULL, THE ITERATOR WULL CYCLE BY IEN
"RTN","BMXADOV",12,0)
; START: STARTING LOOKUP VALUE IN THE OVERALL ITERATION (THE FIRST VALUE THAT CAN BE USED IN SPECIFIED INDEX)
"RTN","BMXADOV",13,0)
; STOP: THE LAST LOOKUP VALUE IN THE OVERALL ITERATION (THE LAST VALUE USED IN SPECIFIED INDEX)
"RTN","BMXADOV",14,0)
; START AND STOP MUST BE IN THE FORMAT (INTERNAL OR EXTERNAL) USED BY THE INDEX
"RTN","BMXADOV",15,0)
; IF THE INDEX IS ON A POINTER FIELD, AND POINTED TO FILED IS DINUMNED, THEN THE EXTERNAL VALUE CAN BE USED
"RTN","BMXADOV",16,0)
; MAX: MAXIMUM NUMBER OF ENTRIES REURNED IN THE TRANSACTION
"RTN","BMXADOV",17,0)
; FORMAT: RETURN INTERNAL OR EXTERNAL VALUES IN THE DATASET
"RTN","BMXADOV",18,0)
; TAG AND ROUTINE: ENTRY POINT FOR CUSTOM/COMPLEX ITERATION
"RTN","BMXADOV",19,0)
; PARAM: PARAMETER STRING PASSED TO THE ITERATOR ENTRY POINT.
"RTN","BMXADOV",20,0)
; ALSO USED WITH THE AA INDEX TO DEFINE PATIENT DFN, V FILE ATTRIBUTE TYPE AND SORT ORDER (C OR R)
"RTN","BMXADOV",21,0)
; E.G., 1|WT|R COULD BE PATIENT #1, MEASUREMENT TYPE="WEIGHT" AND REVERSE CHRONOLICAL PRESENTATION OF DATA
"RTN","BMXADOV",22,0)
; JOIN: JOIN INSTRUCTIONS; E.G., ...~2,4,.04|2,5,.07|4,9,SUB"
"RTN","BMXADOV",23,0)
;
"RTN","BMXADOV",24,0)
;
"RTN","BMXADOV",25,0)
VIEW(OUT,VSTG,TOT) ; EP-VIEW A DATA SET ; GATEWAY TO ALL ITERATORS
"RTN","BMXADOV",26,0)
;
"RTN","BMXADOV",27,0)
; DON'T CALL THIS EP UNLESS YOU WANT DATA RETURNED WITH THE SCHEMA!
"RTN","BMXADOV",28,0)
; INPUT: VSTG AND THE TOTAL NUMBER OF NODES IN THE SCHEMA ARRAY
"RTN","BMXADOV",29,0)
; OUTPUT: THE DATA NODES AND THE SEED (SEED IS STUFFED INTO 3RD PIECE OF INTRODUCTORY NODE OF SCHEMA ARRAY)
"RTN","BMXADOV",30,0)
; RETURNS THE ADO DATASET IN THE ARRAY SPECIFIED BY 'OUT'
"RTN","BMXADOV",31,0)
; THE SEED IS ALWAYS RETURNED IN 'LDA' REGARDLESS OF WHAT ITERATOR IS USED
"RTN","BMXADOV",32,0)
; IF ITERATION IS COMPLETED THE SEED WILL HAVE A NULL VALUE
"RTN","BMXADOV",33,0)
;
"RTN","BMXADOV",34,0)
;
"RTN","BMXADOV",35,0)
;
"RTN","BMXADOV",36,0)
N DAS,DA,IX,START,STOP,MAX,FMT,EP,IENS,OREF,CREF,FIEN,TAG,ROUTINE,X,Y,%,PARAM,NUM,FINFO,LIEN,LDA,LFILE,%DT,T
"RTN","BMXADOV",37,0)
S SIEN=+$G(VSTG) I SIEN,'$D(^BMXADO(SIEN,0)) S ERR="Invalid schema IEN" D ERR^BMXADO(ERR) Q
"RTN","BMXADOV",38,0)
I $G(TOT)<2 S ERR="Missing schema string" D ERR^BMXADO(ERR) Q ; MUST HAVE A VALID SCHEMA STRING FOR EACH TRANSACTION
"RTN","BMXADOV",39,0)
INIT ; INITIALIZE VARIABLES
"RTN","BMXADOV",40,0)
S T="~"
"RTN","BMXADOV",41,0)
S FIEN=$P(^BMXADO(SIEN,0),U,2) I '$D(^DD(FIEN,0)) S ERR="Invalid file number in schema file" D ERR^BMXADO(ERR) Q
"RTN","BMXADOV",42,0)
S DAS=$P(VSTG,T,2),IX=$P(VSTG,T,3)
"RTN","BMXADOV",43,0)
S START=$P(VSTG,T,4),STOP=$P(VSTG,T,5),MAX=$P(VSTG,T,6)
"RTN","BMXADOV",44,0)
I $L(START),$L(STOP),START,START=+START,STOP,STOP=+STOP
"RTN","BMXADOV",45,0)
S %=$T ; NUMERIC START AND STOP
"RTN","BMXADOV",46,0)
I %,START>STOP S ERR="Invalid start stop pair" D ERR^BMXADO(ERR) Q
"RTN","BMXADOV",47,0)
I '%,$L(START),$L(STOP),START]STOP S ERR="Invalid start stop pair" D ERR^BMXADO(ERR) Q
"RTN","BMXADOV",48,0)
I $L(MAX),(MAX'>0!(MAX'=MAX\1)) S ERR="Invalid MAX parameter" D ERR^BMXADO(ERR) Q
"RTN","BMXADOV",49,0)
S FMT=$P(VSTG,T,7),TAG=$P(VSTG,T,8),ROUTINE=$P(VSTG,T,9),PARAM=$P(VSTG,T,10),NUM=0
"RTN","BMXADOV",50,0)
I $L(TAG),'$L(ROUTINE) S ERR="Invalid EP info" D ERR^BMXADO(ERR) Q
"RTN","BMXADOV",51,0)
S EP=TAG_U_ROUTINE I EP=U S EP=""
"RTN","BMXADOV",52,0)
I $L(EP) X ("S %=$L($T("_EP_"))") I '% S ERR="Invalid EP info" D ERR^BMXADO(ERR) Q
"RTN","BMXADOV",53,0)
I FMT='"I" S FMT=""
"RTN","BMXADOV",54,0)
I MAX="" S MAX=100
"RTN","BMXADOV",55,0)
I $G(JOIN) S MAX=999999999 ; MAX IS UNLIMITED FOR SECONDARY DATA SETS DURING JOINS
"RTN","BMXADOV",56,0)
S IENS=$$IENS(DAS) ; CONVERT DA STRING TO IEN STRING ; DAS AND IENS MUST BE AVAILABLE TO ALL ITERATORS
"RTN","BMXADOV",57,0)
S OREF=$$ROOT^DILFD(FIEN,IENS) I '$L(OREF) S ERR="Unable to generate a vaild open reference" D ERR^BMXADO(ERR) Q
"RTN","BMXADOV",58,0)
S CREF=$$CREF^DILF(OREF) I '$L(CREF) S ERR="Unable to generate a vaild closed reference" D ERR^BMXADO(ERR) Q
"RTN","BMXADOV",59,0)
DATA ; GET DATA
"RTN","BMXADOV",60,0)
SPEC I $L(EP) D Q ; SPECIAL CASE: USE CUSTOM ITERATOR
"RTN","BMXADOV",61,0)
. I '$G(LDA) S LDA=""
"RTN","BMXADOV",62,0)
. X ("S LDA=$$"_EP_"(PARAM,IENS,MAX,.OUT,.TOT)")
"RTN","BMXADOV",63,0)
. D SEED(LDA)
"RTN","BMXADOV",64,0)
. Q
"RTN","BMXADOV",65,0)
I IX="" S LDA=$$NUMIT^BMXADOV1(+$G(DA)) D SEED(LDA) Q ; NO INDEX USED: ITERATE IN IEN ORDER
"RTN","BMXADOV",66,0)
I IX="AA",FIEN=9000013!(FIEN=9000019) S IX="AC" ; 'AA' ITERATION UNNECESSARY FOR SOME FILES. BETTER TO USE 'AC'
"RTN","BMXADOV",67,0)
I '$L($O(@CREF@(IX,""))) Q ; NO INDEXED DATA AVAILABLE, SO QUIT NOW
"RTN","BMXADOV",68,0)
I IX="AA" D Q ; SPECIAL CASE: AA INDEX
"RTN","BMXADOV",69,0)
. I FIEN=9000011 S LDA=$$AAP^BMXADOV1 Q ; THE AA INDEX FOR 'PROBLEMS'; LDA ALWAYS NULL
"RTN","BMXADOV",70,0)
. S LDA=$$AA^BMXADOV1 D SEED(LDA) ; THE VISIT/V-FILE AA INDEX
"RTN","BMXADOV",71,0)
. Q
"RTN","BMXADOV",72,0)
S FINFO=$$IXFLD(FIEN,IX) I FINFO="" Q ; FILE INFO: IX FIELD NUMBER, TYPE, AND DINUM SUBTYPE
"RTN","BMXADOV",73,0)
I $P(FINFO,U,2)="D" D ; PREP FOR DATE INDEX LOOKUP
"RTN","BMXADOV",74,0)
. I $L(START) S X=START D ^%DT S START=+Y
"RTN","BMXADOV",75,0)
. I $L(STOP) S X=STOP D ^%DT S STOP=+Y
"RTN","BMXADOV",76,0)
. Q
"RTN","BMXADOV",77,0)
I $P(FINFO,U,2)="P",$E(START)="`" D Q ; SPECIAL CASE: SHORTCUT TO POINTER LOOKUP FOR A SINGLE, SPECIFIC IEN.
"RTN","BMXADOV",78,0)
. S LIEN=+$E(START,2,99)
"RTN","BMXADOV",79,0)
. S LDA=$$LOOK^BMXADOV1(LIEN)
"RTN","BMXADOV",80,0)
. D SEED(LDA)
"RTN","BMXADOV",81,0)
. Q
"RTN","BMXADOV",82,0)
I $P(FINFO,U,4) S LFILE=$P(FINFO,U,3) I LFILE D Q ; SPECIAL CASE: DINUM -> TEXT LOOKUP.
"RTN","BMXADOV",83,0)
. S LDA=$$LOOK2^BMXADOV1(LFILE)
"RTN","BMXADOV",84,0)
. D SEED(LDA)
"RTN","BMXADOV",85,0)
. Q
"RTN","BMXADOV",86,0)
S LDA=$$LOOK1^BMXADOV1 ; STD INDEX LOOKUP: START FROM SCRATCH
"RTN","BMXADOV",87,0)
D SEED(LDA) ; CAPTURE RE-ENTRY SEED
"RTN","BMXADOV",88,0)
Q
"RTN","BMXADOV",89,0)
;
"RTN","BMXADOV",90,0)
SEED(LDA) ; UPDATE THE SCHEMA STRING WITH THE SEED PARAMETER
"RTN","BMXADOV",91,0)
N X,Y
"RTN","BMXADOV",92,0)
S X=@OUT@(1)
"RTN","BMXADOV",93,0)
S Y=$P(X,U)
"RTN","BMXADOV",94,0)
S $P(Y,"|",3)=LDA
"RTN","BMXADOV",95,0)
S $P(X,U,1)=Y
"RTN","BMXADOV",96,0)
S @OUT@(1)=X
"RTN","BMXADOV",97,0)
Q
"RTN","BMXADOV",98,0)
;
"RTN","BMXADOV",99,0)
IENS(DAS) ;EP - CONVERT DAS STRING TO IENS STRING
"RTN","BMXADOV",100,0)
N I,L,IENS
"RTN","BMXADOV",101,0)
S DAS=$G(DAS)
"RTN","BMXADOV",102,0)
S DAS=$TR(DAS,"+","")
"RTN","BMXADOV",103,0)
S DAS=$TR(DAS,"-","")
"RTN","BMXADOV",104,0)
I '$L(DAS) Q ","
"RTN","BMXADOV",105,0)
I DAS="," S DAS=""
"RTN","BMXADOV",106,0)
S L=$L(DAS,C)
"RTN","BMXADOV",107,0)
S IENS=""
"RTN","BMXADOV",108,0)
F I=L:-1:1 S IENS=IENS_$P(DAS,C,I)_C
"RTN","BMXADOV",109,0)
Q IENS
"RTN","BMXADOV",110,0)
;
"RTN","BMXADOV",111,0)
IXFLD(FIEN,IX) ;EP - GIVEN AN FILE NUMMER AND INDEX NAME, RETURIN THE FIELD NUMBER, TYPE, AND DINUM SUBTYPE
"RTN","BMXADOV",112,0)
N FLD,TYPES,T,X,I
"RTN","BMXADOV",113,0)
I '$G(FIEN) Q ""
"RTN","BMXADOV",114,0)
I '$L($G(IX)) Q ""
"RTN","BMXADOV",115,0)
S FLD=$O(^DD(FIEN,0,"IX",IX,FIEN,0))
"RTN","BMXADOV",116,0)
I 'FLD Q FLD
"RTN","BMXADOV",117,0)
S TYPES="DNSFWCPVM",T=$P($G(^DD(FIEN,FLD,0)),U,2)
"RTN","BMXADOV",118,0)
F I=1:1 S X=$E(TYPES,I) Q:'$L(X) I T[X Q
"RTN","BMXADOV",119,0)
I X="P" S X=X_U_+$P(T,"P",2) I $P(^DD(FIEN,FLD,0),U,5)["DINUM" S X=X_U_1
"RTN","BMXADOV",120,0)
S FLD=FLD_U_X
"RTN","BMXADOV",121,0)
Q FLD
"RTN","BMXADOV",122,0)
;
"RTN","BMXADOV1")
0^45^B71930345
"RTN","BMXADOV1",1,0)
BMXADOV1 ; IHS/CIHA/GIS - RPC CALL: GENERATE DATA FOR AN ADO DATASET ; 12/7/10 4:12pm
"RTN","BMXADOV1",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXADOV1",3,0)
; CONTINUATION FILE FOR BMXADOV
"RTN","BMXADOV1",4,0)
; MANAGES ITERATION FOR INDIVIDUAL INDEX TYPES
"RTN","BMXADOV1",5,0)
; ASSUMES CERTAIN LOCAL VARS: CREF,FIEN,IENS,DAS (<-THESE CAN'T BE NULL),START,STOP,MAX,TOT,NUM,IX
"RTN","BMXADOV1",6,0)
;
"RTN","BMXADOV1",7,0)
; Change Log
"RTN","BMXADOV1",8,0)
; Sam Habiel 3101212 v. 2.21
"RTN","BMXADOV1",9,0)
; Change line 140 from:
"RTN","BMXADOV1",10,0)
; I IX="AA" G AA to
"RTN","BMXADOV1",11,0)
; I IX="AA" Q $$AA
"RTN","BMXADOV1",12,0)
; to fix compilation error
"RTN","BMXADOV1",13,0)
;
"RTN","BMXADOV1",14,0)
;
"RTN","BMXADOV1",15,0)
DATA(IENS,DA,XCNT) ;EP - ADD DATA NODES TO ARRAY
"RTN","BMXADOV1",16,0)
; ASSUMES THAT VSTG VARIABLES AND THE OUT ARRAY ARE PRESENT
"RTN","BMXADOV1",17,0)
I '$G(DA) Q
"RTN","BMXADOV1",18,0)
I '$L(IENS) Q
"RTN","BMXADOV1",19,0)
S $P(IENS,C)=DA
"RTN","BMXADOV1",20,0)
N STG,X,Y,%,FLD,STOP,VAL,CNT,FIEN,LINE,IFLAG,IDEP,TFLD,TNO,TEF
"RTN","BMXADOV1",21,0)
S STG=DA
"RTN","BMXADOV1",22,0)
I $G(DAS),$E(DAS,$L(DAS))="," S STG=$TR(DAS,",",U)_STG ; FIX FOR SUBFILE
"RTN","BMXADOV1",23,0)
S CNT=$L(IENS,",") ; START AFTER THE .001 FIELD
"RTN","BMXADOV1",24,0)
I $G(SUB) S STG=$P(IENS,C,2)_U_DA ; MAKE DAS FOR A SUBFILE. THIS WILL BE THE IST PIECE OF THE DATA STRING
"RTN","BMXADOV1",25,0)
I $G(XCNT) S CNT=XCNT ; USED WITH JOINS
"RTN","BMXADOV1",26,0)
F S CNT=$O(@OUT@(CNT)) Q:'CNT Q:$G(STOP) D I @OUT@(CNT)[$C(30) Q ; LOOP TO CREATE THE DATA STRING
"RTN","BMXADOV1",27,0)
. K IFLAG,IDEP
"RTN","BMXADOV1",28,0)
. S FIEN=+@OUT@(CNT) I '$D(^DD(FIEN,0)) S STOP=1 Q
"RTN","BMXADOV1",29,0)
. S FLD=$P(@OUT@(CNT),B,2)
"RTN","BMXADOV1",30,0)
. I FLD=".01ID" D Q ; PROCESS THE IDENTIFIER FIELD
"RTN","BMXADOV1",31,0)
.. I '$G(SIEN) Q
"RTN","BMXADOV1",32,0)
.. S %=$O(^BMXADO(SIEN,1,"B",".01ID",0)) I '% Q
"RTN","BMXADOV1",33,0)
.. S IDEP=$G(^BMXADO(SIEN,1,%,1)) I '$L(IDEP) Q
"RTN","BMXADOV1",34,0)
.. X ("S VAL=$$"_IDEP_"("_+STG_")") ; PASS THE DA TO THE IDENTIFIER EXTRINSIC FUNCTION, RETURN IDENTIFIERS
"RTN","BMXADOV1",35,0)
.. S VAL=$TR(VAL,"^",""),VAL=$TR(VAL,B,"")
"RTN","BMXADOV1",36,0)
.. S STG=STG_U_VAL
"RTN","BMXADOV1",37,0)
.. Q
"RTN","BMXADOV1",38,0)
. I $G(SIEN),FLD S %=$O(^BMXADO(SIEN,1,"B",FLD,0)) I %,$P($G(^BMXADO(SIEN,1,%,0)),U,9) S IFLAG=1 ; SCHEMA FILE SAYS FORCE INTERNAL VALUE FOR THIS FIELD
"RTN","BMXADOV1",39,0)
. K TFLD
"RTN","BMXADOV1",40,0)
. I FLD["TRIGGER" S TFLD=FLD,FLD=+FLD,IFLAG=1
"RTN","BMXADOV1",41,0)
. I FLD["IEN" S FLD=+FLD,IFLAG=1 ; LOOKUP VALUE FIELD (IEN)
"RTN","BMXADOV1",42,0)
. I '$D(^DD(FIEN,FLD,0)),FLD'=.001 S STOP=1 Q
"RTN","BMXADOV1",43,0)
. I $D(TFLD),FLD=.001 S VAL=+IENS
"RTN","BMXADOV1",44,0)
. E S VAL=$$GET1^DIQ(FIEN,IENS,FLD,$S($G(IFLAG):"I",$G(TFLAG):"I",1:$G(FMT)))
"RTN","BMXADOV1",45,0)
. I $G(TFLD) D S STG=STG_U_VAL Q ; GENERATE A TRIGGERED VALUE FOR THIS FIELD
"RTN","BMXADOV1",46,0)
.. S TNO=$O(^BMXADO(SIEN,1,"B",TFLD,0)) I 'TNO S VAL="" Q
"RTN","BMXADOV1",47,0)
.. S TEF=$G(^BMXADO(SIEN,1,TNO,3)) I '$L(TEF) S VAL="" Q ; GET EXTR FUNCT THAT GENERATES A SECONDARY VALUE
"RTN","BMXADOV1",48,0)
.. X ("S VAL=$$"_TEF_"(VAL)")
"RTN","BMXADOV1",49,0)
.. Q
"RTN","BMXADOV1",50,0)
. I FLD=.01,VAL="" S STOP=1 Q ; INVALID FILEMAN ENTRY! SKIP IT
"RTN","BMXADOV1",51,0)
. S VAL=$TR(VAL,"^",""),VAL=$TR(VAL,B,"")
"RTN","BMXADOV1",52,0)
. S STG=STG_U_VAL
"RTN","BMXADOV1",53,0)
. Q
"RTN","BMXADOV1",54,0)
I $G(STOP) Q ; DON'T ADD NODE IF DD INFO IS INVALID
"RTN","BMXADOV1",55,0)
F S LINE=$E(STG,1,250),STG=$E(STG,251,999999) D I '$L(STG) Q ; PREVENTS DATA LENGTH FROM EXCEEDING 250 BYTES
"RTN","BMXADOV1",56,0)
. S TOT=TOT+1
"RTN","BMXADOV1",57,0)
. I '$L(STG) S LINE=LINE_$C(30),NUM=NUM+1 ; END OF RECORD, RECORD TOTAL IS UPDATED
"RTN","BMXADOV1",58,0)
. S @OUT@(TOT)=LINE ; NODE IS ADDED
"RTN","BMXADOV1",59,0)
. Q
"RTN","BMXADOV1",60,0)
Q
"RTN","BMXADOV1",61,0)
;
"RTN","BMXADOV1",62,0)
NUMIT(DA) ; EP-ITERATE BY NUMBER
"RTN","BMXADOV1",63,0)
N XIT,LDA
"RTN","BMXADOV1",64,0)
I IENS S DA=+IENS ; RE-ENTRY FROM SEED
"RTN","BMXADOV1",65,0)
I '$G(DA),$G(START) S DA=START-1
"RTN","BMXADOV1",66,0)
I '$G(DA) S DA=0
"RTN","BMXADOV1",67,0)
S LDA=""
"RTN","BMXADOV1",68,0)
F S DA=$O(@CREF@(DA)) D I $G(XIT) Q
"RTN","BMXADOV1",69,0)
. I 'DA S XIT=1,LDA="" Q ; NO MORE IENS - THE END OF THE LINE
"RTN","BMXADOV1",70,0)
. D DATA(IENS,DA,+$G(XCNT))
"RTN","BMXADOV1",71,0)
. I $G(STOP),$O(@CREF@(DA))>STOP S LDA="",XIT=1 Q ; AS FAR AS YOU ARE ALLOWED TO GO FOR NUMBER ITERATION
"RTN","BMXADOV1",72,0)
. I NUM=MAX S LDA=DA,XIT=1 Q ; REACHED THE MAX TRANSACTION LIMIT - GET MORE NEXT TIME
"RTN","BMXADOV1",73,0)
. Q
"RTN","BMXADOV1",74,0)
I LDA,'$O(@CREF@(LDA)) S LDA="" ; END OF THE LINE SO SET LDA TO NULL
"RTN","BMXADOV1",75,0)
Q LDA
"RTN","BMXADOV1",76,0)
;
"RTN","BMXADOV1",77,0)
LOOK(LIEN) ; EP-ITERATE BY A SINGLE STANDARD INDEX THAT IS A POINTER VALUE
"RTN","BMXADOV1",78,0)
N XIT,LDA
"RTN","BMXADOV1",79,0)
S DA=+IENS
"RTN","BMXADOV1",80,0)
F S DA=$O(@CREF@(IX,LIEN,DA)) D I $G(XIT) Q
"RTN","BMXADOV1",81,0)
. I 'DA S XIT=1,LDA="" Q ; NO MORE IENS - THE END OF THE LINE
"RTN","BMXADOV1",82,0)
. D DATA(IENS,DA,$G(XCNT))
"RTN","BMXADOV1",83,0)
. I NUM=MAX S LDA=DA,XIT=1 Q ; REACHED THE MAX TRANSACTION LIMIT - GET MORE NEXT TIME
"RTN","BMXADOV1",84,0)
. Q
"RTN","BMXADOV1",85,0)
I '$O(@CREF@(IX,LIEN,DA)) Q ""
"RTN","BMXADOV1",86,0)
Q LDA
"RTN","BMXADOV1",87,0)
;
"RTN","BMXADOV1",88,0)
LOOK1() ; EP-ITERATE USING A STANDARD INDEX
"RTN","BMXADOV1",89,0)
N XIT,LDA,VAL,DA,%
"RTN","BMXADOV1",90,0)
S DA=+IENS I 'DA G SCRATCH ; CHECK FOR RE-RENTRY
"RTN","BMXADOV1",91,0)
REENTER ; RE-ENTER STD ITERATION USING DA AS THE SEED
"RTN","BMXADOV1",92,0)
S %=$$IXVAL(FIEN,IX,DAS) I '$L(%) Q "" ; GET STARTUP INFO
"RTN","BMXADOV1",93,0)
LR S VAL=$P(%,B,3)
"RTN","BMXADOV1",94,0)
I VAL="" Q "" ; NO VAL FOUND FOR INITIAL ITERATION, SO QUIT
"RTN","BMXADOV1",95,0)
F S DA=$O(@CREF@(IX,VAL,DA)) Q:'DA D DATA(IENS,DA,+$G(XCNT)) I NUM=MAX S LDA=DA,XIT=1 Q ; SWEEP UP ALL THE REMAINING DAS UNDER THE CURRENT VALUE
"RTN","BMXADOV1",96,0)
I $G(XIT) Q:'$O(@CREF@(IX,VAL,LDA)) "" Q LDA ; IF NO MORE AFTER MAX, SET LDA = NULL
"RTN","BMXADOV1",97,0)
G LOOK1R ; SEED IS DEFINED
"RTN","BMXADOV1",98,0)
SCRATCH S VAL="" ; STD LOOKUP STARTING FROM SCRATCH
"RTN","BMXADOV1",99,0)
I $L(START) S VAL=$O(@CREF@(IX,START),-1) ; GET SEED FOR ITERATION
"RTN","BMXADOV1",100,0)
LOOK1R F S VAL=$O(@CREF@(IX,VAL)) D I $G(XIT) Q ; EP - RE-ENTRY POINT IF SEED IS DEFINED
"RTN","BMXADOV1",101,0)
. I VAL="" S LDA="",XIT=1 Q ; END OF THE LINE
"RTN","BMXADOV1",102,0)
. I STOP=+STOP,VAL=+VAL,VAL>STOP S LDA="",XIT=1 Q
"RTN","BMXADOV1",103,0)
. I $L(STOP),VAL]STOP S LDA="",XIT=1 Q ; LOOKUP LIMITS
"RTN","BMXADOV1",104,0)
. S DA=0
"RTN","BMXADOV1",105,0)
. F S DA=$O(@CREF@(IX,VAL,DA)) Q:'DA D I $G(XIT) Q
"RTN","BMXADOV1",106,0)
.. D DATA(IENS,DA,+$G(XCNT))
"RTN","BMXADOV1",107,0)
.. I NUM=MAX S LDA=DA,XIT=1 D ; TRANSACTION LIMIT ; CHECK FOR MORE
"RTN","BMXADOV1",108,0)
... I $O(@CREF@(IX,VAL,DA)) Q
"RTN","BMXADOV1",109,0)
... S %=$O(@CREF@(IX,VAL)) I %="" S LDA="" Q
"RTN","BMXADOV1",110,0)
... I $L(STOP),%]STOP S LDA="" Q
"RTN","BMXADOV1",111,0)
... I '$O(@CREF@(IX,%,0)) S LDA="" Q
"RTN","BMXADOV1",112,0)
... Q
"RTN","BMXADOV1",113,0)
.. Q
"RTN","BMXADOV1",114,0)
. Q
"RTN","BMXADOV1",115,0)
Q LDA
"RTN","BMXADOV1",116,0)
;
"RTN","BMXADOV1",117,0)
LOOK2(LFILE) ; EP-TEXT POINTER LOOKUP
"RTN","BMXADOV1",118,0)
; CHANGE THE GLOBAL REFERENCE FOR THE LOOKUP TO THE POINTED-TO FILE BEFORE PROCEEDING
"RTN","BMXADOV1",119,0)
N XIT,LDA,OREF,CREF,VAL,DA
"RTN","BMXADOV1",120,0)
S OREF=$$ROOT^DILFD(LFILE,IENS) I '$L(OREF) Q ""
"RTN","BMXADOV1",121,0)
S CREF=$$CREF^DILF(OREF) I '$L(CREF) Q ""
"RTN","BMXADOV1",122,0)
S DA=+IENS
"RTN","BMXADOV1",123,0)
I '$G(DA) G SCRATCH ; START FROM SCRATCH
"RTN","BMXADOV1",124,0)
S %=$$IXVAL(LFILE,IX,DAS) I '$L(%) Q ""
"RTN","BMXADOV1",125,0)
G LR ; RE-ENTER
"RTN","BMXADOV1",126,0)
;
"RTN","BMXADOV1",127,0)
IXVAL(FIEN,IX,DAS) ; GIVEN A FILE IEN, INDEX NAME, AND DAS STRING, RETURN THE VALUE USED IN THE INDEX
"RTN","BMXADOV1",128,0)
N DA,FLD,IENS,OREF,CREF,XREF,VAL,UP,LEV,L
"RTN","BMXADOV1",129,0)
I '$D(^DD(+$G(FIEN),0)) Q "" ; MISSING OR INVALID FILE NUMBER
"RTN","BMXADOV1",130,0)
I '$L($G(IX)) Q "" ; NO INDEX SPECIFIED
"RTN","BMXADOV1",131,0)
S UP=FIEN F LEV=1:1 S UP=$G(^DD(UP,0,"UP")) Q:'UP
"RTN","BMXADOV1",132,0)
I LEV'=$L(DAS,C) Q "" ; DAS LEVELS MUST MATCH FILE OR SUBFILE LEVEL
"RTN","BMXADOV1",133,0)
S IENS=$$IENS^BMXADOV($G(DAS)) I IENS=U Q ""
"RTN","BMXADOV1",134,0)
S OREF=$$ROOT^DILFD(FIEN,IENS) I '$L(OREF) Q ""
"RTN","BMXADOV1",135,0)
S CREF=$$CREF^DILF(OREF) I '$L(CREF) Q ""
"RTN","BMXADOV1",136,0)
I '$D(@CREF@(IX)) Q CREF_"||" ; NO INDEX VALUES TO CHECK
"RTN","BMXADOV1",137,0)
S XREF=OREF_IX_")"
"RTN","BMXADOV1",138,0)
S DA=+IENS I 'DA Q CREF_"||"
"RTN","BMXADOV1",139,0)
I '$D(@CREF@(DA)) Q CREF_"||" ; NO ENTRY EXISTS
"RTN","BMXADOV1",140,0)
I IX="AA" Q $$AA ; SMH v. 2.21
"RTN","BMXADOV1",141,0)
S FLD=+$$IXFLD^BMXADOV(FIEN,IX) I 'FLD Q "" ; INVALID DD
"RTN","BMXADOV1",142,0)
S VAL=$$GET1^DIQ(FIEN,IENS,FLD,"I") I VAL="" Q "" ; VALUE IS NULL - NOTHING TO INDEX
"RTN","BMXADOV1",143,0)
I '$D(@CREF@(IX,VAL,DA)) Q "" ; INVALID INDEX
"RTN","BMXADOV1",144,0)
Q XREF_B_DA_B_VAL
"RTN","BMXADOV1",145,0)
;
"RTN","BMXADOV1",146,0)
AA() ;EP - VISIT/V-FILE ITERATION USING THE 'AA' INDEX
"RTN","BMXADOV1",147,0)
N LDA,XIT,AAINFO,DA,%,X,Y,DFN,TYPE,ORD,ISTART,ISTOP,IDT,AAREF,%DT,DIC
"RTN","BMXADOV1",148,0)
S X=OREF_"""AA"")",%=$Q(@X) I %="" Q ""
"RTN","BMXADOV1",149,0)
S TYPE="" I $L(%,C)=5 S TYPE=$P(PARAM,B,2) I TYPE="" Q "" ; FOR CERTAIN V FILES, TYPE MUST BE DEFINED
"RTN","BMXADOV1",150,0)
I $E(TYPE)="`" S TYPE=$E(TYPE,2,99) I 'TYPE Q "" ; REMOVE ` FROM TYPE IEN
"RTN","BMXADOV1",151,0)
I $L(TYPE),'TYPE D I TYPE'>0 Q "" ; QUIT IF INVALID TYPE
"RTN","BMXADOV1",152,0)
. S %=$P($G(^DD(FIEN,.01,0)),U,2)
"RTN","BMXADOV1",153,0)
. S DIC=+$P(%,"P",2) I '$D(^DD(DIC,.01,0)) Q
"RTN","BMXADOV1",154,0)
. S X=TYPE,DIC(0)="M" D ^DIC I Y=-1 Q
"RTN","BMXADOV1",155,0)
. S TYPE=+Y
"RTN","BMXADOV1",156,0)
. Q
"RTN","BMXADOV1",157,0)
S DFN=+PARAM
"RTN","BMXADOV1",158,0)
I '$D(^DPT(DFN,0)) Q "" ; PATIENT DFN MUST BE DEFINED
"RTN","BMXADOV1",159,0)
I 'TYPE S AAREF=OREF_"""AA"","_DFN_")"
"RTN","BMXADOV1",160,0)
E S AAREF=OREF_"""AA"","_DFN_","_TYPE_")"
"RTN","BMXADOV1",161,0)
I '$D(@AAREF) Q "" ; IF NOTHING UNDER AA INDEX, DON'T BOTHER LOOKING
"RTN","BMXADOV1",162,0)
S ISTART=9999999 I START S X=START,%DT="P" D ^%DT S ISTART=9999999-Y
"RTN","BMXADOV1",163,0)
S ISTOP=0 I STOP S X=STOP,%DT="P" D ^%DT S ISTOP=9999999-Y
"RTN","BMXADOV1",164,0)
S ORD=-1 I $P(PARAM,B,$L(PARAM,B))="R" S ORD=1 ; SORT IN CHRONOLOGICAL OR REVERSE CHRONOLOGICAL ORDER
"RTN","BMXADOV1",165,0)
I ORD=-1 S X=$G(ISTART),Y=$G(ISTOP),ISTOP=X,ISTART=Y ; CHANGES REQUIRED TO PRESENT DATA IN CHRONOLIGICAL ORDER
"RTN","BMXADOV1",166,0)
S IDT=0,LDA=""
"RTN","BMXADOV1",167,0)
I ISTOP S IDT=ISTOP-.0000001
"RTN","BMXADOV1",168,0)
S DA=+IENS
"RTN","BMXADOV1",169,0)
I DA S IDT=$$AAR I 'IDT Q LDA ; SWEEP UP REMAINING IENS FOR CURRENT IDT AND RESET IDT FOR RE-ENTRY
"RTN","BMXADOV1",170,0)
F S IDT=$O(@AAREF@(IDT),ORD) Q:'IDT D I $G(XIT) Q
"RTN","BMXADOV1",171,0)
. I ORD=1,IDT>ISTART S LDA="",XIT=1 Q
"RTN","BMXADOV1",172,0)
. I ORD=-1,IDT<ISTART S LDA="",XIT=1 Q
"RTN","BMXADOV1",173,0)
. S DA=0
"RTN","BMXADOV1",174,0)
. F S DA=$O(@AAREF@(IDT,DA)) Q:'DA D I $G(XIT) Q
"RTN","BMXADOV1",175,0)
.. D DATA(IENS,DA,+$G(XCNT))
"RTN","BMXADOV1",176,0)
.. I NUM=MAX S LDA=DA,XIT=1 I '$$AAMORE S LDA="" ; TRANSACTION LIMIT
"RTN","BMXADOV1",177,0)
.. Q
"RTN","BMXADOV1",178,0)
. Q
"RTN","BMXADOV1",179,0)
Q LDA
"RTN","BMXADOV1",180,0)
;
"RTN","BMXADOV1",181,0)
AAR() ; SWEEP UP REMAINING IENS FOR CURRENT IDT AND RESET IDT FOR RE-ENTRY
"RTN","BMXADOV1",182,0)
N %,X,Y,XIT
"RTN","BMXADOV1",183,0)
S %=$$AAVAL(FIEN,DAS) I '$L(%) Q ""
"RTN","BMXADOV1",184,0)
S IDT=$P(%,B,5) I 'IDT Q ""
"RTN","BMXADOV1",185,0)
F S DA=$O(@AAREF@(IDT,DA)) Q:'DA D I $G(XIT) Q
"RTN","BMXADOV1",186,0)
. D DATA(IENS,DA,+$G(XCNT))
"RTN","BMXADOV1",187,0)
. I NUM=MAX S LDA=DA,IDT="",XIT="" I '$$AAMORE S LDA=""
"RTN","BMXADOV1",188,0)
. Q
"RTN","BMXADOV1",189,0)
Q IDT
"RTN","BMXADOV1",190,0)
;
"RTN","BMXADOV1",191,0)
AAMORE() ; RETURN A '1' IF MORE ITERATION IS POSSIBLE
"RTN","BMXADOV1",192,0)
N X
"RTN","BMXADOV1",193,0)
I $O(@AAREF@(IDT,DA)) Q 1
"RTN","BMXADOV1",194,0)
S X=$O(@AAREF@(IDT),ORD) I 'X Q 0
"RTN","BMXADOV1",195,0)
I $O(@AAREF@(X,0)) Q 1
"RTN","BMXADOV1",196,0)
Q 0
"RTN","BMXADOV1",197,0)
;
"RTN","BMXADOV1",198,0)
AAVAL(FIEN,DAS) ; GIVEN A FILE AND DAS, RETURN INFO NECESSARY TO RE-CREATE THE 'AA' INDEX
"RTN","BMXADOV1",199,0)
N DATE,IDT,DFN,TYPE,VIEN,%,OREF,CREF,DA,IENS
"RTN","BMXADOV1",200,0)
I '$D(^DD(FIEN,.01,0)) Q ""
"RTN","BMXADOV1",201,0)
S IENS=$$IENS^BMXADOV($G(DAS)) I IENS=U Q ""
"RTN","BMXADOV1",202,0)
S OREF=$$ROOT^DILFD(FIEN,IENS) I '$L(OREF) Q ""
"RTN","BMXADOV1",203,0)
S CREF=$$CREF^DILF(OREF) I '$L(CREF) Q ""
"RTN","BMXADOV1",204,0)
S DA=+IENS I '$D(@CREF@(DA)) Q ""
"RTN","BMXADOV1",205,0)
I FIEN=9000010 S DFN=$P(@CREF@(DA,0),U,5),VIEN=DA
"RTN","BMXADOV1",206,0)
E S DFN=$P(@CREF@(DA,0),U,2),VIEN=$P(@CREF@(DA,0),U,3)
"RTN","BMXADOV1",207,0)
I $D(^DPT(DFN,0)),$D(^AUPNVSIT(VIEN,0))
"RTN","BMXADOV1",208,0)
E Q ""
"RTN","BMXADOV1",209,0)
S DATE=+$P($G(^AUPNVSIT(VIEN,0)),U) I 'DATE Q ""
"RTN","BMXADOV1",210,0)
S IDT=(9999999-(DATE\1))
"RTN","BMXADOV1",211,0)
S %=$P(DATE,".",2) I % S IDT=+(IDT_"."_%) I 'IDT Q ""
"RTN","BMXADOV1",212,0)
S X=OREF_"""AA"")",%=$Q(@X) I %="" Q ""
"RTN","BMXADOV1",213,0)
S TYPE="" I $L(%,C)=5 S TYPE=$P(@CREF@(DA,0),U)
"RTN","BMXADOV1",214,0)
Q X_B_DA_B_DFN_B_TYPE_B_IDT
"RTN","BMXADOV1",215,0)
;
"RTN","BMXADOV1",216,0)
AAP() ;EP - ITERATOR FOR PROBLEM FILE: AA INDEX
"RTN","BMXADOV1",217,0)
I '$D(^AUPNPROB("AA",+$G(START))) Q ""
"RTN","BMXADOV1",218,0)
N LOC,PNUM,DFN,IEN
"RTN","BMXADOV1",219,0)
S LOC=0,DFN=START
"RTN","BMXADOV1",220,0)
F S LOC=$O(^AUPNPROB("AA",DFN,LOC)) Q:'LOC D
"RTN","BMXADOV1",221,0)
. S PNUM=""
"RTN","BMXADOV1",222,0)
. F S PNUM=$O(^AUPNPROB("AA",DFN,LOC,PNUM)) Q:PNUM="" D
"RTN","BMXADOV1",223,0)
.. S IEN=0
"RTN","BMXADOV1",224,0)
.. F S IEN=$O(^AUPNPROB("AA",DFN,LOC,PNUM,IEN)) Q:'IEN D DATA(",",IEN,+$G(XCNT))
"RTN","BMXADOV1",225,0)
.. Q
"RTN","BMXADOV1",226,0)
.Q
"RTN","BMXADOV1",227,0)
Q ""
"RTN","BMXADOV1",228,0)
;
"RTN","BMXADOV1",229,0)
TESTID(DA) ; TEST IDENTIFIERS
"RTN","BMXADOV1",230,0)
N %,Y,SEX
"RTN","BMXADOV1",231,0)
S %=$G(^DIZ(2160010,+$G(DA),0)) I '$L(%) Q ""
"RTN","BMXADOV1",232,0)
S SEX=$P(%,U,2) I '$L(SEX) S SEX="??"
"RTN","BMXADOV1",233,0)
S Y=$P(%,U,3) X ^DD("DD")
"RTN","BMXADOV1",234,0)
Q (SEX_" "_Y)
"RTN","BMXADOV1",235,0)
;
"RTN","BMXADOV2")
0^72^B19908593
"RTN","BMXADOV2",1,0)
BMXADOV2 ; IHS/CIHA/GIS - RPC CALL: GENERATE DATA FOR AN ADO DATASET ;
"RTN","BMXADOV2",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXADOV2",3,0)
; CUSTOM ITERATORS FOR RPMS
"RTN","BMXADOV2",4,0)
;
"RTN","BMXADOV2",5,0)
;
"RTN","BMXADOV2",6,0)
;
"RTN","BMXADOV2",7,0)
MEDICARE(PARAM,IENS,MAX,OUT,TOT) ;
"RTN","BMXADOV2",8,0)
; NO PARAM REQUIRED BUT SINCE THIS IS A SUBFILE, THE PATIENT IEN MUST BE IH IENS
"RTN","BMXADOV2",9,0)
; FETCHES THE MOST RECENT MEDICARE RECORD FOR THE PATIENT
"RTN","BMXADOV2",10,0)
N DFN,DA,X,Y,%,LIM,DATE,MAX
"RTN","BMXADOV2",11,0)
S LIM=DT-10000,DA=0,DATE=0,MAX=0
"RTN","BMXADOV2",12,0)
S DFN=$P(IENS,C,2) I 'DFN Q ""
"RTN","BMXADOV2",13,0)
F S DA=$O(^AUPNMCR(DFN,11,DA)) Q:'DA D
"RTN","BMXADOV2",14,0)
. S X=$G(^AUPNMCR(DFN,11,DA,0))
"RTN","BMXADOV2",15,0)
. I +X>DATE S DATE=+X,MAX=DA
"RTN","BMXADOV2",16,0)
. Q
"RTN","BMXADOV2",17,0)
I 'MAX Q ""
"RTN","BMXADOV2",18,0)
S DA=MAX
"RTN","BMXADOV2",19,0)
D DATA^BMXADOV1(IENS,DA)
"RTN","BMXADOV2",20,0)
Q ""
"RTN","BMXADOV2",21,0)
;
"RTN","BMXADOV2",22,0)
MCDIEN(DFN) ; EP-GIVEN A PATIENT IEN, RETRUN THE IEN OF THAT PT'S MOST RECENT RECORD IN MEDICAID ELIGIBILITY FILE
"RTN","BMXADOV2",23,0)
N MIEN,DA,DATE,MAX,X
"RTN","BMXADOV2",24,0)
S DFN=+$G(DFN),MAX="",DATE=0
"RTN","BMXADOV2",25,0)
S MIEN=0 F S MIEN=$O(^AUPNMCD("B",DFN,MIEN)) Q:'MIEN D
"RTN","BMXADOV2",26,0)
. S DA=0 F S DA=$O(^AUPNMCD(MIEN,11,DA)) Q:'DA D
"RTN","BMXADOV2",27,0)
.. S X=+$P($G(^AUPNMCD(MIEN,11,DA,0)),U,2)
"RTN","BMXADOV2",28,0)
.. I X>DATE S DATE=X,MAX=MIEN
"RTN","BMXADOV2",29,0)
.. Q
"RTN","BMXADOV2",30,0)
. Q
"RTN","BMXADOV2",31,0)
Q MAX
"RTN","BMXADOV2",32,0)
;
"RTN","BMXADOV2",33,0)
MEDICAID(PARAM,IENS,MAX,OUT,TOT) ;
"RTN","BMXADOV2",34,0)
; NO PARAM REQUIRED BUT SINCE THIS IS A SUBFILE, THE PATIENT IEN MUST BE IH IENS
"RTN","BMXADOV2",35,0)
; FETCHES THE MOST RECENT MEDICARE RECORD FOR THE PATIENT
"RTN","BMXADOV2",36,0)
N MIEN,DA,X,Y,%,LIM,DATE,MAX
"RTN","BMXADOV2",37,0)
S LIM=DT-10000,DA=0,DATE=0,MAX=0
"RTN","BMXADOV2",38,0)
S MIEN=$P(IENS,C,2) I 'MIEN Q ""
"RTN","BMXADOV2",39,0)
F S DA=$O(^AUPNMCD(MIEN,11,DA)) Q:'DA D
"RTN","BMXADOV2",40,0)
. S X=$G(^AUPNMCD(MIEN,11,DA,0))
"RTN","BMXADOV2",41,0)
. I +X>DATE S DATE=+X,MAX=DA
"RTN","BMXADOV2",42,0)
. Q
"RTN","BMXADOV2",43,0)
I 'MAX Q ""
"RTN","BMXADOV2",44,0)
S DA=MAX
"RTN","BMXADOV2",45,0)
D DATA^BMXADOV1(IENS,DA)
"RTN","BMXADOV2",46,0)
Q ""
"RTN","BMXADOV2",47,0)
;
"RTN","BMXADOV2",48,0)
PT(VAL,IENS,MAX,OUT,TOT) ; EP - PATIENT LOOKUP ; GIVEN A LOOKUP VALUE, GENERATE A LIST OF PATIENTS
"RTN","BMXADOV2",49,0)
N DFN,BMXNOID,DA,X,Y,%,LIM,FILE,NUM,IXS,GBL,CNT,SS
"RTN","BMXADOV2",50,0)
I $G(VAL)="" Q ""
"RTN","BMXADOV2",51,0)
S BMXNOID=1
"RTN","BMXADOV2",52,0)
I '$G(MAX) S MAX=999
"RTN","BMXADOV2",53,0)
I $G(^DD("2","0","ID","IHS0"))="D ^AUPNLKID" S ^("IHS0")="D:'$G(BMXNOID) ^AUPNLKID" ; MUST BE A SILENT CALL
"RTN","BMXADOV2",54,0)
S SS="BMX DFN2",GBL=$NA(^TMP(SS,$J)) K @GBL
"RTN","BMXADOV2",55,0)
S CNT=0,DFN=0
"RTN","BMXADOV2",56,0)
F S DFN=$O(^AUPNPAT("D",VAL,DFN)) Q:'DFN S CNT=CNT+1 S @GBL@("DILIST",2,CNT)=DFN ; FIRST, TRY TO MATCH CHART NUMBER
"RTN","BMXADOV2",57,0)
I CNT G PTIT
"RTN","BMXADOV2",58,0)
I VAL?3N1"-"2N1"-"4N S VAL=$TR(VAL,"-","") ; TRANSFORM SSN
"RTN","BMXADOV2",59,0)
I VAL?9N G PT1
"RTN","BMXADOV2",60,0)
S %=$L(VAL),X=$E(VAL,%-1,%)
"RTN","BMXADOV2",61,0)
I X?2N S X=VAL,%DT="P" D ^%DT S VAL=Y ; TRANSFORM DATE TO INTERNAL VALUE
"RTN","BMXADOV2",62,0)
PT1 K @GBL S SS="BMX DFN1",GBL=$NA(^TMP(SS,$J)) K @GBL
"RTN","BMXADOV2",63,0)
D FIND^DIC(2,"","","",VAL,999,"B^ADOB^SSN","","",GBL,"")
"RTN","BMXADOV2",64,0)
I '$D(^TMP(SS,$J,"DILIST",2)) Q "" ; UNSUCCESSFUL LOOKUP
"RTN","BMXADOV2",65,0)
PTIT ; ITERATE
"RTN","BMXADOV2",66,0)
S CNT=0,NUM=0
"RTN","BMXADOV2",67,0)
F S CNT=$O(^TMP(SS,$J,"DILIST",2,CNT)) Q:'CNT S DA=^(CNT) I DA D DATA^BMXADOV1(IENS,DA)
"RTN","BMXADOV2",68,0)
I $G(^DD("2","0","ID","IHS0"))="D:'$G(BMXNOID) ^AUPNLKID" S ^("IHS0")="D ^AUPNLKID" ; RESTORE DD NODE
"RTN","BMXADOV2",69,0)
; K @GBL ; CLEANUP
"RTN","BMXADOV2",70,0)
Q ""
"RTN","BMXADOV2",71,0)
;
"RTN","BMXADOV2",72,0)
HRN(DFN) ; EP - GIVEN A PATIENT DFN, RETURN THE LOCAL CHART NUMBER
"RTN","BMXADOV2",73,0)
Q $P($G(^AUPNPAT(+$G(DFN),41,+$G(DUZ(2)),0)),U,2)
"RTN","BMXADOV2",74,0)
;
"RTN","BMXADOV2",75,0)
PVTINS ;
"RTN","BMXADOV2",76,0)
; NO PARAM REQUIRED BUT SINCE THIS IS A SUBFILE, THE PATIENT IEN MUST BE IH IENS
"RTN","BMXADOV2",77,0)
N DFN,DA,X,Y,%,LIM
"RTN","BMXADOV2",78,0)
S LIM=DT-10000,DA=0
"RTN","BMXADOV2",79,0)
S DFN=$P(IENS,C,2) I 'DFN Q ""
"RTN","BMXADOV2",80,0)
F S DA=$O(^AUPNPRVT(DFN,11,DA)) Q:'DA D
"RTN","BMXADOV2",81,0)
. S X=$G(^AUPNPRVT(DFN,11,DA,0))
"RTN","BMXADOV2",82,0)
. I '$L(X) Q
"RTN","BMXADOV2",83,0)
. S %=$P(X,U,7)
"RTN","BMXADOV2",84,0)
. I '%!(%>LIM) D DATA^BMXADOV1(IENS,DA)
"RTN","BMXADOV2",85,0)
. Q
"RTN","BMXADOV2",86,0)
Q ""
"RTN","BMXADOV2",87,0)
;
"RTN","BMXADOV2",88,0)
DUPV(PARAM,IENS,MAX,OUT,TOT) ; EP - DUPLICATE VISIT ITERATION
"RTN","BMXADOV2",89,0)
; PARAM: 'DFN|VISIT TIMESTAMP|TYPE|LOCATION|CATEGORY
"RTN","BMXADOV2",90,0)
; PATIENT DFN AND VISIT TIMESTAMP (EXTERNAL DATE FORMAT) MUST EXIST.
"RTN","BMXADOV2",91,0)
; THE OTHER 3 DUP PARAMETERS WILL BE CHECKED ONLY IF THEY ARE DEFINED.
"RTN","BMXADOV2",92,0)
; ALL DUPS ARE RETURNED. MAX,START,STOP ARE IGNORED
"RTN","BMXADOV2",93,0)
N DFN,TIME,TYPE,LOC,CAT,IDT,VIEN,DAY,X,PATIENT,Y,%DT,FMTIME,DA,IENS
"RTN","BMXADOV2",94,0)
S DFN=+PARAM,TIME=$P(PARAM,B,2),TYPE=$P(PARAM,B,3),LOC=$P(PARAM,B,4),CAT=$P(PARAM,B,5)
"RTN","BMXADOV2",95,0)
I $D(^DPT(+$G(DFN),0)),$L($G(TIME))
"RTN","BMXADOV2",96,0)
E Q ""
"RTN","BMXADOV2",97,0)
S X=TIME,%DT="T" D ^%DT I Y=-1 Q
"RTN","BMXADOV2",98,0)
S FMTIME=Y
"RTN","BMXADOV2",99,0)
S (IDT,DAY)=9999999-(FMTIME\1),IDT=IDT-.0000001
"RTN","BMXADOV2",100,0)
F S IDT=$O(^AUPNVSIT("AA",DFN,IDT)) Q:$E(IDT,1,7)'=DAY S VIEN=999999999999 F S VIEN=$O(^AUPNVSIT("AA",DFN,IDT,VIEN),-1) Q:'VIEN D
"RTN","BMXADOV2",101,0)
. S X=$G(^AUPNVSIT(VIEN,0)) I '$L(X) Q ; VISIT DATA MUST EXIT
"RTN","BMXADOV2",102,0)
. I $P(X,U,11) Q ; MUST BE AN 'ACTIVE' VISIT - NOT 'DELETED'
"RTN","BMXADOV2",103,0)
. I $L(TYPE),TYPE'=$P(X,U,3) Q
"RTN","BMXADOV2",104,0)
. I $L(LOC),LOC'=$P(X,U,6) Q
"RTN","BMXADOV2",105,0)
. I $L(CAT),CAT'=$P(X,U,7) Q
"RTN","BMXADOV2",106,0)
. S DA=VIEN,IENS=DA_C
"RTN","BMXADOV2",107,0)
. D DATA^BMXADOV1(IENS,DA)
"RTN","BMXADOV2",108,0)
. Q
"RTN","BMXADOV2",109,0)
Q ""
"RTN","BMXADOV2",110,0)
;
"RTN","BMXADOV2",111,0)
DAIT(DSTG,IENS,MAX,OUT,TOT) ; EP - SET OF IENS ITERATION.
"RTN","BMXADOV2",112,0)
; THE DSTG CONTAINS A "|" SET OF DAS STRINGS
"RTN","BMXADOV2",113,0)
; ALL VALUES ARE RETURNED. MAX IS NOT CHECKED. START AND STOP ARE IRRELEVANT
"RTN","BMXADOV2",114,0)
N PCE,DA,XIT,IENS,L,DAS
"RTN","BMXADOV2",115,0)
S L=$L(DSTG,B)
"RTN","BMXADOV2",116,0)
F PCE=1:1:L S DAS=$P(DSTG,B,PCE) D I $G(XIT) Q
"RTN","BMXADOV2",117,0)
. I 'DAS S XIT=1 Q ; NO MORE IENS - THE END OF THE LINE
"RTN","BMXADOV2",118,0)
. I DAS'[C S IENS=DAS_C
"RTN","BMXADOV2",119,0)
. E S IENS=$$IENS^BMXADOV(DAS)
"RTN","BMXADOV2",120,0)
. S DA=+IENS
"RTN","BMXADOV2",121,0)
. D DATA^BMXADOV1(IENS,DA)
"RTN","BMXADOV2",122,0)
. Q
"RTN","BMXADOV2",123,0)
Q ""
"RTN","BMXADOV2",124,0)
;
"RTN","BMXADOV2",125,0)
APRV(PARAM,IENS,MAX,OUT,TOT) ; EP - RETURN A LIST OF ALL ACTIVE PROVIDERS
"RTN","BMXADOV2",126,0)
; ALL VALUES ARE RETURNED. MAX IS NOT CHECKED. START AND STOP ARE IRRELEVANT
"RTN","BMXADOV2",127,0)
N NAME,DA,STG
"RTN","BMXADOV2",128,0)
S NAME=""
"RTN","BMXADOV2",129,0)
F S NAME=$O(^VA(200,"B",NAME)) Q:NAME="" D
"RTN","BMXADOV2",130,0)
. S DA=0
"RTN","BMXADOV2",131,0)
. F S DA=$O(^VA(200,"B",NAME,DA)) Q:'DA D
"RTN","BMXADOV2",132,0)
.. I $P($G(^VA(200,DA,"PS")),U,4) Q ; CHECK INACTIVE DATE FIELD
"RTN","BMXADOV2",133,0)
.. D DATA^BMXADOV1(IENS,DA)
"RTN","BMXADOV2",134,0)
.. Q
"RTN","BMXADOV2",135,0)
. Q
"RTN","BMXADOV2",136,0)
Q ""
"RTN","BMXADOV2",137,0)
;
"RTN","BMXADOVJ")
0^73^B8677686
"RTN","BMXADOVJ",1,0)
BMXADOVJ ; IHS/CIHA/GIS - RPC CALL: GENERATE DATA FOR AN ADO DATASET ;
"RTN","BMXADOVJ",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXADOVJ",3,0)
; THIS ROUTINE MANAGES THE JOINS
"RTN","BMXADOVJ",4,0)
;
"RTN","BMXADOVJ",5,0)
;
"RTN","BMXADOVJ",6,0)
;
"RTN","BMXADOVJ",7,0)
; THE FIFTH PARAMETER OF SS^BMXADO CONTAINS THE JOIN INSTRUCTIONS
"RTN","BMXADOVJ",8,0)
; SYNTAX: DESCENDANT SCHEMA IEN (DETAILS FILE), JOIN FIELD FROM MASTER FILE
"RTN","BMXADOVJ",9,0)
; THE FIRST "," PIECE STATES THAT THE MASTER FILE IS JOINED BY ITS .02 FIELD TO THE DETAILS FILE
"RTN","BMXADOVJ",10,0)
; THE SECOND "," PIECE STARTES THAT THE DETAILS FILE IS DEFINED BY SCHEMA #6
"RTN","BMXADOVJ",11,0)
; AN OPTIONAL 3RD "," PIECE MAY CONTAIN A SECONDARY VSTG TO MORE PRECISELY DEFINE JOIN ITERATION
"RTN","BMXADOVJ",12,0)
; E.G., "...~6.,.02,AA~1/1/2004~2/1/2004~~~~~|WT|R"
"RTN","BMXADOVJ",13,0)
; IN THIS CASE, THE SECONDARY VSTG SPECIFIES THAT THE AA INDEX BE USED TO CONTROL THE ITERATOR
"RTN","BMXADOVJ",14,0)
; THE START AND STOP DATES ARE IN EFFECT BUT MAX IS IGNORED/IRRELEVANT
"RTN","BMXADOVJ",15,0)
; THE 1ST "|" PIECE OF THE PARAM SECTION WILL BE AUTOMATICALLY STUFFED WITH PATEINT DFN(S) DURING ITERATION
"RTN","BMXADOVJ",16,0)
; IF MULTIPLE JOINS ARE REQUESTED, THEY ARE SPARATED BY THE '@JOIN@' DELIMTER
"RTN","BMXADOVJ",17,0)
; "E.G., 6,.02@JOIN@1,.03@JOIN@2,.02@JOIN@9,SUB"
"RTN","BMXADOVJ",18,0)
; IN THIS EXAPLE THE MASTER FILE IS JOIND TO THE DETAILS FILES ASSOCIATED WITH SCHEMAS 6, 1, AND 9
"RTN","BMXADOVJ",19,0)
; NOTE THAT THE 3RD JOIN DEINED IN THE STRING SPECIFIES A SUBFILE REALTION RATHER THAN A "POINTER" RELATION
"RTN","BMXADOVJ",20,0)
; IF A SECOND RECORD SET IS CREATED TO FULFILL A JOIN REQUEST, IT WILL ONLY CONTAIN THE ROWS NECESSARY TO COMPLETE THE JOIN
"RTN","BMXADOVJ",21,0)
;
"RTN","BMXADOVJ",22,0)
JOIN(SMASTER,JSTG) ;EP - APPEND ADDITIONAL ANRS TO FULFILL JOIN REQUESTS
"RTN","BMXADOVJ",23,0)
N TMP,JOIN,JINST,FMASTER
"RTN","BMXADOVJ",24,0)
I '$L($G(JSTG)) Q ; JOIN STRING MUST NOT BE NULL
"RTN","BMXADOVJ",25,0)
S FMASTER=$P($G(^BMXADO(+$G(SMASTER),0)),U,2) I 'FMASTER Q ; MASTER SCHEMA & FILE MUST EXIST
"RTN","BMXADOVJ",26,0)
S TMP=$NA(^TMP("BMX JOIN",$J)) K @TMP ; JOIN INFO TEMP STORAGE ARRAY
"RTN","BMXADOVJ",27,0)
S @TMP@(0,SMASTER)=$$RANGE ; GET DATA NODE RANGE FOR THE MASTER ANR
"RTN","BMXADOVJ",28,0)
I '$D(@TMP@(0)) Q ; DATA MUST EXIST IN THE MASTER FILE OR QUIT
"RTN","BMXADOVJ",29,0)
F JOIN=1:1 S JINST=$P(JSTG,"@JOIN@",JOIN) Q:JINST="" D J(SMASTER,JINST) ; MAIN LOOP FOR DOING JOINS
"RTN","BMXADOVJ",30,0)
K @TMP
"RTN","BMXADOVJ",31,0)
Q
"RTN","BMXADOVJ",32,0)
;
"RTN","BMXADOVJ",33,0)
RANGE() ; GET DATA NODE RANGE FOR LAST SCHEMA ENTERED
"RTN","BMXADOVJ",34,0)
N X,FIRST,LAST,Y
"RTN","BMXADOVJ",35,0)
S (X,LAST)=$O(@OUT@(999999999),-1)
"RTN","BMXADOVJ",36,0)
F S X=$O(@OUT@(X),-1) Q:'X S Y=@OUT@(X) Q:Y'[$C(30) S FIRST=X
"RTN","BMXADOVJ",37,0)
I '$G(FIRST) Q ""
"RTN","BMXADOVJ",38,0)
S FIRST=FIRST+1
"RTN","BMXADOVJ",39,0)
Q (FIRST_U_LAST)
"RTN","BMXADOVJ",40,0)
;
"RTN","BMXADOVJ",41,0)
J(SMASTER,JSTG) ; JOIN DETAILS FILE TO MASTER FILE
"RTN","BMXADOVJ",42,0)
; SMASTER=MASTER SCHMA IEN, SDETAIL=DETAILS SCHEMA IEN
"RTN","BMXADOVJ",43,0)
N JARR,SEC,ERR,JIEN,SUB,IX,PARENT,JFLD,DFLD,NODE,X,STOP,VSTG2,SDETAIL,JFLD
"RTN","BMXADOVJ",44,0)
S SDETAIL=$P(JSTG,C),JFLD=$P(JSTG,C,2),DFLD=$P(JSTG,C,3),VSTG2=$P(JSTG,C,4,999)
"RTN","BMXADOVJ",45,0)
I JFLD="SUB" S JFLD=.001,DFLD=.0001
"RTN","BMXADOVJ",46,0)
I JFLD=.001,DFLD=.0001 S SUB=1,VSTG2="~~~~~SIT~BMXADOVJ~" ; MAKE SUBFILE ITERATOR VSTG
"RTN","BMXADOVJ",47,0)
D IEN(SMASTER,SDETAIL,JFLD) ; GET A LIST OF JOIN IENS FROM THE MASTER FILE
"RTN","BMXADOVJ",48,0)
I '$D(@TMP@(1)) Q ; NO MASTER FILE IENS FOR JOINS, SO QUIT
"RTN","BMXADOVJ",49,0)
N FIEN,DAS,SIEN,VSTG,JSTG
"RTN","BMXADOVJ",50,0)
S DAS="",SIEN=SDETAIL,VSTG=VSTG2
"RTN","BMXADOVJ",51,0)
S FIEN=$P($G(^BMXADO(SIEN,0)),U,2) I 'FIEN Q
"RTN","BMXADOVJ",52,0)
D JEP^BMXADO ; BUILD THE JOIN ANR
"RTN","BMXADOVJ",53,0)
Q
"RTN","BMXADOVJ",54,0)
;
"RTN","BMXADOVJ",55,0)
IEN(SMASTER,SDETAIL,JFLD) ; GET THE MASTER FILE IENS FOR BUILDING THE JOIN DATA SET
"RTN","BMXADOVJ",56,0)
N FIEN,%,FIRST,LAST,NODE,DA,IEN
"RTN","BMXADOVJ",57,0)
I JFLD["IEN" S JFLD=+JFLD
"RTN","BMXADOVJ",58,0)
S FIEN=$P($G(^BMXADO(SMASTER,0)),U,2) I 'FIEN Q
"RTN","BMXADOVJ",59,0)
S %=$G(@TMP@(0,SMASTER)) I '$L(%) Q
"RTN","BMXADOVJ",60,0)
S FIRST=+%,LAST=$P(%,U,2),NODE=FIRST-.1
"RTN","BMXADOVJ",61,0)
F S NODE=$O(@OUT@(NODE)) Q:'NODE Q:NODE>LAST D
"RTN","BMXADOVJ",62,0)
. S DA=+@OUT@(NODE)
"RTN","BMXADOVJ",63,0)
. I 'DA Q
"RTN","BMXADOVJ",64,0)
. I JFLD=.001 S @TMP@(1,SDETAIL,DA)="" Q
"RTN","BMXADOVJ",65,0)
. S IEN=$$GET1^DIQ(FIEN,(DA_C),JFLD,"I") I 'IEN Q
"RTN","BMXADOVJ",66,0)
. S @TMP@(1,SDETAIL,IEN)=""
"RTN","BMXADOVJ",67,0)
. Q
"RTN","BMXADOVJ",68,0)
Q
"RTN","BMXADOVJ",69,0)
;
"RTN","BMXADOVJ",70,0)
JFLD ; EP-STUFF JOIN FIELD IDS INTO THE INTRO SEGMENT OF THE SCHEMA
"RTN","BMXADOVJ",71,0)
N NODE,%
"RTN","BMXADOVJ",72,0)
S NODE=999999999999
"RTN","BMXADOVJ",73,0)
F S NODE=$O(@OUT@(NODE),-1) Q:'NODE I ^(NODE)["@@@meta@@@" Q
"RTN","BMXADOVJ",74,0)
I 'NODE Q
"RTN","BMXADOVJ",75,0)
S %=$P(@OUT@(NODE),U),$P(%,"|",4)=$G(JFLD),$P(%,"|",5)=$G(DFLD)
"RTN","BMXADOVJ",76,0)
S @OUT@(NODE)=%_U
"RTN","BMXADOVJ",77,0)
Q
"RTN","BMXADOVJ",78,0)
;
"RTN","BMXADOX")
0^74^B208011638
"RTN","BMXADOX",1,0)
BMXADOX ; IHS/CIHA/GIS - RPC CALL: GENERATE AN ADO SCHEMA STRING AND DATA SET ;
"RTN","BMXADOX",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXADOX",3,0)
; EXMAPLES OF RPMS SCHEMAE GENERATION
"RTN","BMXADOX",4,0)
;
"RTN","BMXADOX",5,0)
;
"RTN","BMXADOX",6,0)
DISP(OUT) ;EP - TEMP DISPLAY
"RTN","BMXADOX",7,0)
N I,X
"RTN","BMXADOX",8,0)
S I=0 W !
"RTN","BMXADOX",9,0)
F S I=$O(@OUT@(I)) Q:'I S X=@OUT@(I) S X=$TR(X,$C(30),"}") S X=$TR(X,$C(31),"{") W !,X
"RTN","BMXADOX",10,0)
Q
"RTN","BMXADOX",11,0)
;
"RTN","BMXADOX",12,0)
SCHEMA(NAME) ; GIVEN SCHEMA NAME, RETURN THE IEN
"RTN","BMXADOX",13,0)
N IEN
"RTN","BMXADOX",14,0)
S IEN=$O(^BMXADO("B",NAME,0))
"RTN","BMXADOX",15,0)
Q IEN
"RTN","BMXADOX",16,0)
;
"RTN","BMXADOX",17,0)
NEXTNUM(DFN,LOC) ; RETURN THE NEXT PROBLEM NUMBER FOR A PATIENT
"RTN","BMXADOX",18,0)
N X,LAST,MAX,NUM
"RTN","BMXADOX",19,0)
S NUM=0,MAX=""
"RTN","BMXADOX",20,0)
F S NUM=$O(^AUPNPROB("AA",DFN,LOC,NUM)) Q:NUM="" S X=$E(NUM,2,99) I +X>MAX S MAX=+X
"RTN","BMXADOX",21,0)
I 'MAX Q 1
"RTN","BMXADOX",22,0)
S X=X+1 S X=X\1
"RTN","BMXADOX",23,0)
Q X
"RTN","BMXADOX",24,0)
;
"RTN","BMXADOX",25,0)
DEMOG ; VIEW DEMOGRAPHICS
"RTN","BMXADOX",26,0)
N OUT,%,DFN,MAX,SIEN
"RTN","BMXADOX",27,0)
S DFN=1,MAX=1000
"RTN","BMXADOX",28,0)
S SIEN=$$SCHEMA("UPDATE PATIENT DEMOGRAPHICS")
"RTN","BMXADOX",29,0)
D SS^BMXADO(.OUT,SIEN,"",("~"_DFN_"~"_DFN_"~"_MAX))
"RTN","BMXADOX",30,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",31,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",32,0)
Q
"RTN","BMXADOX",33,0)
;
"RTN","BMXADOX",34,0)
MEDICARE ; UPDATE MEDICARE DATES/INFO
"RTN","BMXADOX",35,0)
N OUT,%,DAS,PIEN,JIEN,DFN,MAX
"RTN","BMXADOX",36,0)
S DFN=1,MAX=1000
"RTN","BMXADOX",37,0)
S DAS=DFN_","
"RTN","BMXADOX",38,0)
S PIEN=$$SCHEMA("UPDATE MEDICARE DATES")
"RTN","BMXADOX",39,0)
S JIEN=$$SCHEMA("UPDATE MEDICARE INFO")
"RTN","BMXADOX",40,0)
D SS^BMXADO(.OUT,PIEN,DAS,("~"_DFN_"~"_DFN_"~"_MAX_"~~"_"MEDICARE~BMXADOV2~~"_JIEN_",PARENT"))
"RTN","BMXADOX",41,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",42,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",43,0)
Q
"RTN","BMXADOX",44,0)
;
"RTN","BMXADOX",45,0)
MEDICAID ; VIEW MEDICAID DATES/INFO
"RTN","BMXADOX",46,0)
N OUT,%,DAS,PIEN,JIEN,DFN,DA
"RTN","BMXADOX",47,0)
S DFN=3
"RTN","BMXADOX",48,0)
S DA(1)=$$MCDIEN^BMXADOV2(DFN) I 'DA(1) Q
"RTN","BMXADOX",49,0)
S DAS=DA(1)_","
"RTN","BMXADOX",50,0)
S PIEN=$$SCHEMA("UPDATE MEDICAID DATES")
"RTN","BMXADOX",51,0)
S JIEN=$$SCHEMA("UPDATE MEDICAID INFO")
"RTN","BMXADOX",52,0)
D SS^BMXADO(.OUT,PIEN,DAS,("~~~~~MEDICAID~BMXADOV2~~"_JIEN_",PARENT"))
"RTN","BMXADOX",53,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",54,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",55,0)
Q
"RTN","BMXADOX",56,0)
;
"RTN","BMXADOX",57,0)
PVTINS ; VIEW PRIVATE INSURANCE DATES/INFO
"RTN","BMXADOX",58,0)
N OUT,%,DAS,SIEN,DFN
"RTN","BMXADOX",59,0)
S DFN=1
"RTN","BMXADOX",60,0)
S DAS=DFN_","
"RTN","BMXADOX",61,0)
S SIEN=$$SCHEMA("UPDATE PVT INSURANCE INFO")
"RTN","BMXADOX",62,0)
D SS^BMXADO(.OUT,SIEN,DAS,"~~~~~PVTINS~BMXADOV2~~")
"RTN","BMXADOX",63,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",64,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",65,0)
Q
"RTN","BMXADOX",66,0)
;
"RTN","BMXADOX",67,0)
VISIT ; VIEW VISITS
"RTN","BMXADOX",68,0)
N OUT,%,SIEN,DFN
"RTN","BMXADOX",69,0)
S DFN=1
"RTN","BMXADOX",70,0)
S SIEN=$$SCHEMA("VISITS")
"RTN","BMXADOX",71,0)
D SS^BMXADO(.OUT,SIEN,"","AA~3/21/1985~6/4/1986~100~~~~1|R")
"RTN","BMXADOX",72,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",73,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",74,0)
Q
"RTN","BMXADOX",75,0)
;
"RTN","BMXADOX",76,0)
DUPVIS ; DISPLAY POSSIBLE DUPLICATE VISITS
"RTN","BMXADOX",77,0)
N OUT,%,SIEN,DFN
"RTN","BMXADOX",78,0)
S DFN=1
"RTN","BMXADOX",79,0)
S SIEN=$$SCHEMA("VISITS")
"RTN","BMXADOX",80,0)
D SS^BMXADO(.OUT,SIEN,"","~~~~~DUPV~BMXADOV2~1|4/19/04@1PM|I|4585|A~")
"RTN","BMXADOX",81,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",82,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",83,0)
Q
"RTN","BMXADOX",84,0)
;
"RTN","BMXADOX",85,0)
ADDVIS ; ADD A NEW VISIT
"RTN","BMXADOX",86,0)
N OUT,%,SIEN,DFN,NODE
"RTN","BMXADOX",87,0)
S DFN=3
"RTN","BMXADOX",88,0)
S SIEN=$$SCHEMA("VISITS")
"RTN","BMXADOX",89,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOX",90,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOX",91,0)
S ^TMP("BMX ADO",$J,NODE)="^JUN 03, 2004@09:32^I^`3^`4585^A^`1"_$C(30)
"RTN","BMXADOX",92,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",93,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
"RTN","BMXADOX",94,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",95,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
"RTN","BMXADOX",96,0)
Q
"RTN","BMXADOX",97,0)
;
"RTN","BMXADOX",98,0)
POV ; DISPLAY POVS
"RTN","BMXADOX",99,0)
N OUT,%,SIEN,DFN
"RTN","BMXADOX",100,0)
S DFN=1
"RTN","BMXADOX",101,0)
S SIEN=$$SCHEMA("VIEW POVS")
"RTN","BMXADOX",102,0)
D SS^BMXADO(.OUT,SIEN,"","AA~3/21/1985~6/4/1986~100~~~~1|C")
"RTN","BMXADOX",103,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",104,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",105,0)
Q
"RTN","BMXADOX",106,0)
;
"RTN","BMXADOX",107,0)
FLDS ; GET FILEMAN FIELDS
"RTN","BMXADOX",108,0)
N OUT,%,SIEN,DFN
"RTN","BMXADOX",109,0)
S SIEN=$$SCHEMA("FIELDS")
"RTN","BMXADOX",110,0)
D SS^BMXADO(.OUT,SIEN,"","~~~~~FLDIT~BMXADOS1~3.7~")
"RTN","BMXADOX",111,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",112,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",113,0)
Q
"RTN","BMXADOX",114,0)
;
"RTN","BMXADOX",115,0)
FINFO ; GET FILEMAN FILEINFO
"RTN","BMXADOX",116,0)
N OUT,%,SIEN,DFN
"RTN","BMXADOX",117,0)
S SIEN=$$SCHEMA("FILEMAN FILEINFO")
"RTN","BMXADOX",118,0)
D SS^BMXADO(.OUT,SIEN,"","~~~~~FNIT~BMXADOS1~3.7~")
"RTN","BMXADOX",119,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",120,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",121,0)
Q
"RTN","BMXADOX",122,0)
;
"RTN","BMXADOX",123,0)
ADDPOV ; ADD A POV TO AN EXISITING VISIT
"RTN","BMXADOX",124,0)
N OUT,%,SIEN,DFN,NODE
"RTN","BMXADOX",125,0)
S DFN=1
"RTN","BMXADOX",126,0)
S SIEN=$$SCHEMA("UPDATE POVS")
"RTN","BMXADOX",127,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOX",128,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOX",129,0)
S ^TMP("BMX ADO",$J,NODE)="^`8718^`1^`71164^DM II ON NEW MEDS^2^P"_$C(30)
"RTN","BMXADOX",130,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",131,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
"RTN","BMXADOX",132,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",133,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
"RTN","BMXADOX",134,0)
Q
"RTN","BMXADOX",135,0)
;
"RTN","BMXADOX",136,0)
EDITPOV ; ADD A POV TO AN EXISITING VISIT
"RTN","BMXADOX",137,0)
N OUT,%,SIEN,DFN,NODE
"RTN","BMXADOX",138,0)
S DFN=1
"RTN","BMXADOX",139,0)
S SIEN=$$SCHEMA("UPDATE POVS")
"RTN","BMXADOX",140,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOX",141,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOX",142,0)
S ^TMP("BMX ADO",$J,NODE)="100123^`8718^`1^`71164^DM II ON SPECIAL MEDS^2^P"_$C(30)
"RTN","BMXADOX",143,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",144,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
"RTN","BMXADOX",145,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",146,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
"RTN","BMXADOX",147,0)
Q
"RTN","BMXADOX",148,0)
;
"RTN","BMXADOX",149,0)
PROB ; DISPLAY PROBLEMS
"RTN","BMXADOX",150,0)
N OUT,%,SIEN,DFN
"RTN","BMXADOX",151,0)
S DFN=1
"RTN","BMXADOX",152,0)
S SIEN=$$SCHEMA("VIEW PROBLEMS")
"RTN","BMXADOX",153,0)
D SS^BMXADO(.OUT,SIEN,"","AA~"_DFN_"~"_DFN_"~~~~~")
"RTN","BMXADOX",154,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",155,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",156,0)
Q
"RTN","BMXADOX",157,0)
;
"RTN","BMXADOX",158,0)
ADDPROB ; ADD A PROBLEM TO THE PROBLEM LIST
"RTN","BMXADOX",159,0)
N OUT,%,SIEN,DFN,NODE,NUM,LOC,ICD,TEXT,AIR,IEN
"RTN","BMXADOX",160,0)
S ICD=2477
"RTN","BMXADOX",161,0)
S TEXT="HYPERTENSION ON SPECIAL MEDS"
"RTN","BMXADOX",162,0)
S DFN=1,LOC=DUZ(2),AIR="A"
"RTN","BMXADOX",163,0)
S SIEN=$$SCHEMA("UPDATE PROBLEMS")
"RTN","BMXADOX",164,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOX",165,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOX",166,0)
S ^TMP("BMX ADO",$J,NODE)=U_"`"_ICD_U_"`"_DFN_U_DT_U_U_TEXT_U_"`"_LOC_U_DT_$C(30)
"RTN","BMXADOX",167,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",168,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
"RTN","BMXADOX",169,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",170,0)
S IEN=+$P(OUT(1),"|",2) I '$D(^AUPNPROB(IEN,0)) Q
"RTN","BMXADOX",171,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
"RTN","BMXADOX",172,0)
K OUT
"RTN","BMXADOX",173,0)
S NUM=$$NEXTNUM(DFN,LOC) I 'NUM Q ; PROBLEM NUMBER & STATUS MUST BE ADDED SEPARATELY
"RTN","BMXADOX",174,0)
S SIEN=$$SCHEMA("UPDATE PROBLEM NUMBER")
"RTN","BMXADOX",175,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOX",176,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOX",177,0)
S ^TMP("BMX ADO",$J,NODE)=IEN_U_NUM_U_"A"_$C(30)
"RTN","BMXADOX",178,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",179,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
"RTN","BMXADOX",180,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",181,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
"RTN","BMXADOX",182,0)
Q
"RTN","BMXADOX",183,0)
;
"RTN","BMXADOX",184,0)
MEAS ; DISPLAY MEASUREMENTS
"RTN","BMXADOX",185,0)
N OUT,%,SIEN,DFN
"RTN","BMXADOX",186,0)
S DFN=1
"RTN","BMXADOX",187,0)
S SIEN=$$SCHEMA("VIEW MEASUREMENTS")
"RTN","BMXADOX",188,0)
D SS^BMXADO(.OUT,SIEN,"","AA~3/21/1985~6/4/1986~10~~~~"_DFN_"|WT|C")
"RTN","BMXADOX",189,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",190,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",191,0)
Q
"RTN","BMXADOX",192,0)
;
"RTN","BMXADOX",193,0)
ADDMEAS ; UPDATE V MEASUREMENT FILE
"RTN","BMXADOX",194,0)
N OUT,%,SIEN,DFN,NODE
"RTN","BMXADOX",195,0)
S DFN=1
"RTN","BMXADOX",196,0)
S SIEN=$$SCHEMA("UPDATE MEASUREMENTS")
"RTN","BMXADOX",197,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOX",198,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOX",199,0)
S ^TMP("BMX ADO",$J,NODE)="^`2^`"_DFN_"^`71164^177.5^`6"_$C(30)
"RTN","BMXADOX",200,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",201,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
"RTN","BMXADOX",202,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",203,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
"RTN","BMXADOX",204,0)
Q
"RTN","BMXADOX",205,0)
;
"RTN","BMXADOX",206,0)
MEDS ; DISPLAY MEDS
"RTN","BMXADOX",207,0)
N OUT,%,SIEN,DFN
"RTN","BMXADOX",208,0)
S DFN=3
"RTN","BMXADOX",209,0)
S SIEN=$$SCHEMA("VIEW MEDS")
"RTN","BMXADOX",210,0)
D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1989~12/31/1990~10~~~~"_DFN_"|C")
"RTN","BMXADOX",211,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",212,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",213,0)
Q
"RTN","BMXADOX",214,0)
;
"RTN","BMXADOX",215,0)
ADDMEDS ; UPDATE V MED FILE
"RTN","BMXADOX",216,0)
N OUT,%,SIEN,DFN,NODE
"RTN","BMXADOX",217,0)
S DFN=3
"RTN","BMXADOX",218,0)
S SIEN=$$SCHEMA("UPDATE MEDS")
"RTN","BMXADOX",219,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOX",220,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOX",221,0)
S ^TMP("BMX ADO",$J,NODE)="^`305^`"_DFN_"^`71164^T1T QID^40"_$C(30)
"RTN","BMXADOX",222,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",223,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
"RTN","BMXADOX",224,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",225,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
"RTN","BMXADOX",226,0)
Q
"RTN","BMXADOX",227,0)
;
"RTN","BMXADOX",228,0)
LAB ; DISPLAY LAB TEST RESULTS
"RTN","BMXADOX",229,0)
N OUT,%,SIEN,DFN
"RTN","BMXADOX",230,0)
S DFN=1
"RTN","BMXADOX",231,0)
S SIEN=$$SCHEMA("VIEW LABS")
"RTN","BMXADOX",232,0)
D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1985~12/31/1987~10~~~~"_DFN_"|175|C")
"RTN","BMXADOX",233,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",234,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",235,0)
Q
"RTN","BMXADOX",236,0)
;
"RTN","BMXADOX",237,0)
ADDLAB ; UPDATE V LAB
"RTN","BMXADOX",238,0)
N OUT,%,SIEN,DFN,NODE
"RTN","BMXADOX",239,0)
S DFN=1
"RTN","BMXADOX",240,0)
S SIEN=$$SCHEMA("UPDATE LABS")
"RTN","BMXADOX",241,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOX",242,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOX",243,0)
S ^TMP("BMX ADO",$J,NODE)="^`175^`"_DFN_"^`71164^216"_$C(30)
"RTN","BMXADOX",244,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",245,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
"RTN","BMXADOX",246,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",247,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
"RTN","BMXADOX",248,0)
Q
"RTN","BMXADOX",249,0)
;
"RTN","BMXADOX",250,0)
EXAMS ; DISPLAY EXAMS
"RTN","BMXADOX",251,0)
N OUT,%,SIEN,DFN
"RTN","BMXADOX",252,0)
S DFN=1
"RTN","BMXADOX",253,0)
S SIEN=$$SCHEMA("VIEW EXAMS")
"RTN","BMXADOX",254,0)
D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1986~12/31/1990~10~~~~"_DFN_"|6|C")
"RTN","BMXADOX",255,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",256,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",257,0)
Q
"RTN","BMXADOX",258,0)
;
"RTN","BMXADOX",259,0)
ADDEXAMS ; UPDATE V EXAM
"RTN","BMXADOX",260,0)
S DFN=1
"RTN","BMXADOX",261,0)
S SIEN=$$SCHEMA("UPDATE EXAMS")
"RTN","BMXADOX",262,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOX",263,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOX",264,0)
S ^TMP("BMX ADO",$J,NODE)="^`6^`"_DFN_"^`71164^NORMAL"_$C(30)
"RTN","BMXADOX",265,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",266,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
"RTN","BMXADOX",267,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",268,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
"RTN","BMXADOX",269,0)
Q
"RTN","BMXADOX",270,0)
;
"RTN","BMXADOX",271,0)
IMM ; DISPLAY IMMUNIZATIONS
"RTN","BMXADOX",272,0)
N OUT,%,SIEN,DFN
"RTN","BMXADOX",273,0)
S DFN=2
"RTN","BMXADOX",274,0)
S SIEN=$$SCHEMA("VIEW IMM")
"RTN","BMXADOX",275,0)
D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1986~12/31/1988~10~~~~"_DFN_"|12|C")
"RTN","BMXADOX",276,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",277,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",278,0)
Q
"RTN","BMXADOX",279,0)
;
"RTN","BMXADOX",280,0)
ADDIMM ; UPDATE V IMMUNIZATION FILE
"RTN","BMXADOX",281,0)
S DFN=2
"RTN","BMXADOX",282,0)
S SIEN=$$SCHEMA("UPDATE IMM")
"RTN","BMXADOX",283,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOX",284,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOX",285,0)
S ^TMP("BMX ADO",$J,NODE)="^`12^`"_DFN_"^`71164^2"_$C(30)
"RTN","BMXADOX",286,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",287,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
"RTN","BMXADOX",288,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",289,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
"RTN","BMXADOX",290,0)
Q
"RTN","BMXADOX",291,0)
;
"RTN","BMXADOX",292,0)
PROV ; DISPLAY PROVIDERS FOR A VISIT
"RTN","BMXADOX",293,0)
N OUT,%,SIEN,VIEN
"RTN","BMXADOX",294,0)
S VIEN=11
"RTN","BMXADOX",295,0)
S SIEN=$$SCHEMA("VIEW PROV")
"RTN","BMXADOX",296,0)
D SS^BMXADO(.OUT,SIEN,"","AD~"_VIEN_"~"_VIEN_"~10~~~~")
"RTN","BMXADOX",297,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",298,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",299,0)
Q
"RTN","BMXADOX",300,0)
;
"RTN","BMXADOX",301,0)
ADDPROV ; UPDATE V PROVIDER FILE
"RTN","BMXADOX",302,0)
N OUT,%,SIEN,NODE,PIEN,DFN
"RTN","BMXADOX",303,0)
S PIEN=5,DFN=1
"RTN","BMXADOX",304,0)
I $P(^DD(9000010.06,.01,0),U,3)["DIC(6" S PIEN=$P(^VA(200,PIEN,0),U,16) ; CONVERT FILE 200 TO FILE 16 IF NECESS.
"RTN","BMXADOX",305,0)
S SIEN=$$SCHEMA("UPDATE PROV")
"RTN","BMXADOX",306,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOX",307,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOX",308,0)
S ^TMP("BMX ADO",$J,NODE)="^`"_PIEN_"^`"_DFN_"^`71164^P"_$C(30)
"RTN","BMXADOX",309,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",310,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
"RTN","BMXADOX",311,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",312,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
"RTN","BMXADOX",313,0)
Q
"RTN","BMXADOX",314,0)
;
"RTN","BMXADOX",315,0)
PROC ; DISPLAY PROCEDURES
"RTN","BMXADOX",316,0)
N OUT,%,SIEN,DFN
"RTN","BMXADOX",317,0)
S DFN=4
"RTN","BMXADOX",318,0)
S SIEN=$$SCHEMA("VIEW PROCEDURES")
"RTN","BMXADOX",319,0)
D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1985~12/31/1985~10~~~~"_DFN_"|C")
"RTN","BMXADOX",320,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",321,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",322,0)
Q
"RTN","BMXADOX",323,0)
;
"RTN","BMXADOX",324,0)
ADDPROC ; UPDATE V PROCEDURES FILE
"RTN","BMXADOX",325,0)
N OUT,%,SIEN,DFN,NODE
"RTN","BMXADOX",326,0)
S DFN=1
"RTN","BMXADOX",327,0)
S SIEN=$$SCHEMA("UPDATE PROCEDURES")
"RTN","BMXADOX",328,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOX",329,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOX",330,0)
S ^TMP("BMX ADO",$J,NODE)="^`2198^`"_DFN_"^`71164^`8718"_$C(30)
"RTN","BMXADOX",331,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",332,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
"RTN","BMXADOX",333,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",334,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
"RTN","BMXADOX",335,0)
Q
"RTN","BMXADOX",336,0)
;
"RTN","BMXADOX",337,0)
CPT ; DISPLAY CPT CODES
"RTN","BMXADOX",338,0)
N OUT,%,SIEN,DFN
"RTN","BMXADOX",339,0)
S VIEN=71164
"RTN","BMXADOX",340,0)
S SIEN=$$SCHEMA("VIEW CPT")
"RTN","BMXADOX",341,0)
D SS^BMXADO(.OUT,SIEN,"","AD~"_VIEN_"~"_VIEN_"~10~~~~")
"RTN","BMXADOX",342,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",343,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",344,0)
Q
"RTN","BMXADOX",345,0)
;
"RTN","BMXADOX",346,0)
ADDCPT ; UPDATE V CPT FILE
"RTN","BMXADOX",347,0)
N OUT,%,SIEN,DFN,NODE
"RTN","BMXADOX",348,0)
S DFN=1
"RTN","BMXADOX",349,0)
S SIEN=$$SCHEMA("UPDATE CPT")
"RTN","BMXADOX",350,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOX",351,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOX",352,0)
S ^TMP("BMX ADO",$J,NODE)="^`10000^`"_DFN_"^`71164^WOUND CARE"_$C(30)
"RTN","BMXADOX",353,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",354,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
"RTN","BMXADOX",355,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",356,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
"RTN","BMXADOX",357,0)
Q
"RTN","BMXADOX",358,0)
;
"RTN","BMXADOX",359,0)
PH ; DISPLAY PERSONAL HISTORY
"RTN","BMXADOX",360,0)
N OUT,%,SIEN,DFN
"RTN","BMXADOX",361,0)
S DFN=632
"RTN","BMXADOX",362,0)
S SIEN=$$SCHEMA("VIEW PERSONAL HISTORY")
"RTN","BMXADOX",363,0)
D SS^BMXADO(.OUT,SIEN,"","AC~"_DFN_"~"_DFN_"~~~~~")
"RTN","BMXADOX",364,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",365,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",366,0)
Q
"RTN","BMXADOX",367,0)
;
"RTN","BMXADOX",368,0)
ADDPH ; UPDATE PERSONAL HX
"RTN","BMXADOX",369,0)
N OUT,%,SIEN,DFN,NODE,ICD,TEXT
"RTN","BMXADOX",370,0)
S ICD=2477
"RTN","BMXADOX",371,0)
S TEXT="PERSONAL HISTORY OF SERIOUS PROBLEMS"
"RTN","BMXADOX",372,0)
S DFN=632
"RTN","BMXADOX",373,0)
S SIEN=$$SCHEMA("UPDATE PERSONAL HISTORY")
"RTN","BMXADOX",374,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOX",375,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOX",376,0)
S ^TMP("BMX ADO",$J,NODE)="^`11353^`"_DFN_"^2851219^"_TEXT_"^2810303"_$C(30)
"RTN","BMXADOX",377,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",378,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
"RTN","BMXADOX",379,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",380,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
"RTN","BMXADOX",381,0)
Q
"RTN","BMXADOX",382,0)
;
"RTN","BMXADOX",383,0)
FH ; DISPLAY FAMILY HX
"RTN","BMXADOX",384,0)
N OUT,%,SIEN,DFN
"RTN","BMXADOX",385,0)
S DFN=631
"RTN","BMXADOX",386,0)
S SIEN=$$SCHEMA("VIEW FAMILY HISTORY")
"RTN","BMXADOX",387,0)
D SS^BMXADO(.OUT,SIEN,"","AC~"_DFN_"~"_DFN_"~~~~~")
"RTN","BMXADOX",388,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",389,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",390,0)
Q
"RTN","BMXADOX",391,0)
;
"RTN","BMXADOX",392,0)
ADDFH ; UPDATE FAMILY HISTORY
"RTN","BMXADOX",393,0)
N OUT,%,SIEN,DFN,NODE,ICD,TEXT
"RTN","BMXADOX",394,0)
S ICD=2477
"RTN","BMXADOX",395,0)
S TEXT="FAMILY HISTORY OF SERIOUS PROBLEMS"
"RTN","BMXADOX",396,0)
S DFN=631
"RTN","BMXADOX",397,0)
S SIEN=$$SCHEMA("UPDATE FAMILY HISTORY")
"RTN","BMXADOX",398,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOX",399,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOX",400,0)
S ^TMP("BMX ADO",$J,NODE)="^`7571^`"_DFN_"^2851219^"_TEXT_$C(30)
"RTN","BMXADOX",401,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",402,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
"RTN","BMXADOX",403,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",404,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
"RTN","BMXADOX",405,0)
Q
"RTN","BMXADOX",406,0)
;
"RTN","BMXADOX",407,0)
HF ; DISPLAY HEALTH FACTORS
"RTN","BMXADOX",408,0)
N OUT,%,SIEN,DFN
"RTN","BMXADOX",409,0)
S DFN=1
"RTN","BMXADOX",410,0)
S SIEN=$$SCHEMA("VIEW HEALTH FACTORS")
"RTN","BMXADOX",411,0)
D SS^BMXADO(.OUT,SIEN,"","AC"_"~"_DFN_"~"_DFN_"~~~~~")
"RTN","BMXADOX",412,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",413,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",414,0)
Q
"RTN","BMXADOX",415,0)
;
"RTN","BMXADOX",416,0)
ADDHF ; UPDATE HEALTH FACTORS FILE
"RTN","BMXADOX",417,0)
N OUT,%,SIEN,DFN,NODE
"RTN","BMXADOX",418,0)
S DFN=1
"RTN","BMXADOX",419,0)
S SIEN=$$SCHEMA("UPDATE HEALTH FACTORS")
"RTN","BMXADOX",420,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOX",421,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOX",422,0)
S ^TMP("BMX ADO",$J,NODE)="^`3^`"_DFN_U_DT_$C(30)
"RTN","BMXADOX",423,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",424,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
"RTN","BMXADOX",425,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",426,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
"RTN","BMXADOX",427,0)
Q
"RTN","BMXADOX",428,0)
;
"RTN","BMXADOX",429,0)
REPRO ; DISPLAY REPRODUCTIVE FACTORS
"RTN","BMXADOX",430,0)
N OUT,%,SIEN,DFN
"RTN","BMXADOX",431,0)
S DFN=5
"RTN","BMXADOX",432,0)
S SIEN=$$SCHEMA("VIEW REPRODUCTIVE FACTORS")
"RTN","BMXADOX",433,0)
D SS^BMXADO(.OUT,SIEN,"","B"_"~"_DFN_"~"_DFN_"~~~~~")
"RTN","BMXADOX",434,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",435,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",436,0)
Q
"RTN","BMXADOX",437,0)
;
"RTN","BMXADOX",438,0)
ADDREPRO ; UPDATE REPRODUCTIVE FACTORS
"RTN","BMXADOX",439,0)
; THE .O1 FIELD IS DINUMED
"RTN","BMXADOX",440,0)
; THEREFORE, THE FILER WILL AUTOMATICALLY SWITCH TO MOD MODE IF A RECORD ALREADY EXISTS FOR THIS PATIENT
"RTN","BMXADOX",441,0)
N OUT,%,SIEN,DFN,NODE
"RTN","BMXADOX",442,0)
S DFN=5
"RTN","BMXADOX",443,0)
; I $D(^AUPNREP(DFN)) G ERF
"RTN","BMXADOX",444,0)
S SIEN=$$SCHEMA("ADD REPRODUCTIVE FACTORS")
"RTN","BMXADOX",445,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOX",446,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOX",447,0)
S ^TMP("BMX ADO",$J,NODE)="^`"_DFN_"^G5P4LC3SA1TA0^"_DT_"^2^3040101^"_DT_$C(30)
"RTN","BMXADOX",448,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",449,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
"RTN","BMXADOX",450,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",451,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
"RTN","BMXADOX",452,0)
Q
"RTN","BMXADOX",453,0)
;
"RTN","BMXADOX",454,0)
; ---------------------------------- GRIDS ---------------------------------------------
"RTN","BMXADOX",455,0)
;
"RTN","BMXADOX",456,0)
GRID ; POPULATE THE INTRO GRID
"RTN","BMXADOX",457,0)
N OUT,%,SIEN,NODE,NEXT
"RTN","BMXADOX",458,0)
S NEXT="70470;0"
"RTN","BMXADOX",459,0)
S SIEN=$$SCHEMA("VEN MOJO DE INTRO")
"RTN","BMXADOX",460,0)
D SS^BMXADO(.OUT,SIEN,"","ASEG~"_NEXT_"~"_NEXT) ; GET SCHEMA
"RTN","BMXADOX",461,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",462,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",463,0)
Q
"RTN","BMXADOX",464,0)
;
"RTN","BMXADOX",465,0)
MGRID ; POPULATE THE MEASUREMENT GRID
"RTN","BMXADOX",466,0)
N OUT,%,SIEN,NODE,NEXT,START,STOP
"RTN","BMXADOX",467,0)
S NEXT="70470;2"
"RTN","BMXADOX",468,0)
S SIEN=$$SCHEMA("VEN MOJO DE MEASUREMENT")
"RTN","BMXADOX",469,0)
; D SS^BMXADO(.OUT,SIEN,"","~~~~~GRIDIT~VENPCCTG~"_NEXT) ; GET SCHEMA
"RTN","BMXADOX",470,0)
D SS^BMXADO(.OUT,SIEN,"","ASEG~"_NEXT_"~"_NEXT) ; GET SCHEMA
"RTN","BMXADOX",471,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",472,0)
; K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",473,0)
Q
"RTN","BMXADOX",474,0)
;
"RTN","BMXADOX",475,0)
PRVGRID ; POPULATE THE PROVIDER GRID
"RTN","BMXADOX",476,0)
N OUT,%,SIEN,NODE,NEXT
"RTN","BMXADOX",477,0)
S NEXT="70470;4"
"RTN","BMXADOX",478,0)
S SIEN=$$SCHEMA("VEN MOJO DE PROVIDER")
"RTN","BMXADOX",479,0)
D SS^BMXADO(.OUT,SIEN,"","ASEG~"_NEXT_"~"_NEXT) ; GET SCHEMA
"RTN","BMXADOX",480,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",481,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",482,0)
Q
"RTN","BMXADOX",483,0)
;
"RTN","BMXADOX",484,0)
CLGRID ; POPULATE THE CLINIC GRID
"RTN","BMXADOX",485,0)
N OUT,%,SIEN,NODE,NEXT
"RTN","BMXADOX",486,0)
S NEXT="70470;8"
"RTN","BMXADOX",487,0)
S SIEN=$$SCHEMA("VEN MOJO DE CLINIC")
"RTN","BMXADOX",488,0)
D SS^BMXADO(.OUT,SIEN,"","ASEG~"_NEXT_"~"_NEXT) ; GET SCHEMA
"RTN","BMXADOX",489,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",490,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",491,0)
Q
"RTN","BMXADOX",492,0)
;
"RTN","BMXADOX",493,0)
DXGRID ; POPULATE THE DX GRID
"RTN","BMXADOX",494,0)
N OUT,%,SIEN,NODE,NEXT
"RTN","BMXADOX",495,0)
S NEXT="70470;1"
"RTN","BMXADOX",496,0)
S SIEN=$$SCHEMA("VEN MOJO DE DX DXHX")
"RTN","BMXADOX",497,0)
D SS^BMXADO(.OUT,SIEN,"","ASEG~"_NEXT_"~"_NEXT) ; GET SCHEMA
"RTN","BMXADOX",498,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX",499,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX",500,0)
Q
"RTN","BMXADOX",501,0)
;
"RTN","BMXADOX1")
0^75^B84889528
"RTN","BMXADOX1",1,0)
BMXADOX1 ; IHS/CIHA/GIS - RPC CALL: GENERATE AN ADO SCHEMA STRING AND DATA SET ;
"RTN","BMXADOX1",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXADOX1",3,0)
; EXMAPLES OF FILEMAN SCHEMA GENERATION
"RTN","BMXADOX1",4,0)
;
"RTN","BMXADOX1",5,0)
;
"RTN","BMXADOX1",6,0)
; N OUT,DAX,% S DAX=0 D SS^BMXADO(.OUT,1,DAX,"^^^5^I^^^^3,XSUB,2160010.03") D DISP(OUT) Q ; TEST EXTENDED SUBJOIN
"RTN","BMXADOX1",7,0)
;
"RTN","BMXADOX1",8,0)
DISP(OUT) ;
"RTN","BMXADOX1",9,0)
D DISP^BMXADOX(OUT)
"RTN","BMXADOX1",10,0)
Q
"RTN","BMXADOX1",11,0)
;
"RTN","BMXADOX1",12,0)
SCHEMA(NAME) ; GIVEN SCHEMA NAME, RETURN THE IEN
"RTN","BMXADOX1",13,0)
N IEN
"RTN","BMXADOX1",14,0)
S IEN=$O(^BMXADO("B",NAME,0))
"RTN","BMXADOX1",15,0)
Q IEN
"RTN","BMXADOX1",16,0)
;
"RTN","BMXADOX1",17,0)
NUM ; ITERATE BY IEN
"RTN","BMXADOX1",18,0)
; IX="",START WITH IEN=1, STOP AFTER IEN=20, MAX # RECORDS RETURNED = 5
"RTN","BMXADOX1",19,0)
; TO VIEW INTERNAL VALUES SET VSTG="~1~20~5~I"
"RTN","BMXADOX1",20,0)
N OUT,%,SIEN
"RTN","BMXADOX1",21,0)
S SIEN=$$SCHEMA("IHS PATIENT")
"RTN","BMXADOX1",22,0)
D SS^BMXADO(.OUT,SIEN,"","~1~20~5")
"RTN","BMXADOX1",23,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX1",24,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX1",25,0)
Q
"RTN","BMXADOX1",26,0)
;
"RTN","BMXADOX1",27,0)
IX ; ITERATE BY INDEX
"RTN","BMXADOX1",28,0)
; ITERATE USING THE "B" INDEX
"RTN","BMXADOX1",29,0)
; START WITH PT NAME "C", STOP AFTER PATIENT NAME = "D", MAX # RECORDS RETURNED = 5
"RTN","BMXADOX1",30,0)
N OUT,%,SIEN
"RTN","BMXADOX1",31,0)
S SIEN=$$SCHEMA("IHS PATIENT")
"RTN","BMXADOX1",32,0)
D SS^BMXADO(.OUT,SIEN,"","B~C~D~5")
"RTN","BMXADOX1",33,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX1",34,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX1",35,0)
Q
"RTN","BMXADOX1",36,0)
;
"RTN","BMXADOX1",37,0)
VCN ; SHOW VALUES FOR A SINGLE VISIT THAT AS A DEFINED VCN
"RTN","BMXADOX1",38,0)
N OUT,%,SIEN
"RTN","BMXADOX1",39,0)
S SIEN=$$SCHEMA("BMXADO DATA ENTRY IDENTIFIERS")
"RTN","BMXADOX1",40,0)
D SS^BMXADO(.OUT,SIEN,"","VCN~1.242A~1.242A~")
"RTN","BMXADOX1",41,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX1",42,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX1",43,0)
Q
"RTN","BMXADOX1",44,0)
;
"RTN","BMXADOX1",45,0)
MT ; MEASUREMNT TYPES
"RTN","BMXADOX1",46,0)
N OUT,%,SIEN
"RTN","BMXADOX1",47,0)
S SIEN=$$SCHEMA("BMXADO MEASUREMENT TYPES")
"RTN","BMXADOX1",48,0)
D SS^BMXADO(.OUT,SIEN,"","B~~")
"RTN","BMXADOX1",49,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX1",50,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX1",51,0)
Q
"RTN","BMXADOX1",52,0)
;
"RTN","BMXADOX1",53,0)
PROB ; PATIENT PROBLEMS
"RTN","BMXADOX1",54,0)
N OUT,%,SIEN
"RTN","BMXADOX1",55,0)
S SIEN=$$SCHEMA("BMXADO PROBLEMS")
"RTN","BMXADOX1",56,0)
D SS^BMXADO(.OUT,SIEN,"","AA~53~53")
"RTN","BMXADOX1",57,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX1",58,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX1",59,0)
Q
"RTN","BMXADOX1",60,0)
;
"RTN","BMXADOX1",61,0)
PB1 ; ALT PROB RETRIEVAL TEST
"RTN","BMXADOX1",62,0)
N OUT,%,SIEN
"RTN","BMXADOX1",63,0)
S SIEN=$$SCHEMA("BMXADO PROBLEMS")
"RTN","BMXADOX1",64,0)
D SS^BMXADO(.OUT,SIEN,"","~221~221~")
"RTN","BMXADOX1",65,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX1",66,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX1",67,0)
Q
"RTN","BMXADOX1",68,0)
;
"RTN","BMXADOX1",69,0)
POV ; RETURN THE POV SCHEMA
"RTN","BMXADOX1",70,0)
N OUT,%,SIEN
"RTN","BMXADOX1",71,0)
S SIEN=$$SCHEMA("BMXADO ADD POV")
"RTN","BMXADOX1",72,0)
D SS^BMXADO(.OUT,SIEN,"","")
"RTN","BMXADOX1",73,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX1",74,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX1",75,0)
Q
"RTN","BMXADOX1",76,0)
;
"RTN","BMXADOX1",77,0)
NOTES ; RETURN NOTES FOR A SPECIFIC PATIENT PROBLEMS
"RTN","BMXADOX1",78,0)
N OUT,%,SIEN
"RTN","BMXADOX1",79,0)
S SIEN=$$SCHEMA("BMXADO NOTES")
"RTN","BMXADOX1",80,0)
D SS^BMXADO(.OUT,SIEN,"","~~~~~NOTES~BMXADOFD~53")
"RTN","BMXADOX1",81,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX1",82,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX1",83,0)
Q
"RTN","BMXADOX1",84,0)
;
"RTN","BMXADOX1",85,0)
RENT ; ITERATE IN CHUNKS
"RTN","BMXADOX1",86,0)
; RE-ITERATE USING THE "B" INDEX
"RTN","BMXADOX1",87,0)
; START WITH PT IEN 5 AS THE "SEED", STOP AFTER PATIENT NAME = "D", MAX # RECORDS RETURNED = 5
"RTN","BMXADOX1",88,0)
N OUT,%,SIEN,SEED,LSEED,X,Y
"RTN","BMXADOX1",89,0)
S SEED=0,LSEED=""
"RTN","BMXADOX1",90,0)
S SIEN=$$SCHEMA("IHS PATIENT")
"RTN","BMXADOX1",91,0)
RIT F D I '$G(SEED) Q
"RTN","BMXADOX1",92,0)
. ; D SS^BMXADO(.OUT,SIEN,SEED,"B~CA~CB~5")
"RTN","BMXADOX1",93,0)
. D SS^BMXADO(.OUT,SIEN,SEED,"~~~5")
"RTN","BMXADOX1",94,0)
. D DISP(OUT) R %:$G(DTIME,60) E S SEED="" Q
"RTN","BMXADOX1",95,0)
. I %?1"^" S SEED="" Q
"RTN","BMXADOX1",96,0)
. S X=$P(@OUT@(1),U,1)
"RTN","BMXADOX1",97,0)
. S SEED=$P(X,"|",3)
"RTN","BMXADOX1",98,0)
. I SEED=LSEED S SEED="" Q
"RTN","BMXADOX1",99,0)
. S LSEED=SEED
"RTN","BMXADOX1",100,0)
. K ^TMP("BMX ADO",$J)
"RTN","BMXADOX1",101,0)
. Q
"RTN","BMXADOX1",102,0)
Q
"RTN","BMXADOX1",103,0)
;
"RTN","BMXADOX1",104,0)
SUB ; SUBFILE ITERATION
"RTN","BMXADOX1",105,0)
; THE SCHEMA IS ATTACHED TO THE MEDICARE ELIGIBILITY FILE/ELIG DATE SUBFILE
"RTN","BMXADOX1",106,0)
; THE DA STRING HAS A VALUE OF '1,',: THE IEN IN THE PARENT FILE.
"RTN","BMXADOX1",107,0)
; NOTE THE COMMA IN THE DA STRING. THIS INDICATES THAT THE FILE IEN IS 1 BUT THE SUBFILE IEN IS UNSPECIFIED
"RTN","BMXADOX1",108,0)
N OUT,%,SIEN
"RTN","BMXADOX1",109,0)
S SIEN=$$SCHEMA("UPDATE MEDICARE DATES")
"RTN","BMXADOX1",110,0)
D SS^BMXADO(.OUT,SIEN,"1,","~~~")
"RTN","BMXADOX1",111,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX1",112,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX1",113,0)
Q
"RTN","BMXADOX1",114,0)
;
"RTN","BMXADOX1",115,0)
DINUM ; DINUMED POINTER ITERATION
"RTN","BMXADOX1",116,0)
; THE SCHEMA IS ATTACHED TO THE IHS PATIENT FILE (9000001)
"RTN","BMXADOX1",117,0)
; THE IHS PATIENT FILE IS DINUM'D AND ITS .01 FIELD POINTS TO THE VA PATIENT FILE (2)
"RTN","BMXADOX1",118,0)
; BECAUSE OF THE SPECIAL RELATIONSHIP BETWEEN THE FILES, WE CAN USE THE B INDEX OF FILE 2 TO ITERATE FILE 9000001.
"RTN","BMXADOX1",119,0)
N OUT,%,SIEN
"RTN","BMXADOX1",120,0)
S SIEN=$$SCHEMA("IHS PATIENT")
"RTN","BMXADOX1",121,0)
D SS^BMXADO(.OUT,SIEN,"","B~A~B~5")
"RTN","BMXADOX1",122,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX1",123,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX1",124,0)
Q
"RTN","BMXADOX1",125,0)
;
"RTN","BMXADOX1",126,0)
IXP ; INDEXED POINTER ITERATION
"RTN","BMXADOX1",127,0)
; THE SCHEMA IS ATTACHED TO THE V POV FILE
"RTN","BMXADOX1",128,0)
; THE AC CROSS REFERENCE INDEXES THE PATIENT FIELD
"RTN","BMXADOX1",129,0)
; BY STARTING AND STOPING WITH PATIENT 1 (MAX=5) WE COLLECT THE FIRST 5 POVS FOR PATIENT 1 IN THE FILE
"RTN","BMXADOX1",130,0)
N OUT,%,SIEN
"RTN","BMXADOX1",131,0)
S SIEN=$$SCHEMA("VIEW POVS")
"RTN","BMXADOX1",132,0)
D SS^BMXADO(.OUT,SIEN,"","AC~1~1~5")
"RTN","BMXADOX1",133,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX1",134,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX1",135,0)
Q
"RTN","BMXADOX1",136,0)
;
"RTN","BMXADOX1",137,0)
AA ; ITERATE USING AA INDEX
"RTN","BMXADOX1",138,0)
; INDEX IS 'AA" THE START AND STOP DATES ARE SPECIFIED IN EXTERNAL FORMAT. MAX=10
"RTN","BMXADOX1",139,0)
; THE FOLLOWING FILTERS ARE SPECIFIED IN THE LAST PARAMETER ("1|WT|C"):
"RTN","BMXADOX1",140,0)
; 1=PATIENT DFN #1
"RTN","BMXADOX1",141,0)
; WT=RETURN ONLY WEIGHTS. MEASUREMENT TYPE MUST BE SPECIFIED WITH A VALID, UNAMBIGUOUS LOOKUP VALUE.
"RTN","BMXADOX1",142,0)
; C=RETRUN VALUES IN CHRONOLOGICAL ORDER USE 'R' INSTEAD OF 'C' FOR REVERSE CHRONOLOGICAL ORDER. DEFAULT=C
"RTN","BMXADOX1",143,0)
; THE SEED PARAMTER IS SET AND CAN BE USED TO RETURN DATA IN CHUNKS
"RTN","BMXADOX1",144,0)
N OUT,%,SIEN
"RTN","BMXADOX1",145,0)
S SIEN=$$SCHEMA("VIEW MEASUREMENTS")
"RTN","BMXADOX1",146,0)
D SS^BMXADO(.OUT,SIEN,"","AA~3/21/1985~6/4/1986~5~~~~1|WT|C")
"RTN","BMXADOX1",147,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX1",148,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX1",149,0)
Q
"RTN","BMXADOX1",150,0)
;
"RTN","BMXADOX1",151,0)
AA2 ; ITERATE USING AA INDEX
"RTN","BMXADOX1",152,0)
; THIS SCHEMA IS ATTACHED TO THE VISIT FILE (9000010)
"RTN","BMXADOX1",153,0)
; IN THIS CASE THERE IS NO ATTRIBUTE TYPE SO THE FILTER PARAM HAS ONLY 2 PIECES "1|R"
"RTN","BMXADOX1",154,0)
; 1=PATIENT DFN
"RTN","BMXADOX1",155,0)
; R=RETURN DATA IN REVERSE CHRONOLOGICAL ORDER
"RTN","BMXADOX1",156,0)
N OUT,%,SIEN
"RTN","BMXADOX1",157,0)
S SIEN=$$SCHEMA("VISITS")
"RTN","BMXADOX1",158,0)
D SS^BMXADO(.OUT,SIEN,"","AA~3/21/1985~6/4/1986~5~~~~1|R")
"RTN","BMXADOX1",159,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX1",160,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX1",161,0)
Q
"RTN","BMXADOX1",162,0)
;
"RTN","BMXADOX1",163,0)
CIT ; CUSTOM ITERATOR
"RTN","BMXADOX1",164,0)
; IF COMPLEX OR UNUSUAL SORTING/FILTERING IS REQUITED, USE A CUSTOM ITERATOR
"RTN","BMXADOX1",165,0)
; THE CUSTOM ITERATOR IS DEFINED BY 6TH, 7TH AND 8TH PIECES IN THE VSTG
"RTN","BMXADOX1",166,0)
; PIECE 8=TAG, PIECE 9=ROUTINE, PIECE 8=A PARAMETER PASSED TO THE ENTRY POINT
"RTN","BMXADOX1",167,0)
; THE 9TH PIECE CONTAINS PT DFN, TIMESTAMP, VISIT TYPE, LOC IEN, AND SERVICE CATEGORY IN A "|" DELIMTED STRING
"RTN","BMXADOX1",168,0)
; THE ITERATOR CALL TAG^ROUTINE(PARAM) TO GENERATE IENS
"RTN","BMXADOX1",169,0)
; IN THIS CASE THE SCHEMA IS ATTACHED TO THE VISIT FILE.
"RTN","BMXADOX1",170,0)
; GIVEN THE INFORMATION IN THE PARAMETER, THE CUSTOM ITERATOR RETURNS POSSIBLE DUPLICATE VISITS
"RTN","BMXADOX1",171,0)
N OUT,%,SIEN
"RTN","BMXADOX1",172,0)
S SIEN=$$SCHEMA("VISITS")
"RTN","BMXADOX1",173,0)
D SS^BMXADO(.OUT,SIEN,"","~~~~~DUPV~BMXADOV2~1|4/19/04@1PM|I|4585|A~")
"RTN","BMXADOX1",174,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX1",175,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX1",176,0)
Q
"RTN","BMXADOX1",177,0)
;
"RTN","BMXADOX1",178,0)
TRIGGER ; TEXT TRIGGER FUNCTION
"RTN","BMXADOX1",179,0)
N OUT,%,SIEN
"RTN","BMXADOX1",180,0)
S SIEN=$$SCHEMA("PATIENT DEMOGRAPHICS")
"RTN","BMXADOX1",181,0)
D SS^BMXADO(.OUT,SIEN,"","~1~5")
"RTN","BMXADOX1",182,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX1",183,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX1",184,0)
Q
"RTN","BMXADOX1",185,0)
;
"RTN","BMXADOX1",186,0)
ID ; IDENTIFIER FIELD
"RTN","BMXADOX1",187,0)
; THE SCHEMA IS ATTACHED TO THE VA PATIENT FILE (2)
"RTN","BMXADOX1",188,0)
; THE SCHEMA HAS A BUILT IN FIELD (.01ID) THAT RETURNS THE IDENTIFIERS
"RTN","BMXADOX1",189,0)
; THE ENTRY POINT THAT GENERATES THE IDETIFIERS IS STORED IN THE BMX ADO SCHEMA FILE
"RTN","BMXADOX1",190,0)
N OUT,%,SIEN
"RTN","BMXADOX1",191,0)
S SIEN=$$SCHEMA("UPDATE PATIENT DEMOGRAPHICS")
"RTN","BMXADOX1",192,0)
D SS^BMXADO(.OUT,SIEN,"","~1~1~")
"RTN","BMXADOX1",193,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX1",194,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX1",195,0)
Q
"RTN","BMXADOX1",196,0)
;
"RTN","BMXADOX1",197,0)
JMD ; JOIN MASTER TO DETAIL
"RTN","BMXADOX1",198,0)
N OUT,%,SIEN1,SIEN2,VSTG,SIEN3,JSTG
"RTN","BMXADOX1",199,0)
S SIEN1=$$SCHEMA("PATIENT DEMOGRAPHICS")
"RTN","BMXADOX1",200,0)
S SIEN2=$$SCHEMA("VIEW MEASUREMENTS")
"RTN","BMXADOX1",201,0)
S SIEN3=$$SCHEMA("VIEW MEDS")
"RTN","BMXADOX1",202,0)
S VSTG="~1~5" ; INSTRUCTIONS FOR GATHERING DATA SET FOR PTS 1-5 FROM THE MASTER FILE
"RTN","BMXADOX1",203,0)
S JSTG=SIEN3_",.001,.02IEN,AA~1/1/1960~6/30/2004~~~~~|C" ; + INSTRUCTIONS FOR 1ST JOIN TO GET MEDS
"RTN","BMXADOX1",204,0)
S JSTG=JSTG_"@JOIN@"_SIEN2_",.001,.02IEN,AA~1/1/1988~12/31/1988~~~~~|WT|R" ; + INSTRUCTIONS FOR 2ND JOIN TO GET MSRMNTS
"RTN","BMXADOX1",205,0)
D SS^BMXADO(.OUT,SIEN1,"",VSTG,JSTG)
"RTN","BMXADOX1",206,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX1",207,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX1",208,0)
Q
"RTN","BMXADOX1",209,0)
;
"RTN","BMXADOX1",210,0)
JVPT ; JOIN PT DEMOG TO VISIT
"RTN","BMXADOX1",211,0)
N OUT,%,SIEN1,SIEN2,VSTG,JSTG
"RTN","BMXADOX1",212,0)
S SIEN1=$$SCHEMA("PATIENT DEMOGRAPHICS")
"RTN","BMXADOX1",213,0)
S SIEN2=$$SCHEMA("VISITS")
"RTN","BMXADOX1",214,0)
S VSTG="~1~1" ; INSTRUCTIONS FOR GATHERING DATA SET FOR PT 5 FROM THE MASTER FILE
"RTN","BMXADOX1",215,0)
S JSTG=SIEN2_",.05IEN,.001,AC" ; + INSTRUCTIONS FOR 1ST JOIN TO GET VISIT INFO
"RTN","BMXADOX1",216,0)
D SS^BMXADO(.OUT,SIEN1,"",VSTG,JSTG)
"RTN","BMXADOX1",217,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX1",218,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX1",219,0)
Q
"RTN","BMXADOX1",220,0)
;
"RTN","BMXADOX1",221,0)
JAC ; TEST AC INDEX
"RTN","BMXADOX1",222,0)
N OUT,%,SIEN1,SIEN2
"RTN","BMXADOX1",223,0)
S SIEN1=$$SCHEMA("PATIENT DEMOGRAPHICS")
"RTN","BMXADOX1",224,0)
S SIEN2=$$SCHEMA("VIEW LABS")
"RTN","BMXADOX1",225,0)
S SIEN3=$$SCHEMA("VIEW MEASUREMENTS")
"RTN","BMXADOX1",226,0)
D SS^BMXADO(.OUT,SIEN1,"","~3~5~~~~~~"_SIEN2_",.001,.02IEN,AC@JOIN@"_SIEN3_",.001,.02IEN,AC")
"RTN","BMXADOX1",227,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX1",228,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX1",229,0)
Q
"RTN","BMXADOX1",230,0)
;
"RTN","BMXADOX1",231,0)
JPB ; TEST AA INDEX JOINS FOR PROBLEM LIST
"RTN","BMXADOX1",232,0)
N OUT,%,SIEN1,SIEN2
"RTN","BMXADOX1",233,0)
S SIEN1=$$SCHEMA("PATIENT DEMOGRAPHICS")
"RTN","BMXADOX1",234,0)
S SIEN2=$$SCHEMA("VIEW PROBLEMS")
"RTN","BMXADOX1",235,0)
D SS^BMXADO(.OUT,SIEN1,"","~1~5~~~~~~"_SIEN2_",.001,.02IEN,AA")
"RTN","BMXADOX1",236,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX1",237,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX1",238,0)
Q
"RTN","BMXADOX1",239,0)
;
"RTN","BMXADOX1",240,0)
JSUB ; SUBFILE JOIN
"RTN","BMXADOX1",241,0)
; IN THIS CASE THE RECORDS IN A PARENT FILE ARE "JOINED" TO THE RECORDS IN ONE OF ITS SUB FILES
"RTN","BMXADOX1",242,0)
; THE SCHEMA IS ATTACHED TO THE "MEDICARE ELIGIBLE" FILE
"RTN","BMXADOX1",243,0)
; IT IS JOINED TO ITS SUBFILE, "ELIG DATES", VIA THE UPDATE MEDICARE DATES SCHEMA
"RTN","BMXADOX1",244,0)
N OUT,%,SIEN1,SIEN2
"RTN","BMXADOX1",245,0)
S SIEN1=$$SCHEMA("UPDATE MEDICARE INFO")
"RTN","BMXADOX1",246,0)
S SIEN2=$$SCHEMA("UPDATE MEDICARE DATES")
"RTN","BMXADOX1",247,0)
D SS^BMXADO(.OUT,SIEN1,"","~1~5~~~~~~"_SIEN2_",SUB")
"RTN","BMXADOX1",248,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX1",249,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX1",250,0)
Q
"RTN","BMXADOX1",251,0)
;
"RTN","BMXADOX1",252,0)
ADD ; ADD A NEW ENTRY
"RTN","BMXADOX1",253,0)
; THIS IS A 2 STEP PROCESS:
"RTN","BMXADOX1",254,0)
; FIRST GET THE SCHEMA FOR THE FILE YOU WISH TO UPDATE
"RTN","BMXADOX1",255,0)
; THIS SCHEMA TYPICALLY BEGINS WITH THE WORD "UPDATE"
"RTN","BMXADOX1",256,0)
; IT CONTAINS NO ID IR IEN FIELDS
"RTN","BMXADOX1",257,0)
; SECOND ADD THE DATA NODE TO THE ARRAY
"RTN","BMXADOX1",258,0)
; IT HAS THE SAME FORMAT AS A DATA STRING ASSOCIATED WITH THE SCHEMA EXCEPT THE FIRST "^" PIECE IS NULL
"RTN","BMXADOX1",259,0)
; THIS PIECE CORRESPONDS TO THE IEN OF THE RECORD. SINCE THE RECORD HASNOT BEEN ADDED YET, IT IS NULL.
"RTN","BMXADOX1",260,0)
; IN THE DATA STRING, ALL POINTER VALUES ARE PRECEDED BY THE '`' CHARACTER AND EA. STRING ENDS IN $C(30)
"RTN","BMXADOX1",261,0)
; MULTIPLE DATA STRINGS CAN BE APPENDED AS NEW NODES AT THE BOTTOM OF THE ARRAY
"RTN","BMXADOX1",262,0)
; IN THIS CASE WE ARE ADDING A RECORD TO THE V MEASUREMENT FILE
"RTN","BMXADOX1",263,0)
; DATA STRING="^MEASUREMENT TYPE IEN^PATIENT DFN^VISIT IEN^RESULT"_$C(30)
"RTN","BMXADOX1",264,0)
; THERE ARE 2 INPUT PARAMS:
"RTN","BMXADOX1",265,0)
; THE CLOSED REF WHERE THE INPUT ARRAY IS STORED
"RTN","BMXADOX1",266,0)
; SINCE IT IS PASSED BY REFERENCE "OUT" CAN BE NULL OR UNDEFIEND.
"RTN","BMXADOX1",267,0)
; OUT WILL BE DEFINED AT THE CONCLUSION OF THE TRANSACTION.
"RTN","BMXADOX1",268,0)
; THE OUTPUT IS IN THE OUT ARRAY
"RTN","BMXADOX1",269,0)
; OUT(1)="OK|ien" WHERE ien IS THE IEN OF THE RECORD THAT HAS BEE ADDED.
"RTN","BMXADOX1",270,0)
; IF THE TRANSACTION FAILED, AN ERROR MSG WILL BE IN THE OUT ARRAY
"RTN","BMXADOX1",271,0)
;
"RTN","BMXADOX1",272,0)
N OUT,%,SIEN,NODE
"RTN","BMXADOX1",273,0)
S SIEN=$$SCHEMA("UPDATE MEASUREMENTS")
"RTN","BMXADOX1",274,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOX1",275,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOX1",276,0)
S ^TMP("BMX ADO",$J,NODE)="^`2^`1^`71164^175.75"_$C(30)
"RTN","BMXADOX1",277,0)
D DISP(OUT) R %:$G(DTIME,60) ; DISPLAY THE INPUT ARRAY BEFORE UPDATING THE RECORD
"RTN","BMXADOX1",278,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) ; EP FOR UPDAING THE RECORD
"RTN","BMXADOX1",279,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX1",280,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) ; SEND BACK AN ACKNOWLEDGEMENT OR ERROR MSG
"RTN","BMXADOX1",281,0)
Q
"RTN","BMXADOX1",282,0)
;
"RTN","BMXADOX1",283,0)
DELREC ; DELETE AN ENTRY
"RTN","BMXADOX1",284,0)
; THE SIMPLEST WAY TO DELETE AN ENTRY IS TO PUT THE RECORD IEN IN THE DA STRING PRECEDED BY A MINUS SIGN
"RTN","BMXADOX1",285,0)
; YOU CAN ALSO SET THE VALUE OF THE .01 FIELD TO "@"
"RTN","BMXADOX1",286,0)
; IF THE VALUE OF THE .01 FIELD IS NULL AND THE DA STRING IS NOT PRECEDED BY A MINUS SIGN, THE TRANSACTION WILL BE CANCELLED
"RTN","BMXADOX1",287,0)
; IF THE DA STRING IS NULL, THE TRANSACTION WILL BE CANCELLED
"RTN","BMXADOX1",288,0)
N OUT,%,SIEN,NODE,DEL
"RTN","BMXADOX1",289,0)
S DEL=51385
"RTN","BMXADOX1",290,0)
S SIEN=$$SCHEMA("UPDATE MEASUREMENTS")
"RTN","BMXADOX1",291,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOX1",292,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOX1",293,0)
S ^TMP("BMX ADO",$J,NODE)="-"_DEL_$C(30)
"RTN","BMXADOX1",294,0)
D DISP(OUT) R %:$G(DTIME,60) ; DISPLAY THE INPUT ARRAY BEFORE UPDATING THE RECORD
"RTN","BMXADOX1",295,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) ; EP FOR UPDAING THE RECORD
"RTN","BMXADOX1",296,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX1",297,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) ; SEND BACK AN ACKNOWLEDGEMENT OR ERROR MSG
"RTN","BMXADOX1",298,0)
Q
"RTN","BMXADOX1",299,0)
;
"RTN","BMXADOX1",300,0)
EDIT ; EDIT AN EXISTING ENTRY
"RTN","BMXADOX1",301,0)
; SIMILAR TO ABOVE EXCEPT THAT THE FIRST "^" PIECE OF THE DATA NODE IS THE IEN OF THE RECORD TO BE EDITIED
"RTN","BMXADOX1",302,0)
; NOTE THAT THERE IS NO '`' IN FRONT OF THE FIRST PIECE. IT IS A PURE INTEGER
"RTN","BMXADOX1",303,0)
N OUT,%,SIEN,NODE
"RTN","BMXADOX1",304,0)
S SIEN=$$SCHEMA("UPDATE MEASUREMENTS")
"RTN","BMXADOX1",305,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOX1",306,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOX1",307,0)
S ^TMP("BMX ADO",$J,NODE)="51385^^^^176^`6"_$C(30)
"RTN","BMXADOX1",308,0)
D DISP(OUT) R %:$G(DTIME,60) ; DISPLAY THE INPUT ARRAY BEFORE UPDATING THE RECORD
"RTN","BMXADOX1",309,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) ; EP FOR UPDAING THE RECORD
"RTN","BMXADOX1",310,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX1",311,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) ; SEND BACK AN ACKNOWLEDGEMENT OR ERROR MSG
"RTN","BMXADOX1",312,0)
Q
"RTN","BMXADOX1",313,0)
;
"RTN","BMXADOX1",314,0)
DELVAL ; DELETE A VALUE IN A FIELD
"RTN","BMXADOX1",315,0)
; SIMILAR TO EDIT EXCEPT THE VALUE IS "@"
"RTN","BMXADOX1",316,0)
N OUT,%,SIEN,NODE
"RTN","BMXADOX1",317,0)
S SIEN=$$SCHEMA("UPDATE MEASUREMENTS")
"RTN","BMXADOX1",318,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOX1",319,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOX1",320,0)
S ^TMP("BMX ADO",$J,NODE)="51385^^^^^@"_$C(30)
"RTN","BMXADOX1",321,0)
D DISP(OUT) R %:$G(DTIME,60) ; DISPLAY THE INPUT ARRAY BEFORE UPDATING THE RECORD
"RTN","BMXADOX1",322,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) ; EP FOR UPDAING THE RECORD
"RTN","BMXADOX1",323,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX1",324,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) ; SEND BACK AN ACKNOWLEDGEMENT OR ERROR MSG
"RTN","BMXADOX1",325,0)
Q
"RTN","BMXADOX2")
0^76^B11989229
"RTN","BMXADOX2",1,0)
BMXADOX2 ; IHS/CIHA/GIS - RPC CALL: GENERATE AN ADO SCHEMA STRING AND DATA SET ;
"RTN","BMXADOX2",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXADOX2",3,0)
; EXMAPLES OF FILEMAN SCHEMA GENERATION
"RTN","BMXADOX2",4,0)
;
"RTN","BMXADOX2",5,0)
DISP(OUT) ;
"RTN","BMXADOX2",6,0)
D DISP^BMXADOX(OUT)
"RTN","BMXADOX2",7,0)
Q
"RTN","BMXADOX2",8,0)
;
"RTN","BMXADOX2",9,0)
SCHEMA(NAME) ; GIVEN SCHEMA NAME, RETURN THE IEN
"RTN","BMXADOX2",10,0)
N IEN
"RTN","BMXADOX2",11,0)
S IEN=$O(^BMXADO("B",NAME,0))
"RTN","BMXADOX2",12,0)
Q IEN
"RTN","BMXADOX2",13,0)
;
"RTN","BMXADOX2",14,0)
; ---------------------------------------- LISTS ------------------------------------------
"RTN","BMXADOX2",15,0)
;
"RTN","BMXADOX2",16,0)
FIFOLIST N OUT,%,SIEN,NODE,NEXT
"RTN","BMXADOX2",17,0)
S NEXT="70470;8"
"RTN","BMXADOX2",18,0)
S SIEN=$$SCHEMA("VEN MOJO LIST DE FIFO")
"RTN","BMXADOX2",19,0)
D SS^BMXADO(.OUT,SIEN,"","~~~") ; GET ENCOUNTER LIST TO BE PROCESSED BY DATA ENTRY
"RTN","BMXADOX2",20,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX2",21,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX2",22,0)
Q
"RTN","BMXADOX2",23,0)
;
"RTN","BMXADOX2",24,0)
PROBLIST ; LIST PROBLEMS
"RTN","BMXADOX2",25,0)
S SIEN=$$SCHEMA("VEN MOJO DE DX PROBLEM")
"RTN","BMXADOX2",26,0)
D SS^BMXADO(.OUT,SIEN,"","AC~5~5~") ; GET PROBLEM LIST TO BE PROCESSED BY DATA ENTRY
"RTN","BMXADOX2",27,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX2",28,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX2",29,0)
Q
"RTN","BMXADOX2",30,0)
;
"RTN","BMXADOX2",31,0)
PTLIST ; LIST PATIENT WITH A SPECIFIC LOOKUP VALUE
"RTN","BMXADOX2",32,0)
N VAL
"RTN","BMXADOX2",33,0)
R "PATIENT: ",VAL:DTIME E Q
"RTN","BMXADOX2",34,0)
I '$L(VAL) Q
"RTN","BMXADOX2",35,0)
I VAL?1."^" Q
"RTN","BMXADOX2",36,0)
S SIEN=$$SCHEMA("VEN MOJO LIST PATIENTS")
"RTN","BMXADOX2",37,0)
D SS^BMXADO(.OUT,SIEN,"","~~~~~PT~BMXADOV2~"_VAL)
"RTN","BMXADOX2",38,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX2",39,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX2",40,0)
Q
"RTN","BMXADOX2",41,0)
;
"RTN","BMXADOX2",42,0)
CLINLIST ; LIST CLINICS
"RTN","BMXADOX2",43,0)
S SIEN=$$SCHEMA("VEN MOJO LIST CLINICS")
"RTN","BMXADOX2",44,0)
D SS^BMXADO(.OUT,SIEN,"","B~~~") ; GET PROBLEM LIST TO BE PROCESSED BY DATA ENTRY
"RTN","BMXADOX2",45,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX2",46,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX2",47,0)
Q
"RTN","BMXADOX2",48,0)
;
"RTN","BMXADOX2",49,0)
SEGLIST ; LIST DE SEGMENTS
"RTN","BMXADOX2",50,0)
S SIEN=$$SCHEMA("VEN MOJO DE SEGMENT")
"RTN","BMXADOX2",51,0)
D SS^BMXADO(.OUT,SIEN,"","~~~") ; GET PROBLEM LIST TO BE PROCESSED BY DATA ENTRY
"RTN","BMXADOX2",52,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX2",53,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX2",54,0)
Q
"RTN","BMXADOX2",55,0)
;
"RTN","BMXADOX2",56,0)
NOTELIST ; LIST NOTES
"RTN","BMXADOX2",57,0)
;N SIEN
"RTN","BMXADOX2",58,0)
;D NOTELIST^VENPCCTG(.OUT,"70470")
"RTN","BMXADOX2",59,0)
;D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX2",60,0)
;K ^TMP("BMX ADO",$J)
"RTN","BMXADOX2",61,0)
Q
"RTN","BMXADOX2",62,0)
;
"RTN","BMXADOX2",63,0)
PRVLIST ; PROVIDER LIST
"RTN","BMXADOX2",64,0)
N SIEN,OUT
"RTN","BMXADOX2",65,0)
S SIEN=$$SCHEMA("VEN MOJO LIST PROVIDERS")
"RTN","BMXADOX2",66,0)
D SS^BMXADO(.OUT,SIEN,"","B~~~5000") ; GET NOTE LIST TO BE PROCESSED BY DATA ENTRY
"RTN","BMXADOX2",67,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX2",68,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX2",69,0)
Q
"RTN","BMXADOX2",70,0)
;
"RTN","BMXADOX2",71,0)
MLIST ; LIST MEASUREMNTS
"RTN","BMXADOX2",72,0)
S SIEN=$$SCHEMA("VEN MOJO LIST MEASUREMENTS")
"RTN","BMXADOX2",73,0)
D SS^BMXADO(.OUT,SIEN,"","B~~~") ; GET PROBLEM LIST TO BE PROCESSED BY DATA ENTRY
"RTN","BMXADOX2",74,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX2",75,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX2",76,0)
Q
"RTN","BMXADOX2",77,0)
;
"RTN","BMXADOX2",78,0)
RXLIST ; A RX LIST FOR A PATIENT
"RTN","BMXADOX2",79,0)
N SIEN,OUT
"RTN","BMXADOX2",80,0)
S SIEN=$$SCHEMA("VEN MOJO RX LIST")
"RTN","BMXADOX2",81,0)
D SS^BMXADO(.OUT,SIEN,"","~~~~~MED~MOJORX~3") ; GET RX LIST
"RTN","BMXADOX2",82,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX2",83,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX2",84,0)
Q
"RTN","BMXADOX2",85,0)
;
"RTN","BMXADOX2",86,0)
TQLIST ; TABLET QUEUE LIST
"RTN","BMXADOX2",87,0)
N SIEN,OUT
"RTN","BMXADOX2",88,0)
S SIEN=$$SCHEMA("VEN MOJO LIST TABLET QUEUE")
"RTN","BMXADOX2",89,0)
D SS^BMXADO(.OUT,SIEN,"","ATS~~~") ; GET PATIENT LIST
"RTN","BMXADOX2",90,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX2",91,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX2",92,0)
Q
"RTN","BMXADOX2",93,0)
;
"RTN","BMXADOX2",94,0)
UHCLIST ; LIST HIDDEN COLUMNS
"RTN","BMXADOX2",95,0)
N SIEN,OUT
"RTN","BMXADOX2",96,0)
; S SIEN=$$SCHEMA("VEN MOJO DE GFMT UHC")
"RTN","BMXADOX2",97,0)
D SS^BMXADO(.OUT,"VEN MOJO DE FMT GRID","","~~~") ; GET RX LIST
"RTN","BMXADOX2",98,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX2",99,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX2",100,0)
Q
"RTN","BMXADOX2",101,0)
;
"RTN","BMXADOX2",102,0)
GSEGLIST ; LIST GRID PROPERTIES FOR SEGMENTS
"RTN","BMXADOX2",103,0)
N SIEN,OUT
"RTN","BMXADOX2",104,0)
D SS^BMXADO(.OUT,"VEN MOJO DE GRID FMT","","B~~~") ; GET RX LIST
"RTN","BMXADOX2",105,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX2",106,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX2",107,0)
Q
"RTN","BMXADOX2",108,0)
;
"RTN","BMXADOX2",109,0)
ICDLIST ; LIST ICD CODE MATCHES
"RTN","BMXADOX2",110,0)
;N NARR,OUT
"RTN","BMXADOX2",111,0)
;W !,"Provider narrative: " R NARR:60 E Q
"RTN","BMXADOX2",112,0)
;I '$L(NARR) Q
"RTN","BMXADOX2",113,0)
;D ICDMATCH^VENPCCTP(.OUT,NARR) W !!
"RTN","BMXADOX2",114,0)
;D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX2",115,0)
;K ^TMP("BMX ADO",$J)
"RTN","BMXADOX2",116,0)
Q
"RTN","BMXADOX2",117,0)
;
"RTN","BMXADOX2",118,0)
IMAGE ; LIST SEGMENT IMAGE CONTROL PARAMETERS
"RTN","BMXADOX2",119,0)
N SIEN,OUT
"RTN","BMXADOX2",120,0)
D SS^BMXADO(.OUT,"VEN MOJO DE SEG IMAGE","1,","~~~") ; GET RX LIST
"RTN","BMXADOX2",121,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOX2",122,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOX2",123,0)
Q
"RTN","BMXADOXX")
0^77^B166011930
"RTN","BMXADOXX",1,0)
BMXADOXX ; IHS/CIHA/GIS - RPC CALL: GENERATE AN ADO SCHEMA STRING AND DATA SET ;
"RTN","BMXADOXX",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXADOXX",3,0)
; EXMAPLES OF RPMS SCHEMAE GENERATION
"RTN","BMXADOXX",4,0)
;
"RTN","BMXADOXX",5,0)
;
"RTN","BMXADOXX",6,0)
ADDPAT ;
"RTN","BMXADOXX",7,0)
N OUT,%,SIEN,DFN,NODE
"RTN","BMXADOXX",8,0)
;S DFN=9285
"RTN","BMXADOXX",9,0)
S SIEN=$$SCHEMA("UPDATE VA PATIENT")
"RTN","BMXADOXX",10,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOXX",11,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOXX",12,0)
S ^TMP("BMX ADO",$J,NODE)="^KANGAROO,KAP^M^1-1-83^151515555"_$C(30)
"RTN","BMXADOXX",13,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",14,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
"RTN","BMXADOXX",15,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",16,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
"RTN","BMXADOXX",17,0)
;
"RTN","BMXADOXX",18,0)
Q
"RTN","BMXADOXX",19,0)
;
"RTN","BMXADOXX",20,0)
DISP(OUT) ; TEMP DISPLAY
"RTN","BMXADOXX",21,0)
N I,X
"RTN","BMXADOXX",22,0)
S I=0 W !
"RTN","BMXADOXX",23,0)
F S I=$O(@OUT@(I)) Q:'I S X=@OUT@(I) S X=$TR(X,$C(30),"}") S X=$TR(X,$C(31),"{") W !,X
"RTN","BMXADOXX",24,0)
Q
"RTN","BMXADOXX",25,0)
;
"RTN","BMXADOXX",26,0)
SCHEMA(NAME) ; GIVEN SCHEMA NAME, RETURN THE IEN
"RTN","BMXADOXX",27,0)
N IEN
"RTN","BMXADOXX",28,0)
S IEN=$O(^BMXADO("B",NAME,0))
"RTN","BMXADOXX",29,0)
Q IEN
"RTN","BMXADOXX",30,0)
;
"RTN","BMXADOXX",31,0)
NEXTNUM(DFN,LOC) ; RETURN THE NEXT PROBLEM NUMBER FOR A PATIENT
"RTN","BMXADOXX",32,0)
N X,LAST,MAX,NUM
"RTN","BMXADOXX",33,0)
S NUM=0,MAX=""
"RTN","BMXADOXX",34,0)
F S NUM=$O(^AUPNPROB("AA",DFN,LOC,NUM)) Q:NUM="" S X=$E(NUM,2,99) I +X>MAX S MAX=+X
"RTN","BMXADOXX",35,0)
I 'MAX Q 1
"RTN","BMXADOXX",36,0)
S X=X+1 S X=X\1
"RTN","BMXADOXX",37,0)
Q X
"RTN","BMXADOXX",38,0)
;
"RTN","BMXADOXX",39,0)
DEMOG ; VIEW DEMOGRAPHICS
"RTN","BMXADOXX",40,0)
N OUT,%,DFN,MAX,SIEN
"RTN","BMXADOXX",41,0)
S DFN=1373,MAX=1000
"RTN","BMXADOXX",42,0)
S SIEN=$$SCHEMA("UPDATE PATIENT DEMOGRAPHICS")
"RTN","BMXADOXX",43,0)
D SS^BMXADO(.OUT,SIEN,"",("~"_DFN_"~"_DFN_"~"_MAX))
"RTN","BMXADOXX",44,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",45,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",46,0)
Q
"RTN","BMXADOXX",47,0)
;
"RTN","BMXADOXX",48,0)
MEDICARE ; UPDATE MEDICARE DATES/INFO
"RTN","BMXADOXX",49,0)
N OUT,%,DAS,PIEN,JIEN,DFN,MAX
"RTN","BMXADOXX",50,0)
S DFN=1,MAX=1000
"RTN","BMXADOXX",51,0)
S DAS=DFN_","
"RTN","BMXADOXX",52,0)
S PIEN=$$SCHEMA("UPDATE MEDICARE DATES")
"RTN","BMXADOXX",53,0)
S JIEN=$$SCHEMA("UPDATE MEDICARE INFO")
"RTN","BMXADOXX",54,0)
D SS^BMXADO(.OUT,PIEN,DAS,("~"_DFN_"~"_DFN_"~"_MAX_"~~"_"MEDICARE~BMXADOV2~~"_JIEN_",PARENT"))
"RTN","BMXADOXX",55,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",56,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",57,0)
Q
"RTN","BMXADOXX",58,0)
;
"RTN","BMXADOXX",59,0)
MEDICAID ; VIEW MEDICAID DATES/INFO
"RTN","BMXADOXX",60,0)
N OUT,%,DAS,PIEN,JIEN,DFN,DA
"RTN","BMXADOXX",61,0)
S DFN=322
"RTN","BMXADOXX",62,0)
S DA(1)=$$MCDIEN^BMXADOV2(DFN) I 'DA(1) Q
"RTN","BMXADOXX",63,0)
S DAS=DA(1)_","
"RTN","BMXADOXX",64,0)
S PIEN=$$SCHEMA("UPDATE MEDICAID DATES")
"RTN","BMXADOXX",65,0)
S JIEN=$$SCHEMA("UPDATE MEDICAID INFO")
"RTN","BMXADOXX",66,0)
D SS^BMXADO(.OUT,PIEN,DAS,("~~~~~MEDICAID~BMXADOV2~~"_JIEN_",PARENT"))
"RTN","BMXADOXX",67,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",68,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",69,0)
Q
"RTN","BMXADOXX",70,0)
;
"RTN","BMXADOXX",71,0)
PVTINS ; VIEW PRIVATE INSURANCE DATES/INFO
"RTN","BMXADOXX",72,0)
N OUT,%,DAS,SIEN,DFN
"RTN","BMXADOXX",73,0)
S DFN=96
"RTN","BMXADOXX",74,0)
S DAS=DFN_","
"RTN","BMXADOXX",75,0)
S SIEN=$$SCHEMA("UPDATE PVT INSURANCE INFO")
"RTN","BMXADOXX",76,0)
D SS^BMXADO(.OUT,SIEN,DAS,"~~~~~PVTINS~BMXADOV2~~")
"RTN","BMXADOXX",77,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",78,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",79,0)
Q
"RTN","BMXADOXX",80,0)
;
"RTN","BMXADOXX",81,0)
VISIT ; VIEW VISITS
"RTN","BMXADOXX",82,0)
N OUT,%,SIEN,DFN
"RTN","BMXADOXX",83,0)
S DFN=9285
"RTN","BMXADOXX",84,0)
S SIEN=$$SCHEMA("VISITS")
"RTN","BMXADOXX",85,0)
D SS^BMXADO(.OUT,SIEN,"","AA~3/21/1968~6/4/2004~100~~~~9285|C")
"RTN","BMXADOXX",86,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",87,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",88,0)
Q
"RTN","BMXADOXX",89,0)
;
"RTN","BMXADOXX",90,0)
DUPVIS ; DISPLAY POSSIBLE DUPLICATE VISITS
"RTN","BMXADOXX",91,0)
N OUT,%,SIEN,DFN
"RTN","BMXADOXX",92,0)
S DFN=9285
"RTN","BMXADOXX",93,0)
S SIEN=$$SCHEMA("VISITS")
"RTN","BMXADOXX",94,0)
D SS^BMXADO(.OUT,SIEN,"","~~~~~DUPV~BMXADOV2~9285|5/24/04@1PM|I|516|~")
"RTN","BMXADOXX",95,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",96,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",97,0)
Q
"RTN","BMXADOXX",98,0)
;
"RTN","BMXADOXX",99,0)
ADDVIS ; ADD A NEW VISIT
"RTN","BMXADOXX",100,0)
N OUT,%,SIEN,DFN,NODE
"RTN","BMXADOXX",101,0)
S DFN=9285
"RTN","BMXADOXX",102,0)
S SIEN=$$SCHEMA("VISITS")
"RTN","BMXADOXX",103,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOXX",104,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOXX",105,0)
S ^TMP("BMX ADO",$J,NODE)="^JUN 03, 2004@01:32^I^`9285^`516^A^`2"_$C(30)
"RTN","BMXADOXX",106,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",107,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
"RTN","BMXADOXX",108,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",109,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
"RTN","BMXADOXX",110,0)
Q
"RTN","BMXADOXX",111,0)
;
"RTN","BMXADOXX",112,0)
POV ; DISPLAY POVS
"RTN","BMXADOXX",113,0)
N OUT,%,SIEN,DFN
"RTN","BMXADOXX",114,0)
S DFN=9285
"RTN","BMXADOXX",115,0)
S SIEN=$$SCHEMA("VIEW POVS")
"RTN","BMXADOXX",116,0)
D SS^BMXADO(.OUT,SIEN,"","AA~3/21/1965~6/4/2004~100~~~~9285|C")
"RTN","BMXADOXX",117,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",118,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",119,0)
Q
"RTN","BMXADOXX",120,0)
;
"RTN","BMXADOXX",121,0)
ADDPOV ; ADD A POV TO AN EXISITING VISIT
"RTN","BMXADOXX",122,0)
N OUT,%,SIEN,DFN,NODE
"RTN","BMXADOXX",123,0)
S DFN=9285
"RTN","BMXADOXX",124,0)
S SIEN=$$SCHEMA("UPDATE POVS")
"RTN","BMXADOXX",125,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOXX",126,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOXX",127,0)
S ^TMP("BMX ADO",$J,NODE)="^`8718^`9285^`8337^DM II ON EXPMTL MEDS^2^P"_$C(30)
"RTN","BMXADOXX",128,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",129,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
"RTN","BMXADOXX",130,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",131,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
"RTN","BMXADOXX",132,0)
Q
"RTN","BMXADOXX",133,0)
;
"RTN","BMXADOXX",134,0)
EDITPOV ; ADD A POV TO AN EXISITING VISIT
"RTN","BMXADOXX",135,0)
N OUT,%,SIEN,DFN,NODE
"RTN","BMXADOXX",136,0)
S DFN=1
"RTN","BMXADOXX",137,0)
S SIEN=$$SCHEMA("UPDATE POVS")
"RTN","BMXADOXX",138,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOXX",139,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOXX",140,0)
S ^TMP("BMX ADO",$J,NODE)="2815^`8718^`9285^`8337^DM II ON SPECIAL MEDS^2^P"_$C(30)
"RTN","BMXADOXX",141,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",142,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
"RTN","BMXADOXX",143,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",144,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
"RTN","BMXADOXX",145,0)
Q
"RTN","BMXADOXX",146,0)
;
"RTN","BMXADOXX",147,0)
PROB ; DISPLAY PROBLEMS
"RTN","BMXADOXX",148,0)
N OUT,%,SIEN,DFN
"RTN","BMXADOXX",149,0)
S DFN=1373
"RTN","BMXADOXX",150,0)
S SIEN=$$SCHEMA("VIEW PROBLEMS")
"RTN","BMXADOXX",151,0)
D SS^BMXADO(.OUT,SIEN,"","AA~"_DFN_"~"_DFN_"~~~~~")
"RTN","BMXADOXX",152,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",153,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",154,0)
Q
"RTN","BMXADOXX",155,0)
;
"RTN","BMXADOXX",156,0)
ADDPROB ; ADD A PROBLEM TO THE PROBLEM LIST
"RTN","BMXADOXX",157,0)
N OUT,%,SIEN,DFN,NODE,NUM,LOC,ICD,TEXT,AIR,IEN
"RTN","BMXADOXX",158,0)
S ICD=2477
"RTN","BMXADOXX",159,0)
S TEXT="HYPERTENSION ON SPECIAL MEDS"
"RTN","BMXADOXX",160,0)
S DFN=1373,LOC=DUZ(2)
"RTN","BMXADOXX",161,0)
S SIEN=$$SCHEMA("UPDATE PROBLEMS")
"RTN","BMXADOXX",162,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOXX",163,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOXX",164,0)
S ^TMP("BMX ADO",$J,NODE)=U_"`"_ICD_U_"`"_DFN_U_DT_U_U_TEXT_U_"`"_LOC_U_DT_U_$C(30)
"RTN","BMXADOXX",165,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",166,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
"RTN","BMXADOXX",167,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",168,0)
S IEN=+$P(OUT(1),"|",2) I '$D(^AUPNPROB(IEN,0)) Q
"RTN","BMXADOXX",169,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
"RTN","BMXADOXX",170,0)
K OUT
"RTN","BMXADOXX",171,0)
S NUM=$$NEXTNUM(DFN,LOC) I 'NUM Q
"RTN","BMXADOXX",172,0)
S SIEN=$$SCHEMA("UPDATE PROBLEM NUMBER")
"RTN","BMXADOXX",173,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOXX",174,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOXX",175,0)
S ^TMP("BMX ADO",$J,NODE)=IEN_U_NUM_U_"A"_$C(30)
"RTN","BMXADOXX",176,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",177,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
"RTN","BMXADOXX",178,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",179,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
"RTN","BMXADOXX",180,0)
Q
"RTN","BMXADOXX",181,0)
;
"RTN","BMXADOXX",182,0)
MEAS ; DISPLAY MEASUREMENTS
"RTN","BMXADOXX",183,0)
N OUT,%,SIEN,DFN
"RTN","BMXADOXX",184,0)
S DFN=2
"RTN","BMXADOXX",185,0)
S SIEN=$$SCHEMA("VIEW MEASUREMENTS")
"RTN","BMXADOXX",186,0)
D SS^BMXADO(.OUT,SIEN,"","AA~3/21/1965~6/4/2004~10~~~~"_DFN_"|WT|C")
"RTN","BMXADOXX",187,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",188,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",189,0)
Q
"RTN","BMXADOXX",190,0)
;
"RTN","BMXADOXX",191,0)
ADDMEAS ; UPDATE V MEASUREMENT FILE
"RTN","BMXADOXX",192,0)
N OUT,%,SIEN,DFN,NODE
"RTN","BMXADOXX",193,0)
S DFN=2
"RTN","BMXADOXX",194,0)
S SIEN=$$SCHEMA("UPDATE MEASUREMENTS")
"RTN","BMXADOXX",195,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOXX",196,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOXX",197,0)
S ^TMP("BMX ADO",$J,NODE)="^`2^`"_DFN_"^`7806^172.75"_$C(30)
"RTN","BMXADOXX",198,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",199,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
"RTN","BMXADOXX",200,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",201,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
"RTN","BMXADOXX",202,0)
Q
"RTN","BMXADOXX",203,0)
;
"RTN","BMXADOXX",204,0)
MEDS ; DISPLAY MEDS
"RTN","BMXADOXX",205,0)
N OUT,%,SIEN,DFN
"RTN","BMXADOXX",206,0)
S DFN=152
"RTN","BMXADOXX",207,0)
S SIEN=$$SCHEMA("VIEW MEDS")
"RTN","BMXADOXX",208,0)
D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1969~12/31/2004~10~~~~"_DFN_"|C")
"RTN","BMXADOXX",209,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",210,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",211,0)
Q
"RTN","BMXADOXX",212,0)
;
"RTN","BMXADOXX",213,0)
ADDMEDS ; UPDATE V MED FILE
"RTN","BMXADOXX",214,0)
N OUT,%,SIEN,DFN,NODE
"RTN","BMXADOXX",215,0)
S DFN=2
"RTN","BMXADOXX",216,0)
S SIEN=$$SCHEMA("UPDATE MEDS")
"RTN","BMXADOXX",217,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOXX",218,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOXX",219,0)
S ^TMP("BMX ADO",$J,NODE)="^`305^`"_DFN_"^`7806^T1T QID^40"_$C(30)
"RTN","BMXADOXX",220,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",221,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
"RTN","BMXADOXX",222,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",223,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
"RTN","BMXADOXX",224,0)
Q
"RTN","BMXADOXX",225,0)
;
"RTN","BMXADOXX",226,0)
LAB ; DISPLAY LAB TEST RESULTS
"RTN","BMXADOXX",227,0)
N OUT,%,SIEN,DFN
"RTN","BMXADOXX",228,0)
S DFN=280
"RTN","BMXADOXX",229,0)
S SIEN=$$SCHEMA("VIEW LABS")
"RTN","BMXADOXX",230,0)
D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1965~12/31/2003~10~~~~"_DFN_"|175|C")
"RTN","BMXADOXX",231,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",232,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",233,0)
Q
"RTN","BMXADOXX",234,0)
;
"RTN","BMXADOXX",235,0)
ADDLAB ; UPDATE V LAB
"RTN","BMXADOXX",236,0)
N OUT,%,SIEN,DFN,NODE
"RTN","BMXADOXX",237,0)
S DFN=2
"RTN","BMXADOXX",238,0)
S SIEN=$$SCHEMA("UPDATE LABS")
"RTN","BMXADOXX",239,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOXX",240,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOXX",241,0)
S ^TMP("BMX ADO",$J,NODE)="^`175^`"_DFN_"^`7806^216"_$C(30)
"RTN","BMXADOXX",242,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",243,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
"RTN","BMXADOXX",244,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",245,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
"RTN","BMXADOXX",246,0)
Q
"RTN","BMXADOXX",247,0)
;
"RTN","BMXADOXX",248,0)
EXAMS ; DISPLAY EXAMS
"RTN","BMXADOXX",249,0)
N OUT,%,SIEN,DFN
"RTN","BMXADOXX",250,0)
S DFN=1373
"RTN","BMXADOXX",251,0)
S SIEN=$$SCHEMA("VIEW EXAMS")
"RTN","BMXADOXX",252,0)
D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1966~12/31/2003~10~~~~"_DFN_"|6|C")
"RTN","BMXADOXX",253,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",254,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",255,0)
Q
"RTN","BMXADOXX",256,0)
;
"RTN","BMXADOXX",257,0)
ADDEXAMS ; UPDATE V EXAM
"RTN","BMXADOXX",258,0)
S DFN=2
"RTN","BMXADOXX",259,0)
S SIEN=$$SCHEMA("UPDATE EXAMS")
"RTN","BMXADOXX",260,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOXX",261,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOXX",262,0)
S ^TMP("BMX ADO",$J,NODE)="^`6^`"_DFN_"^`7806^NORMAL"_$C(30)
"RTN","BMXADOXX",263,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",264,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
"RTN","BMXADOXX",265,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",266,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
"RTN","BMXADOXX",267,0)
Q
"RTN","BMXADOXX",268,0)
;
"RTN","BMXADOXX",269,0)
IMM ; DISPLAY IMMUNIZATIONS
"RTN","BMXADOXX",270,0)
N OUT,%,SIEN,DFN
"RTN","BMXADOXX",271,0)
S DFN=54
"RTN","BMXADOXX",272,0)
S SIEN=$$SCHEMA("VIEW IMM")
"RTN","BMXADOXX",273,0)
D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1966~12/31/2003~10~~~~"_DFN_"|101|C")
"RTN","BMXADOXX",274,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",275,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",276,0)
Q
"RTN","BMXADOXX",277,0)
;
"RTN","BMXADOXX",278,0)
PROV ; DISPLAY PROVIDERS FOR A VISIT
"RTN","BMXADOXX",279,0)
N OUT,%,SIEN,VIEN
"RTN","BMXADOXX",280,0)
S VIEN=4703
"RTN","BMXADOXX",281,0)
S SIEN=$$SCHEMA("VIEW PROV")
"RTN","BMXADOXX",282,0)
D SS^BMXADO(.OUT,SIEN,"","AD~"_VIEN_"~"_VIEN_"~10~~~~")
"RTN","BMXADOXX",283,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",284,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",285,0)
Q
"RTN","BMXADOXX",286,0)
;
"RTN","BMXADOXX",287,0)
ADDPROV ; UPDATE V PROVIDER FILE
"RTN","BMXADOXX",288,0)
N OUT,%,SIEN,NODE,PIEN,DFN
"RTN","BMXADOXX",289,0)
S PIEN=DUZ,DFN=2
"RTN","BMXADOXX",290,0)
I $P(^DD(9000010.06,.01,0),U,3)["DIC(6" S PIEN=$P(^VA(200,PIEN,0),U,16) ; CONVERT FILE 200 TO FILE 16 IF NECESS.
"RTN","BMXADOXX",291,0)
S SIEN=$$SCHEMA("UPDATE PROV")
"RTN","BMXADOXX",292,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOXX",293,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOXX",294,0)
S ^TMP("BMX ADO",$J,NODE)="^`"_PIEN_"^`"_DFN_"^`7806^P"_$C(30)
"RTN","BMXADOXX",295,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",296,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
"RTN","BMXADOXX",297,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",298,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
"RTN","BMXADOXX",299,0)
Q
"RTN","BMXADOXX",300,0)
;
"RTN","BMXADOXX",301,0)
PROC ; DISPLAY PROCEDURES
"RTN","BMXADOXX",302,0)
N OUT,%,SIEN,DFN
"RTN","BMXADOXX",303,0)
S DFN=235
"RTN","BMXADOXX",304,0)
S SIEN=$$SCHEMA("VIEW PROCEDURES")
"RTN","BMXADOXX",305,0)
D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1965~12/31/2003~10~~~~"_DFN_"|C")
"RTN","BMXADOXX",306,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",307,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",308,0)
Q
"RTN","BMXADOXX",309,0)
;
"RTN","BMXADOXX",310,0)
ADDPROC ; UPDATE V PROCEDURES FILE
"RTN","BMXADOXX",311,0)
N OUT,%,SIEN,DFN,NODE
"RTN","BMXADOXX",312,0)
S DFN=2
"RTN","BMXADOXX",313,0)
S SIEN=$$SCHEMA("UPDATE PROCEDURES")
"RTN","BMXADOXX",314,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOXX",315,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOXX",316,0)
S ^TMP("BMX ADO",$J,NODE)="^`2198^`"_DFN_"^`7806^`8718"_$C(30)
"RTN","BMXADOXX",317,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",318,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
"RTN","BMXADOXX",319,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",320,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
"RTN","BMXADOXX",321,0)
Q
"RTN","BMXADOXX",322,0)
;
"RTN","BMXADOXX",323,0)
CPT ; DISPLAY CPT CODES
"RTN","BMXADOXX",324,0)
N OUT,%,SIEN,DFN
"RTN","BMXADOXX",325,0)
S VIEN=8082
"RTN","BMXADOXX",326,0)
S SIEN=$$SCHEMA("VIEW CPT")
"RTN","BMXADOXX",327,0)
D SS^BMXADO(.OUT,SIEN,"","AD~"_VIEN_"~"_VIEN_"~10~~~~")
"RTN","BMXADOXX",328,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",329,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",330,0)
Q
"RTN","BMXADOXX",331,0)
;
"RTN","BMXADOXX",332,0)
ADDCPT ; UPDATE V CPT FILE
"RTN","BMXADOXX",333,0)
N OUT,%,SIEN,DFN,NODE
"RTN","BMXADOXX",334,0)
S DFN=2
"RTN","BMXADOXX",335,0)
S SIEN=$$SCHEMA("UPDATE CPT")
"RTN","BMXADOXX",336,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOXX",337,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOXX",338,0)
S ^TMP("BMX ADO",$J,NODE)="^`10000^`"_DFN_"^`7806"_$C(30)
"RTN","BMXADOXX",339,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",340,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
"RTN","BMXADOXX",341,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",342,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
"RTN","BMXADOXX",343,0)
Q
"RTN","BMXADOXX",344,0)
;
"RTN","BMXADOXX",345,0)
PH ; DISPLAY PERSONAL HISTORY
"RTN","BMXADOXX",346,0)
N OUT,%,SIEN,DFN
"RTN","BMXADOXX",347,0)
S DFN=1373
"RTN","BMXADOXX",348,0)
S SIEN=$$SCHEMA("VIEW PERSONAL HISTORY")
"RTN","BMXADOXX",349,0)
D SS^BMXADO(.OUT,SIEN,"","AC~"_DFN_"~"_DFN_"~~~~~")
"RTN","BMXADOXX",350,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",351,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",352,0)
Q
"RTN","BMXADOXX",353,0)
;
"RTN","BMXADOXX",354,0)
ADDPH ; UPDATE PERSONAL HX
"RTN","BMXADOXX",355,0)
N OUT,%,SIEN,DFN,NODE,ICD,TEXT
"RTN","BMXADOXX",356,0)
S ICD=2477
"RTN","BMXADOXX",357,0)
S TEXT="PERSONAL HISTORY OF SERIOUS PROBLEMS"
"RTN","BMXADOXX",358,0)
S DFN=2
"RTN","BMXADOXX",359,0)
S SIEN=$$SCHEMA("UPDATE PERSONAL HISTORY")
"RTN","BMXADOXX",360,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOXX",361,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOXX",362,0)
S ^TMP("BMX ADO",$J,NODE)="^`11353^`"_DFN_"^2851219^"_TEXT_"^2810303"_$C(30)
"RTN","BMXADOXX",363,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",364,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
"RTN","BMXADOXX",365,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",366,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
"RTN","BMXADOXX",367,0)
Q
"RTN","BMXADOXX",368,0)
;
"RTN","BMXADOXX",369,0)
FH ; DISPLAY FAMILY HX
"RTN","BMXADOXX",370,0)
N OUT,%,SIEN,DFN
"RTN","BMXADOXX",371,0)
S DFN=631
"RTN","BMXADOXX",372,0)
S SIEN=$$SCHEMA("VIEW FAMILY HISTORY")
"RTN","BMXADOXX",373,0)
D SS^BMXADO(.OUT,SIEN,"","AC~"_DFN_"~"_DFN_"~~~~~")
"RTN","BMXADOXX",374,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",375,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",376,0)
Q
"RTN","BMXADOXX",377,0)
;
"RTN","BMXADOXX",378,0)
ADDFH ; UPDATE FAMILY HISTORY
"RTN","BMXADOXX",379,0)
N OUT,%,SIEN,DFN,NODE,ICD,TEXT
"RTN","BMXADOXX",380,0)
S ICD=2477
"RTN","BMXADOXX",381,0)
S TEXT="FAMILY HISTORY OF SERIOUS PROBLEMS"
"RTN","BMXADOXX",382,0)
S DFN=2
"RTN","BMXADOXX",383,0)
S SIEN=$$SCHEMA("UPDATE FAMILY HISTORY")
"RTN","BMXADOXX",384,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOXX",385,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOXX",386,0)
S ^TMP("BMX ADO",$J,NODE)="^`7571^`"_DFN_"^2851219^"_TEXT_$C(30)
"RTN","BMXADOXX",387,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",388,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
"RTN","BMXADOXX",389,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",390,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
"RTN","BMXADOXX",391,0)
Q
"RTN","BMXADOXX",392,0)
;
"RTN","BMXADOXX",393,0)
HF ; DISPLAY HEALTH FACTORS
"RTN","BMXADOXX",394,0)
N OUT,%,SIEN,DFN
"RTN","BMXADOXX",395,0)
S DFN=2390
"RTN","BMXADOXX",396,0)
S SIEN=$$SCHEMA("VIEW HEALTH FACTORS")
"RTN","BMXADOXX",397,0)
D SS^BMXADO(.OUT,SIEN,"","AC"_"~"_DFN_"~"_DFN_"~~~~~")
"RTN","BMXADOXX",398,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",399,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",400,0)
Q
"RTN","BMXADOXX",401,0)
;
"RTN","BMXADOXX",402,0)
ADDHF ; UPDATE HEALTH FACTORS FILE
"RTN","BMXADOXX",403,0)
N OUT,%,SIEN,DFN,NODE
"RTN","BMXADOXX",404,0)
S DFN=2
"RTN","BMXADOXX",405,0)
S SIEN=$$SCHEMA("UPDATE HEALTH FACTORS")
"RTN","BMXADOXX",406,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOXX",407,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOXX",408,0)
S ^TMP("BMX ADO",$J,NODE)="^`3^`"_DFN_U_DT_$C(30)
"RTN","BMXADOXX",409,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",410,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
"RTN","BMXADOXX",411,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",412,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
"RTN","BMXADOXX",413,0)
Q
"RTN","BMXADOXX",414,0)
;
"RTN","BMXADOXX",415,0)
REPRO ; DISPLAY REPRODUCTIVE FACTORS
"RTN","BMXADOXX",416,0)
N OUT,%,SIEN,DFN
"RTN","BMXADOXX",417,0)
S DFN=1373
"RTN","BMXADOXX",418,0)
S SIEN=$$SCHEMA("VIEW REPRODUCTIVE FACTORS")
"RTN","BMXADOXX",419,0)
D SS^BMXADO(.OUT,SIEN,"","B"_"~"_DFN_"~"_DFN_"~~~~~")
"RTN","BMXADOXX",420,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",421,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",422,0)
Q
"RTN","BMXADOXX",423,0)
;
"RTN","BMXADOXX",424,0)
ADDREPRO ; UPDATE REPRODUCTIVE FACTORS
"RTN","BMXADOXX",425,0)
; THE .O1 FIELD IS DINUMED
"RTN","BMXADOXX",426,0)
; THEREFORE, THE FILER WILL AUTOMATICALLY SWITCH TO MOD MODE IF A RECORD ALREADY EXISTS FOR THIS PATIENT
"RTN","BMXADOXX",427,0)
N OUT,%,SIEN,DFN,NODE
"RTN","BMXADOXX",428,0)
S DFN=2
"RTN","BMXADOXX",429,0)
; I $D(^AUPNREP(DFN)) G ERF
"RTN","BMXADOXX",430,0)
S SIEN=$$SCHEMA("UPDATE REPRODUCTIVE FACTORS")
"RTN","BMXADOXX",431,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOXX",432,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOXX",433,0)
S ^TMP("BMX ADO",$J,NODE)="^`"_DFN_"^G5P4LC3SA1TA0^"_DT_"^2^3040101^"_DT_$C(30)
"RTN","BMXADOXX",434,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXX",435,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
"RTN","BMXADOXX",436,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXX",437,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
"RTN","BMXADOXX",438,0)
Q
"RTN","BMXADOXX",439,0)
;
"RTN","BMXADOXY")
0^78^B61093377
"RTN","BMXADOXY",1,0)
BMXADOXY ; IHS/CIHA/GIS - RPC CALL: GENERATE AN ADO SCHEMA STRING AND DATA SET ;
"RTN","BMXADOXY",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXADOXY",3,0)
; EXMAPLES OF FILEMAN SCHEMA GENERATION
"RTN","BMXADOXY",4,0)
;
"RTN","BMXADOXY",5,0)
;
"RTN","BMXADOXY",6,0)
;
"RTN","BMXADOXY",7,0)
DISP(OUT) ; TEMP DISPLAY OF THE ANR
"RTN","BMXADOXY",8,0)
N I,X
"RTN","BMXADOXY",9,0)
S I=0 W !
"RTN","BMXADOXY",10,0)
F S I=$O(@OUT@(I)) Q:'I S X=@OUT@(I) S X=$TR(X,$C(30),"}") S X=$TR(X,$C(31),"{") W !,X
"RTN","BMXADOXY",11,0)
Q
"RTN","BMXADOXY",12,0)
;
"RTN","BMXADOXY",13,0)
SCHEMA(NAME) ; GIVEN SCHEMA NAME, RETURN THE IEN
"RTN","BMXADOXY",14,0)
N IEN
"RTN","BMXADOXY",15,0)
S IEN=$O(^BMXADO("B",NAME,0))
"RTN","BMXADOXY",16,0)
Q IEN
"RTN","BMXADOXY",17,0)
;
"RTN","BMXADOXY",18,0)
NUM ; ITERATE BY IEN
"RTN","BMXADOXY",19,0)
; IX="",START WITH IEN=1, STOP AFTER IEN=20, MAX # RECORDS RETURNED = 5
"RTN","BMXADOXY",20,0)
; TO VIEW INTERNAL VALUES SET VSTG="~1~20~5~I"
"RTN","BMXADOXY",21,0)
N OUT,%,SIEN
"RTN","BMXADOXY",22,0)
S SIEN=$$SCHEMA("IHS PATIENT")
"RTN","BMXADOXY",23,0)
D SS^BMXADO(.OUT,SIEN,"","~1~20~5")
"RTN","BMXADOXY",24,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXY",25,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXY",26,0)
Q
"RTN","BMXADOXY",27,0)
;
"RTN","BMXADOXY",28,0)
IX ; ITERATE BY INDEX
"RTN","BMXADOXY",29,0)
; ITERATE USING THE "B" INDEX
"RTN","BMXADOXY",30,0)
; START WITH PT NAME "C", STOP AFTER PATIENT NAME = "D", MAX # RECORDS RETURNED = 5
"RTN","BMXADOXY",31,0)
N OUT,%,SIEN
"RTN","BMXADOXY",32,0)
S SIEN=$$SCHEMA("IHS PATIENT")
"RTN","BMXADOXY",33,0)
D SS^BMXADO(.OUT,SIEN,"","B~C~D~5")
"RTN","BMXADOXY",34,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXY",35,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXY",36,0)
Q
"RTN","BMXADOXY",37,0)
;
"RTN","BMXADOXY",38,0)
RENT ; ITERATE IN CHUNKS
"RTN","BMXADOXY",39,0)
; RE-ITERATE USING THE "B" INDEX
"RTN","BMXADOXY",40,0)
; START WITH PT IEN 5 AS THE "SEED", STOP AFTER PATIENT NAME = "D", MAX # RECORDS RETURNED = 5
"RTN","BMXADOXY",41,0)
N OUT,%,SIEN,SEED,LSEED,X,Y
"RTN","BMXADOXY",42,0)
S SEED=0,LSEED=""
"RTN","BMXADOXY",43,0)
S SIEN=$$SCHEMA("IHS PATIENT")
"RTN","BMXADOXY",44,0)
RIT F D I '$G(SEED) Q
"RTN","BMXADOXY",45,0)
. D SS^BMXADO(.OUT,SIEN,SEED,"B~CA~CB~5")
"RTN","BMXADOXY",46,0)
. D DISP(OUT) R %:$G(DTIME,60) E S SEED="" Q
"RTN","BMXADOXY",47,0)
. I %?1"^" S SEED="" Q
"RTN","BMXADOXY",48,0)
. S X=$P(@OUT@(1),U,1)
"RTN","BMXADOXY",49,0)
. S SEED=$P(X,"|",3)
"RTN","BMXADOXY",50,0)
. I SEED=LSEED S SEED="" Q
"RTN","BMXADOXY",51,0)
. S LSEED=SEED
"RTN","BMXADOXY",52,0)
. K ^TMP("BMX ADO",$J)
"RTN","BMXADOXY",53,0)
. Q
"RTN","BMXADOXY",54,0)
Q
"RTN","BMXADOXY",55,0)
;
"RTN","BMXADOXY",56,0)
SUB ; SUBFILE ITERATION
"RTN","BMXADOXY",57,0)
; THE SCHEMA IS ATTACHED TO THE MEDICARE ELIGIBILITY FILE/ELIG DATE SUBFILE
"RTN","BMXADOXY",58,0)
; THE DA STRING HAS A VALUE OF '4,',: THE IEN IN THE PARENT FILE (PATIENT DFN).
"RTN","BMXADOXY",59,0)
; NOTE THE COMMA IN THE DA STRING. THIS INDICATES THAT THE FILE IEN IS 4 BUT THE SUBFILE IEN IS UNSPECIFIED
"RTN","BMXADOXY",60,0)
N OUT,%,SIEN
"RTN","BMXADOXY",61,0)
S SIEN=$$SCHEMA("UPDATE MEDICARE DATES")
"RTN","BMXADOXY",62,0)
;D SS^BMXADO(.OUT,SIEN,"1,","~~~")
"RTN","BMXADOXY",63,0)
D SS^BMXADO(.OUT,18,"1,","~~~")
"RTN","BMXADOXY",64,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXY",65,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXY",66,0)
Q
"RTN","BMXADOXY",67,0)
;
"RTN","BMXADOXY",68,0)
DINUM ; DINUMED POINTER ITERATION
"RTN","BMXADOXY",69,0)
; THE SCHEMA IS ATTACHED TO THE PATIENT FILE (9000001)
"RTN","BMXADOXY",70,0)
; THE PATIENT FILE IS DINUM'D AND ITS .01 FIELD POINTS TO THE VA PATIENT FILE (2)
"RTN","BMXADOXY",71,0)
; BECAUSE OF THE SPECIAL RELATIONSHIP BETWEEN THE FILES, WE CAN USE THE B INDEX OF FILE 2 TO ITERATE FILE 9000001.
"RTN","BMXADOXY",72,0)
N OUT,%,SIEN
"RTN","BMXADOXY",73,0)
S SIEN=$$SCHEMA("IHS PATIENT")
"RTN","BMXADOXY",74,0)
D SS^BMXADO(.OUT,SIEN,"","B~A~B~5")
"RTN","BMXADOXY",75,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXY",76,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXY",77,0)
Q
"RTN","BMXADOXY",78,0)
;
"RTN","BMXADOXY",79,0)
IXP ; INDEXED POINTER ITERATION
"RTN","BMXADOXY",80,0)
; THE SCHEMA IS ATTACHED TO THE V POV FILE
"RTN","BMXADOXY",81,0)
; THE AC CROSS REFERENCE INDEXES THE PATIENT FIELD
"RTN","BMXADOXY",82,0)
; BY STARTING AND STOPING WITH PATIENT 235 (MAX=5) WE COLLECT THE FIRST 5 POVS FOR PATIENT 235 IN THE FILE
"RTN","BMXADOXY",83,0)
N OUT,%,SIEN
"RTN","BMXADOXY",84,0)
S SIEN=$$SCHEMA("VIEW POVS")
"RTN","BMXADOXY",85,0)
D SS^BMXADO(.OUT,SIEN,"","AC~235~235~5")
"RTN","BMXADOXY",86,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXY",87,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXY",88,0)
Q
"RTN","BMXADOXY",89,0)
;
"RTN","BMXADOXY",90,0)
AA ; ITERATE USING AA INDEX
"RTN","BMXADOXY",91,0)
; INDEX IS 'AA" THE START AND STOP DATES ARE SPECIFIED IN EXTERNAL FORMAT. MAX=10
"RTN","BMXADOXY",92,0)
; THE FOLLOWING FILTERS ARE SPECIFIED IN THE LAST PARAMETER ("235|WT|C"):
"RTN","BMXADOXY",93,0)
; 235=PATIENT DFN #235
"RTN","BMXADOXY",94,0)
; WT=RETURN ONLY WEIGHTS. MEASUREMENT TYPE MUST BE SPECIFIED WITH A VALID, UNAMBIGUOUS LOOKUP VALUE.
"RTN","BMXADOXY",95,0)
; C=RETRUN VALUES IN CHRONOLOGICAL ORDER USE 'R' INSTEAD OF 'C' FOR REVERSE CHRONOLOGICAL ORDER. DEFAULT=C
"RTN","BMXADOXY",96,0)
; THE SEED PARAMTER IS SET AND CAN BE USED TO RETURN DATA IN CHUNKS
"RTN","BMXADOXY",97,0)
N OUT,%,SIEN
"RTN","BMXADOXY",98,0)
S SIEN=$$SCHEMA("VIEW MEASUREMENTS")
"RTN","BMXADOXY",99,0)
D SS^BMXADO(.OUT,SIEN,"","AA~3/21/1965~6/4/2004~5~~~~235|WT|C")
"RTN","BMXADOXY",100,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXY",101,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXY",102,0)
Q
"RTN","BMXADOXY",103,0)
;
"RTN","BMXADOXY",104,0)
AA2 ; ITERATE USING AA INDEX
"RTN","BMXADOXY",105,0)
; THIS SCHEMA IS ATTACHED TO THE VISIT FILE (9000010)
"RTN","BMXADOXY",106,0)
; IN THIS CASE THERE IS NO ATTRIBUTE TYPE SO THE FILTER PARAM HAS ONLY 2 PIECES "1|R"
"RTN","BMXADOXY",107,0)
; 235=PATIENT DFN
"RTN","BMXADOXY",108,0)
; R=RETURN DATA IN REVERSE CHRONOLOGICAL ORDER
"RTN","BMXADOXY",109,0)
N OUT,%,SIEN
"RTN","BMXADOXY",110,0)
S SIEN=$$SCHEMA("VISITS") ;12
"RTN","BMXADOXY",111,0)
D SS^BMXADO(.OUT,SIEN,"","AA~3/21/1965~6/4/2004~5~~~~235|R")
"RTN","BMXADOXY",112,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXY",113,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXY",114,0)
Q
"RTN","BMXADOXY",115,0)
;
"RTN","BMXADOXY",116,0)
CIT ; CUSTOM ITERATOR
"RTN","BMXADOXY",117,0)
; IF COMPLEX OR UNUSUAL SORTING/FILTERING IS REQUITED, USE A CUSTOM ITERATOR
"RTN","BMXADOXY",118,0)
; THE CUSTOM ITERATOR IS DEFINED BY 6TH, 7TH AND 8TH PIECES IN THE VSTG
"RTN","BMXADOXY",119,0)
; PIECE 8=TAG, PIECE 9=ROUTINE, PIECE 8=A PARAMETER PASSED TO THE ENTRY POINT
"RTN","BMXADOXY",120,0)
; THE 9TH PIECE CONTAINS PT DFN, TIMESTAMP, VISIT TYPE, LOC IEN, AND SERVICE CATEGORY IN A "|" DELIMTED STRING
"RTN","BMXADOXY",121,0)
; THE ITERATOR CALL TAG^ROUTINE(PARAM) TO GENERATE IENS
"RTN","BMXADOXY",122,0)
; IN THIS CASE THE SCHEMA IS ATTACHED TO THE VISIT FILE.
"RTN","BMXADOXY",123,0)
; GIVEN THE INFORMATION IN THE PARAMETER, THE CUSTOM ITERATOR RETURNS POSSIBLE DUPLICATE VISITS
"RTN","BMXADOXY",124,0)
N OUT,%,SIEN
"RTN","BMXADOXY",125,0)
S SIEN=$$SCHEMA("VISITS")
"RTN","BMXADOXY",126,0)
D SS^BMXADO(.OUT,SIEN,"","~~~~~DUPV~BMXADOV2~9285|5/24/04@1PM|I|516|~")
"RTN","BMXADOXY",127,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXY",128,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXY",129,0)
Q
"RTN","BMXADOXY",130,0)
;
"RTN","BMXADOXY",131,0)
ID ; IDENTIFIER FIELD
"RTN","BMXADOXY",132,0)
; THE SCHEMA IS ATTACHED TO THE VA PATIENT FILE (2)
"RTN","BMXADOXY",133,0)
; THE SCHEMA HAS A BUILT IN FIELD (.01ID) THAT RETURNS THE IDENTIFIERS
"RTN","BMXADOXY",134,0)
; THE ENTRY POINT THAT GENERATES THE IDETIFIERS IS STORED IN THE BMX ADO SCHEMA FILE
"RTN","BMXADOXY",135,0)
; PATIENT DFN=235
"RTN","BMXADOXY",136,0)
N OUT,%,SIEN
"RTN","BMXADOXY",137,0)
S SIEN=$$SCHEMA("UPDATE PATIENT DEMOGRAPHICS")
"RTN","BMXADOXY",138,0)
D SS^BMXADO(.OUT,SIEN,"","~235~235~")
"RTN","BMXADOXY",139,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXY",140,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXY",141,0)
Q
"RTN","BMXADOXY",142,0)
;
"RTN","BMXADOXY",143,0)
JSTD ; STANDARD JOIN
"RTN","BMXADOXY",144,0)
; BY SPECIFYING A JOIN IN THE VSTG, MULTIPLE SCHEMAE AND DATA SETS ARE RETURNED IN ONE PASS
"RTN","BMXADOXY",145,0)
; THE SCHEMA IS ATTACHED TO THE V MEASUREMENT FILE
"RTN","BMXADOXY",146,0)
; THIS IS JOINED TO A SECOND FILE, THE VA PATIENT FILE VIA A JOIN
"RTN","BMXADOXY",147,0)
; THE JOIN IS BASTED ON THE FACT THAT THE PATIENT FIELD (.02) IN THE V MEASUREMENT FILE POINTS TO THE VA PATIENT FILE
"RTN","BMXADOXY",148,0)
; THE JOIN PARAMETER IS THE 9TH PIECE OF THE VSTG. IT CONSISTS OF 2 PIECES DELIMITED BY A ","
"RTN","BMXADOXY",149,0)
; PIECE 1 IS THE SCHEMA THAT YOU ARE JOINING TO
"RTN","BMXADOXY",150,0)
; PIECE 2 IS THE FIELD IN THE PRIMARY FILE THAT ENABLES THE JOIN
"RTN","BMXADOXY",151,0)
; THE DATA SET FROM THE SECOND (JOIN) FILE CONTAINS ONLY THOSE RECORDS NECESSARY TO COMPLETE THE JOIN
"RTN","BMXADOXY",152,0)
; PATIENT DFN=235, INDEX=AA, MAX=5, START=3/21/65, STOP=6/4/04
"RTN","BMXADOXY",153,0)
N OUT,%,SIEN1,SIEN2
"RTN","BMXADOXY",154,0)
S SIEN2=$$SCHEMA("VIEW MEASUREMENTS")
"RTN","BMXADOXY",155,0)
S SIEN1=$$SCHEMA("PATIENT DEMOGRAPHICS")
"RTN","BMXADOXY",156,0)
;SIEN1=23, SIEN2=11
"RTN","BMXADOXY",157,0)
;D SS^BMXADO(.OUT,SIEN1,"","AA~3/21/1965~6/4/2004~5~~~~234|WT|C~"_SIEN2_",.02")
"RTN","BMXADOXY",158,0)
D SS^BMXADO(.OUT,SIEN1,"","~234~236~~~~~~"_SIEN2_",.01")
"RTN","BMXADOXY",159,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXY",160,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXY",161,0)
Q
"RTN","BMXADOXY",162,0)
;
"RTN","BMXADOXY",163,0)
HWSTD ;
"RTN","BMXADOXY",164,0)
; PATIENT DFN=235, INDEX=AA, MAX=5, START=3/21/65, STOP=6/4/04
"RTN","BMXADOXY",165,0)
N OUT,%,SIEN1,SIEN2
"RTN","BMXADOXY",166,0)
S SIEN1=$$SCHEMA("PATIENT DEMOGRAPHICS")
"RTN","BMXADOXY",167,0)
S SIEN2=$$SCHEMA("VIEW MEASUREMENTS")
"RTN","BMXADOXY",168,0)
;SIEN2=23, SIEN1=11
"RTN","BMXADOXY",169,0)
D SS^BMXADO(.OUT,SIEN1,"","~235~250~~~~~~"_SIEN2_",.01")
"RTN","BMXADOXY",170,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXY",171,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXY",172,0)
Q
"RTN","BMXADOXY",173,0)
;
"RTN","BMXADOXY",174,0)
JMD ;JOIN MASTER TO DETAIL
"RTN","BMXADOXY",175,0)
N OUT,%,SIEN1,SIEN2,SIEN3,VSTG
"RTN","BMXADOXY",176,0)
S SIEN1=$$SCHEMA("PATIENT DEMOGRAPHICS")
"RTN","BMXADOXY",177,0)
S SIEN2=$$SCHEMA("VIEW MEASUREMENTS")
"RTN","BMXADOXY",178,0)
S SIEN3=$$SCHEMA("VIEW MEDS")
"RTN","BMXADOXY",179,0)
S VSTG="~1~5~~~~~~"
"RTN","BMXADOXY",180,0)
;S VSTG=VSTG_SIEN3_",.001,.02IEN,AA~1/1/1960~6/30/2004~~~~~|C"
"RTN","BMXADOXY",181,0)
S VSTG=VSTG_SIEN3_",.001,.02IEN,AA~1/1/1960~6/30/2004~~~~~|C"
"RTN","BMXADOXY",182,0)
;S VSTG="~1~5~~~~~~23,.001,.02IEN,AA~1/1/1960~6/30/2004~~~~~|WT|C"
"RTN","BMXADOXY",183,0)
;BMX ADO SS^11^^~1~5~~~~~~23,.001,.02IEN,AA~1/1/1960~6/30/2004~~~~~|WT|C
"RTN","BMXADOXY",184,0)
;BMX ADO SS^11^^~1~5~~~~~~25,.001,.02IEN,AA~1/1/1960~6/30/2004~~~~~|C
"RTN","BMXADOXY",185,0)
D SS^BMXADO(.OUT,SIEN1,"",VSTG)
"RTN","BMXADOXY",186,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXY",187,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXY",188,0)
Q
"RTN","BMXADOXY",189,0)
;
"RTN","BMXADOXY",190,0)
JSUB ; SUBFILE JOIN
"RTN","BMXADOXY",191,0)
; IN THIS CASE THE RECORDS IN A PARENT FILE ARE "JOINED" TO THE RECORDS IN ONE OF ITS SUB FILES
"RTN","BMXADOXY",192,0)
; THE SCHEMA IS ATTACHED TO THE "MEDICARE ELIGIBLE" FILE
"RTN","BMXADOXY",193,0)
; IT IS JOINED TO ITS SUBFILE, "ELIG DATES", VIA THE UPDATE MEDICARE DATES SCHEMA
"RTN","BMXADOXY",194,0)
; THE SYNTAX FOR THE JOIN PIECE IS "sien2,SUB" WHERE sien2=IEN OF SECOND SCHEMA
"RTN","BMXADOXY",195,0)
; PATIENT DFN=4
"RTN","BMXADOXY",196,0)
N OUT,%,SIEN1,SIEN2
"RTN","BMXADOXY",197,0)
S SIEN1=$$SCHEMA("UPDATE MEDICARE INFO") ;17
"RTN","BMXADOXY",198,0)
S SIEN2=$$SCHEMA("UPDATE MEDICARE DATES") ;18
"RTN","BMXADOXY",199,0)
;BMX ADO SS^17^^~4~5~~~~~~18,SUB
"RTN","BMXADOXY",200,0)
D SS^BMXADO(.OUT,SIEN1,"","~4~5~~~~~~"_SIEN2_",SUB")
"RTN","BMXADOXY",201,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXY",202,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXY",203,0)
Q
"RTN","BMXADOXY",204,0)
;
"RTN","BMXADOXY",205,0)
JPAR ; PARENT FILE JOIN
"RTN","BMXADOXY",206,0)
; SIMILAR TO A SUBFILE JOIN EXCEPT THE SUB-FILE IS TREATED AS THE PRIMARY FILE AND IT IS JOINED TO ITS PARENT
"RTN","BMXADOXY",207,0)
; BECAUSE WE ARE STARTING IN A SUBFILE, THE DA STRING CONTAINS THE IEN OF THE PARENT FILE ("4,"
"RTN","BMXADOXY",208,0)
; THE SYNTAX OF THE 9TH PIECE IS "sien2,PARENT" WHERE sien2 IS THE IEN OF THE SECONDARY SCHEMA
"RTN","BMXADOXY",209,0)
; PATIENT DFN=4
"RTN","BMXADOXY",210,0)
N OUT,%,SIEN1,SIEN2
"RTN","BMXADOXY",211,0)
S SIEN1=$$SCHEMA("UPDATE MEDICARE DATES")
"RTN","BMXADOXY",212,0)
S SIEN2=$$SCHEMA("UPDATE MEDICARE INFO")
"RTN","BMXADOXY",213,0)
D SS^BMXADO(.OUT,SIEN1,"4,","~~~5~~~~~"_SIEN2_",PARENT")
"RTN","BMXADOXY",214,0)
D DISP(OUT) R %:$G(DTIME,60)
"RTN","BMXADOXY",215,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXY",216,0)
Q
"RTN","BMXADOXY",217,0)
;
"RTN","BMXADOXY",218,0)
ADD ; ADD A NEW ENTRY
"RTN","BMXADOXY",219,0)
; THIS IS A 2 STEP PROCESS:
"RTN","BMXADOXY",220,0)
; FIRST GET THE SCHEMA FOR THE FILE YOU WISH TO UPDATE
"RTN","BMXADOXY",221,0)
; THIS SCHEMA'S NAME TYPICALLY BEGINS WITH THE WORD "UPDATE"
"RTN","BMXADOXY",222,0)
; IT CONTAINS NO ID OR IEN FIELDS
"RTN","BMXADOXY",223,0)
; SECOND ADD THE DATA NODE TO THE ARRAY
"RTN","BMXADOXY",224,0)
; IT HAS THE SAME FORMAT AS A DATA STRING ASSOCIATED WITH THE SCHEMA EXCEPT THE FIRST "^" PIECE IS NULL
"RTN","BMXADOXY",225,0)
; THIS PIECE CORRESPONDS TO THE IEN OF THE RECORD. SINCE THE RECORD HAS NOT BEEN ADDED YET, IT IS NULL.
"RTN","BMXADOXY",226,0)
; IN THE DATA STRING, ALL POINTER VALUES ARE PRECEDED BY THE '`' CHARACTER AND EA. STRING ENDS IN $C(30)
"RTN","BMXADOXY",227,0)
; MULTIPLE DATA STRINGS CAN BE APPENDED AS NEW NODES AT THE BOTTOM OF THE ARRAY
"RTN","BMXADOXY",228,0)
; IN THIS CASE WE ARE ADDING A RECORD TO THE V MEASUREMENT FILE
"RTN","BMXADOXY",229,0)
; DATA STRING="^MEASUREMENT TYPE IEN^PATIENT DFN^VISIT IEN^RESULT"_$C(30)
"RTN","BMXADOXY",230,0)
; THERE ARE 2 INPUT PARAMS:
"RTN","BMXADOXY",231,0)
; THE CLOSED REF WHERE THE INPUT ARRAY IS STORED
"RTN","BMXADOXY",232,0)
; SINCE IT IS PASSED BY REFERENCE "OUT" CAN BE NULL OR UNDEFIEND.
"RTN","BMXADOXY",233,0)
; OUT WILL BE DEFINED AT THE CONCLUSION OF THE TRANSACTION.
"RTN","BMXADOXY",234,0)
; THE OUTPUT IS IN THE OUT ARRAY
"RTN","BMXADOXY",235,0)
; OUT(1)="OK|ien" WHERE ien IS THE IEN OF THE RECORD THAT HAS BEE ADDED.
"RTN","BMXADOXY",236,0)
; IF THE TRANSACTION FAILED, AN ERROR MSG WILL BE IN THE OUT ARRAY
"RTN","BMXADOXY",237,0)
; MEASUREMENT TYPE=2, PATIENT DFN=2, VISIT IEN=7806, PATIENT'S WEIGHT=172.75
"RTN","BMXADOXY",238,0)
N OUT,%,SIEN,NODE,DFN
"RTN","BMXADOXY",239,0)
S DFN=2
"RTN","BMXADOXY",240,0)
S SIEN=$$SCHEMA("UPDATE MEASUREMENTS")
"RTN","BMXADOXY",241,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOXY",242,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOXY",243,0)
S ^TMP("BMX ADO",$J,NODE)="^`2^`"_DFN_"^`7806^172.75"_$C(30)
"RTN","BMXADOXY",244,0)
D DISP(OUT) R %:$G(DTIME,60) ; DISPLAY THE INPUT ARRAY BEFORE UPDATING THE RECORD
"RTN","BMXADOXY",245,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) ; EP FOR UPDAING THE RECORD
"RTN","BMXADOXY",246,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXY",247,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) ; SEND BACK AN ACKNOWLEDGEMENT OR ERROR MSG
"RTN","BMXADOXY",248,0)
Q
"RTN","BMXADOXY",249,0)
;
"RTN","BMXADOXY",250,0)
DEL ; DELETE A RECORD
"RTN","BMXADOXY",251,0)
; THE SIPLEST WAY TO DELETE AN ENTRY IS TO PUT THE RECORD IEN IN THE DA STRING PRECEDED BY A MINUS SIGN
"RTN","BMXADOXY",252,0)
; YOU CAN ALSO SET THE VALUE OF THE .01 FIELD TO "@"
"RTN","BMXADOXY",253,0)
; IF THE VALUE OF THE .01 FIELD IS NULL AND THE DA STRING IS NOT PRECEDED BY A MINUS SIGN, THE TRANSACTION WILL BE CANCELLED
"RTN","BMXADOXY",254,0)
; IF THE DA STRING IS NULL, THE TRANSACTION WILL BE CANCELLED
"RTN","BMXADOXY",255,0)
; IN THIS EXAMPLE, WE DELETE A V MEASUREMENT RECORD THAT WAS JUST ADDED
"RTN","BMXADOXY",256,0)
N OUT,%,SIEN,NODE,DEL
"RTN","BMXADOXY",257,0)
S DEL=1621
"RTN","BMXADOXY",258,0)
S SIEN=$$SCHEMA("UPDATE MEASUREMENTS")
"RTN","BMXADOXY",259,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOXY",260,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOXY",261,0)
S ^TMP("BMX ADO",$J,NODE)="-"_DEL_$C(30)
"RTN","BMXADOXY",262,0)
D DISP(OUT) R %:$G(DTIME,60) ; DISPLAY THE INPUT ARRAY BEFORE UPDATING THE RECORD
"RTN","BMXADOXY",263,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) ; EP FOR UPDAING THE RECORD
"RTN","BMXADOXY",264,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXY",265,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) ; SEND BACK AN ACKNOWLEDGEMENT OR ERROR MSG
"RTN","BMXADOXY",266,0)
Q
"RTN","BMXADOXY",267,0)
;
"RTN","BMXADOXY",268,0)
EDIT ; EDIT AN EXISTING ENTRY
"RTN","BMXADOXY",269,0)
; SIMILAR TO ABOVE EXCEPT THAT THE FIRST "^" PIECE OF THE DATA NODE IS THE IEN OF THE RECORD TO BE EDITIED
"RTN","BMXADOXY",270,0)
; NOTE THAT THERE IS NO '`' IN FRONT OF THE FIRST PIECE. IT IS A PURE INTEGER
"RTN","BMXADOXY",271,0)
; LAB TEST=175, PATIENT DFN=2, VISIT IEN=8040, PT'S GLUCOSE=276, ANORMAL="ABNORMAL"
"RTN","BMXADOXY",272,0)
N OUT,%,SIEN,NODE
"RTN","BMXADOXY",273,0)
S SIEN=$$SCHEMA("UPDATE LABS")
"RTN","BMXADOXY",274,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOXY",275,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOXY",276,0)
S ^TMP("BMX ADO",$J,NODE)="279^`175^`2^`8040^280^H"_$C(30)
"RTN","BMXADOXY",277,0)
D DISP(OUT) R %:$G(DTIME,60) ; DISPLAY THE INPUT ARRAY BEFORE UPDATING THE RECORD
"RTN","BMXADOXY",278,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) ; EP FOR UPDAING THE RECORD
"RTN","BMXADOXY",279,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXY",280,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) ; SEND BACK AN ACKNOWLEDGEMENT OR ERROR MSG
"RTN","BMXADOXY",281,0)
Q
"RTN","BMXADOXY",282,0)
;
"RTN","BMXADOXY",283,0)
DELVAL ; DELETE A VALUE IN A FIELD
"RTN","BMXADOXY",284,0)
; SIMILAR TO EDIT EXCEPT THE VALUE IS "@"
"RTN","BMXADOXY",285,0)
; DELETE WILL BE ABORTED IF IF FILEMAN SAYS THIS IS A REQUIRED FIELD
"RTN","BMXADOXY",286,0)
N OUT,%,SIEN,NODE
"RTN","BMXADOXY",287,0)
S SIEN=$$SCHEMA("UPDATE LABS")
"RTN","BMXADOXY",288,0)
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
"RTN","BMXADOXY",289,0)
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
"RTN","BMXADOXY",290,0)
S ^TMP("BMX ADO",$J,NODE)="279^`175^`2^`8040^^@"_$C(30)
"RTN","BMXADOXY",291,0)
D DISP(OUT) R %:$G(DTIME,60) ; DISPLAY THE INPUT ARRAY BEFORE UPDATING THE RECORD
"RTN","BMXADOXY",292,0)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) ; EP FOR UPDAING THE RECORD
"RTN","BMXADOXY",293,0)
K ^TMP("BMX ADO",$J)
"RTN","BMXADOXY",294,0)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) ; SEND BACK AN ACKNOWLEDGEMENT OR ERROR MSG
"RTN","BMXADOXY",295,0)
Q
"RTN","BMXADOXY",296,0)
;
"RTN","BMXE01")
0^114^B6931626
"RTN","BMXE01",1,0)
BMXE01 ; IHS/OIT/FJE - ENVIRONMENT CHECK FOR BMX 2.0 ;
"RTN","BMXE01",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXE01",3,0)
;
"RTN","BMXE01",4,0)
S $P(LINE,"*",81)=""
"RTN","BMXE01",5,0)
S XPDNOQUE="NO QUE" ;NO QUEUING ALLOWED
"RTN","BMXE01",6,0)
S XPDABORT=0
"RTN","BMXE01",7,0)
I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." S XPX="DUZ" D SORRY Q
"RTN","BMXE01",8,0)
;
"RTN","BMXE01",9,0)
I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." S XPX="DUZ" D SORRY Q
"RTN","BMXE01",10,0)
;
"RTN","BMXE01",11,0)
D HOME^%ZIS,DT^DICRW
"RTN","BMXE01",12,0)
S X=$P($G(^VA(200,DUZ,0)),U)
"RTN","BMXE01",13,0)
I $G(X)="" W !,"Who are you????" S XPX="DUZ" D SORRY Q
"RTN","BMXE01",14,0)
W !,"Hello, "_$P(X,",",2)_" "_$P(X,",")
"RTN","BMXE01",15,0)
W !!,"Checking Environment for Install of Version "_$P($T(+2),";",3)_" of "_$P($T(+2),";",4)_"."
"RTN","BMXE01",16,0)
;
"RTN","BMXE01",17,0)
S X=$G(^DD("VERSION"))
"RTN","BMXE01",18,0)
W !!,"Need at least FileMan 22.....FileMan "_X_" Present"
"RTN","BMXE01",19,0)
I X<22 S XPX="FM" D SORRY Q
"RTN","BMXE01",20,0)
;
"RTN","BMXE01",21,0)
S X=$G(^DIC(9.4,$O(^DIC(9.4,"C","XU",0)),"VERSION"))
"RTN","BMXE01",22,0)
W !!,"Need at least Kernel 8.0.....Kernel "_X_" Present"
"RTN","BMXE01",23,0)
I +X<8 S XPX="KERNEL" D SORRY Q
"RTN","BMXE01",24,0)
;
"RTN","BMXE01",25,0)
S X=$G(^DIC(9.4,$O(^DIC(9.4,"C","XB",0)),"VERSION"))
"RTN","BMXE01",26,0)
W !!,"Need at least XB/ZIB 3.....XB/ZIB "_X_" Present"
"RTN","BMXE01",27,0)
I +X<2 S XPX="XB" D SORRY Q
"RTN","BMXE01",28,0)
q
"RTN","BMXE01",29,0)
ENVOK ; If this is just an environ check, end here.
"RTN","BMXE01",30,0)
W !!,"ENVIRONMENT OK."
"RTN","BMXE01",31,0)
;
"RTN","BMXE01",32,0)
; The following line prevents the "Disable Options..." and "Move
"RTN","BMXE01",33,0)
; Routines..." questions from being asked during the install.
"RTN","BMXE01",34,0)
I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
"RTN","BMXE01",35,0)
I $G(XPDENV)=1 D ;Updates BMX Version file
"RTN","BMXE01",36,0)
.S X="2",DIC="^BMXAPPL(",DLAYGO=90093.2,DIC(0)="E" K DD,D0 D FILE^DICN
"RTN","BMXE01",37,0)
.S DA=+Y
"RTN","BMXE01",38,0)
.S:+DA DIE="^BMXAPPL(",DR=".02///0;.03////"_DT D ^DIE
"RTN","BMXE01",39,0)
.K DIE,DA
"RTN","BMXE01",40,0)
Q
"RTN","BMXE01",41,0)
SORRY ;
"RTN","BMXE01",42,0)
K DIFQ
"RTN","BMXE01",43,0)
S XPDABORT=1
"RTN","BMXE01",44,0)
W *7,!!!,"Sorry....something is wrong with your environment"
"RTN","BMXE01",45,0)
W !,"Aborting BMX Version 2.0 Install!"
"RTN","BMXE01",46,0)
W !,"Correct error and reinstall otherwise"
"RTN","BMXE01",47,0)
W !,"please print/capture this screen and notify"
"RTN","BMXE01",48,0)
W !,"technical support."
"RTN","BMXE01",49,0)
W !!,LINE
"RTN","BMXE01",50,0)
D BMES^XPDUTL("Sorry....something is wrong with your environment")
"RTN","BMXE01",51,0)
D BMES^XPDUTL("Enviroment ERROR "_$G(XPX))
"RTN","BMXE01",52,0)
D BMES^XPDUTL("Aborting BMX 2.0 install!")
"RTN","BMXE01",53,0)
D BMES^XPDUTL("Correct error and reinstall otherwise")
"RTN","BMXE01",54,0)
D BMES^XPDUTL("please print/capture this screen and notify")
"RTN","BMXE01",55,0)
D BMES^XPDUTL("technical support.")
"RTN","BMXE01",56,0)
Q
"RTN","BMXE01",57,0)
;
"RTN","BMXFIND")
0^79^B45092715
"RTN","BMXFIND",1,0)
BMXFIND ; IHS/OIT/HMW - BMX GENERIC FIND ;
"RTN","BMXFIND",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXFIND",3,0)
;
"RTN","BMXFIND",4,0)
;
"RTN","BMXFIND",5,0)
TABLE(BMXGBL,BMXFL) ;EP
"RTN","BMXFIND",6,0)
;
"RTN","BMXFIND",7,0)
;---> If file number not provided check for file name.
"RTN","BMXFIND",8,0)
;S ^HW("BMXTABLE")=BMXFL
"RTN","BMXFIND",9,0)
S BMX31=$C(31)_$C(31)
"RTN","BMXFIND",10,0)
I +BMXFL'=BMXFL D
"RTN","BMXFIND",11,0)
. S BMXFL=$TR(BMXFL,"_"," ")
"RTN","BMXFIND",12,0)
. I '$D(^DIC("B",BMXFL)) S BMXFL="" Q
"RTN","BMXFIND",13,0)
. S BMXFL=$O(^DIC("B",BMXFL,0))
"RTN","BMXFIND",14,0)
I '$G(BMXFL) D ERROUT("File number not provided.",1) Q
"RTN","BMXFIND",15,0)
D FIND(.BMXGBL,BMXFL,"*",,,10,,,,1)
"RTN","BMXFIND",16,0)
Q
"RTN","BMXFIND",17,0)
;
"RTN","BMXFIND",18,0)
FIND(BMXGBL,BMXFL,BMXFLDS,BMXFLG,BMXIN,BMXMX,BMXIX,BMXSCR,BMXMC,BMXNUM) ;EP
"RTN","BMXFIND",19,0)
;
"RTN","BMXFIND",20,0)
;TODO:
"RTN","BMXFIND",21,0)
; -- Return column info even if no rows returned
"RTN","BMXFIND",22,0)
;
"RTN","BMXFIND",23,0)
;---> Places matching records from requested file into a
"RTN","BMXFIND",24,0)
;---> result global, ^BMXTEMP($J). The exact global name
"RTN","BMXFIND",25,0)
;---> is returned in the first parameter (BMXGBL).
"RTN","BMXFIND",26,0)
;---> Records are returned one per node in the result global.
"RTN","BMXFIND",27,0)
;---> Each record is terminated with a $C(30), for parsing out
"RTN","BMXFIND",28,0)
;---> on the VB side, since the Broker concatenates all nodes
"RTN","BMXFIND",29,0)
;---> into a single string when passing the data out of M.
"RTN","BMXFIND",30,0)
;---> Requested fields within records are delimited by "^".
"RTN","BMXFIND",31,0)
;---> NOTE: The first "^"-piece of every node is the IEN of
"RTN","BMXFIND",32,0)
;---> that entry in its file; the requested fields follow.
"RTN","BMXFIND",33,0)
;---> The final record (node) contains Error Delimiter,
"RTN","BMXFIND",34,0)
; $C(31)_$C(31), followed by error text, if any.
"RTN","BMXFIND",35,0)
;
"RTN","BMXFIND",36,0)
;
"RTN","BMXFIND",37,0)
;---> Parameters:
"RTN","BMXFIND",38,0)
; 1 - BMXGBL (ret) Name of result global for Broker.
"RTN","BMXFIND",39,0)
; 2 - BMXFL (req) File for lookup.
"RTN","BMXFIND",40,0)
; 3 - BMXFLDS (opt) Fields to return w/each entry.
"RTN","BMXFIND",41,0)
; 4 - BMXFLG (opt) Flags in DIC(0); If null, "M" is sent.
"RTN","BMXFIND",42,0)
; 5 - BMXIN (opt) Input to match on (see Algorithm below).
"RTN","BMXFIND",43,0)
; 6 - BMXMX (opt) Maximum number of entries to return.
"RTN","BMXFIND",44,0)
; 7 - BMXIX (opt) Indexes to search.
"RTN","BMXFIND",45,0)
; 8 - BMXSCR (opt) Screen/filter (M code).
"RTN","BMXFIND",46,0)
; 9 - BMXMC (opt) Mixed Case: 1=mixed case, 0=no change.
"RTN","BMXFIND",47,0)
; (Converts data in uppercase to mixed case.)
"RTN","BMXFIND",48,0)
; 10 - BMXNUM (opt) Include IEN in returned recordset (1=true)
"RTN","BMXFIND",49,0)
;
"RTN","BMXFIND",50,0)
;---> Set variables, kill temp globals.
"RTN","BMXFIND",51,0)
;N (BMXGBL,BMXFL,BMXFLDS,BMXFLG,BMXIN,BMXMX,BMXIX,BMXSCR,BMXMC)
"RTN","BMXFIND",52,0)
S BMX31=$C(31)_$C(31)
"RTN","BMXFIND",53,0)
S BMXGBL="^BMXTEMP("_$J_")",BMXERR="",U="^"
"RTN","BMXFIND",54,0)
K ^BMXTMP($J),^BMXTEMP($J)
"RTN","BMXFIND",55,0)
;
"RTN","BMXFIND",56,0)
;---> If file number not provided check for file name.
"RTN","BMXFIND",57,0)
I +BMXFL'=BMXFL D
"RTN","BMXFIND",58,0)
. I '$D(^DIC("B",BMXFL)) S BMXFL="" Q
"RTN","BMXFIND",59,0)
. S BMXFL=$O(^DIC("B",BMXFL,0))
"RTN","BMXFIND",60,0)
I '$G(BMXFL) D ERROUT("File number not provided.",1) Q
"RTN","BMXFIND",61,0)
;
"RTN","BMXFIND",62,0)
;---> If no fields provided, pass .01.
"RTN","BMXFIND",63,0)
;---> NOTE: If .01 is NOT included, but the Index to lookup on is
"RTN","BMXFIND",64,0)
;---> NOT on the .01, then the .01 will be returned
"RTN","BMXFIND",65,0)
;---> automatically as the second ^-piece of data in the
"RTN","BMXFIND",66,0)
;---> Result Global.
"RTN","BMXFIND",67,0)
;---> So it would be: IEN^.01^requested fields...
"RTN","BMXFIND",68,0)
I $G(BMXFLDS)="" S BMXFLDS=".01"
"RTN","BMXFIND",69,0)
;
"RTN","BMXFIND",70,0)
;---> If no index or flag provided, set flag="M".
"RTN","BMXFIND",71,0)
I $G(BMXFLG)="" D
"RTN","BMXFIND",72,0)
.I $G(BMXIX)="" S BMXFLG="M" Q
"RTN","BMXFIND",73,0)
.S BMXFLG=""
"RTN","BMXFIND",74,0)
;
"RTN","BMXFIND",75,0)
;---> If no Maximum Number provided, set it to 200.
"RTN","BMXFIND",76,0)
I '$G(BMXMX) S BMXMX=200
"RTN","BMXFIND",77,0)
;
"RTN","BMXFIND",78,0)
;---> Define index and screen.
"RTN","BMXFIND",79,0)
S:'$D(BMXIX) BMXIX=""
"RTN","BMXFIND",80,0)
S:'$D(BMXSCR) BMXSCR=""
"RTN","BMXFIND",81,0)
;
"RTN","BMXFIND",82,0)
;---> Set Target Global for output and errors.
"RTN","BMXFIND",83,0)
S BMXG="^BMXTMP($J)"
"RTN","BMXFIND",84,0)
;
"RTN","BMXFIND",85,0)
;---> If Mixed Case not set, set to No Change.
"RTN","BMXFIND",86,0)
I '$D(BMXMC) S BMXMC=0
"RTN","BMXFIND",87,0)
;
"RTN","BMXFIND",88,0)
;---> If Return IEN not set, set to No
"RTN","BMXFIND",89,0)
I '$D(BMXNUM) S BMXNUM=0
"RTN","BMXFIND",90,0)
S BMXNUM=+BMXNUM
"RTN","BMXFIND",91,0)
;
"RTN","BMXFIND",92,0)
;---> Silent Fileman call.
"RTN","BMXFIND",93,0)
D
"RTN","BMXFIND",94,0)
.I $G(BMXIN)="" D Q
"RTN","BMXFIND",95,0)
..D LIST^DIC(BMXFL,,,,BMXMX,0,,BMXIX,BMXSCR,,BMXG,BMXG)
"RTN","BMXFIND",96,0)
.D FIND^DIC(BMXFL,,,BMXFLG,BMXIN,BMXMX,BMXIX,BMXSCR,,BMXG,BMXG)
"RTN","BMXFIND",97,0)
;
"RTN","BMXFIND",98,0)
D WRITE
"RTN","BMXFIND",99,0)
Q
"RTN","BMXFIND",100,0)
;
"RTN","BMXFIND",101,0)
;
"RTN","BMXFIND",102,0)
;----------
"RTN","BMXFIND",103,0)
WRITE ;EP
"RTN","BMXFIND",104,0)
;---> Collect data for matching records and write in result global.
"RTN","BMXFIND",105,0)
;
"RTN","BMXFIND",106,0)
;---> First, check for errors.
"RTN","BMXFIND",107,0)
;---> If errors exist, write them and quit.
"RTN","BMXFIND",108,0)
N I,N,X
"RTN","BMXFIND",109,0)
I $D(^BMXTMP($J,"DIERR")) I $O(^("DIERR",0)) D Q
"RTN","BMXFIND",110,0)
.S N=0,X=""
"RTN","BMXFIND",111,0)
.F S N=$O(^BMXTMP($J,"DIERR",N)) Q:'N D
"RTN","BMXFIND",112,0)
..N M S M=0
"RTN","BMXFIND",113,0)
..F S M=$O(^BMXTMP($J,"DIERR",N,"TEXT",M)) Q:'M D
"RTN","BMXFIND",114,0)
...S X=X_^BMXTMP($J,"DIERR",N,"TEXT",M)_" "
"RTN","BMXFIND",115,0)
.D ERROUT(X,1)
"RTN","BMXFIND",116,0)
;
"RTN","BMXFIND",117,0)
;
"RTN","BMXFIND",118,0)
;---> Write valid results.
"RTN","BMXFIND",119,0)
;---> Loop through the IEN node (...2,N) of the temp global.
"RTN","BMXFIND",120,0)
; and call GETS^DIQ for each record
"RTN","BMXFIND",121,0)
N I,N,X S N=0
"RTN","BMXFIND",122,0)
S BMXA="A"
"RTN","BMXFIND",123,0)
;B
"RTN","BMXFIND",124,0)
S I=0
"RTN","BMXFIND",125,0)
S BMXFLDF=0
"RTN","BMXFIND",126,0)
RESULTS F S N=$O(^BMXTMP($J,"DILIST",2,N)) Q:'N D
"RTN","BMXFIND",127,0)
. S X=^BMXTMP($J,"DILIST",2,N)
"RTN","BMXFIND",128,0)
. S I=I+1
"RTN","BMXFIND",129,0)
. K A
"RTN","BMXFIND",130,0)
. D GETS^DIQ(BMXFL,X_",",BMXFLDS,,BMXA,BMXA)
"RTN","BMXFIND",131,0)
. ;--->Once only, write field names
"RTN","BMXFIND",132,0)
. D:'BMXFLDF FIELDS
"RTN","BMXFIND",133,0)
. ;
"RTN","BMXFIND",134,0)
. ;
"RTN","BMXFIND",135,0)
. ;---> Loop through results global
"RTN","BMXFIND",136,0)
. S F=0,BMXCNT=0
"RTN","BMXFIND",137,0)
. F S F=$O(A(BMXFL,X_",",F)) Q:'F S BMXCNT=BMXCNT+1
"RTN","BMXFIND",138,0)
. S F=0
"RTN","BMXFIND",139,0)
. S BMXREC=""
"RTN","BMXFIND",140,0)
. S:BMXNUM ^BMXTEMP($J,I)=X_"^"
"RTN","BMXFIND",141,0)
. S BMXCNTB=0
"RTN","BMXFIND",142,0)
. S BMXORD=BMXNUM
"RTN","BMXFIND",143,0)
. F S F=$O(A(BMXFL,X_",",F)) Q:'F S BMXCNTB=BMXCNTB+1 D S:BMXCNTB<BMXCNT ^BMXTEMP($J,I)=^BMXTEMP($J,I)_U
"RTN","BMXFIND",144,0)
. . S BMXORD=BMXORD+1
"RTN","BMXFIND",145,0)
. . I $P(^DD(BMXFL,F,0),U,2) D I 1 ;Multiple or WP
"RTN","BMXFIND",146,0)
. . . ;Get the subfile number into FL1
"RTN","BMXFIND",147,0)
. . . S FL1=+$P(^DD(BMXFL,F,0),U,2)
"RTN","BMXFIND",148,0)
. . . S FLD1=$O(^DD(FL1,0))
"RTN","BMXFIND",149,0)
. . . I $P(^DD(FL1,FLD1,0),U,2)["W" D ;WP
"RTN","BMXFIND",150,0)
. . . . S WPL=0,BMXLTMP=0
"RTN","BMXFIND",151,0)
. . . . F S WPL=$O(A(BMXFL,X_",",F,WPL)) Q:'WPL S I=I+1 D
"RTN","BMXFIND",152,0)
. . . . . S ^BMXTEMP($J,I)=A(BMXFL,X_",",F,WPL)_" "
"RTN","BMXFIND",153,0)
. . . . . S BMXLTMP=BMXLTMP+$L(A(BMXFL,X_",",F,WPL))+1
"RTN","BMXFIND",154,0)
. . . . . Q
"RTN","BMXFIND",155,0)
. . . . S:BMXLTMP>BMXLEN(BMXORD) BMXLEN(BMXORD)=BMXLTMP
"RTN","BMXFIND",156,0)
. . . . Q
"RTN","BMXFIND",157,0)
. . . D ;It's a multiple. Implement in next phase
"RTN","BMXFIND",158,0)
. . . . Q ;
"RTN","BMXFIND",159,0)
. . . Q
"RTN","BMXFIND",160,0)
. . E D ;Not a multiple
"RTN","BMXFIND",161,0)
. . . S I=I+1
"RTN","BMXFIND",162,0)
. . . S ^BMXTEMP($J,I)=A(BMXFL,X_",",F)
"RTN","BMXFIND",163,0)
. . . S:$L(A(BMXFL,X_",",F))>BMXLEN(BMXORD) BMXLEN(BMXORD)=$L(A(BMXFL,X_",",F))
"RTN","BMXFIND",164,0)
. . . Q
"RTN","BMXFIND",165,0)
. . Q
"RTN","BMXFIND",166,0)
. ;---> Convert data to mixed case if BMXMC=1.
"RTN","BMXFIND",167,0)
. ;S:BMXMC BMXREC=$$T^BMXTRS(BMXREC)
"RTN","BMXFIND",168,0)
. ;---> Set data in result global.
"RTN","BMXFIND",169,0)
. S ^BMXTEMP($J,I)=^BMXTEMP($J,I)_$C(30)
"RTN","BMXFIND",170,0)
;
"RTN","BMXFIND",171,0)
;---> If no results, report it as an error.
"RTN","BMXFIND",172,0)
D:'$O(^BMXTEMP($J,0))
"RTN","BMXFIND",173,0)
.I BMXIN]"" S BMXERR="No entry matches """_BMXIN_"""." Q
"RTN","BMXFIND",174,0)
.S BMXERR="Either the lookup file is empty"
"RTN","BMXFIND",175,0)
.S BMXERR=BMXERR_" or all entries are screened (software error)."
"RTN","BMXFIND",176,0)
;
"RTN","BMXFIND",177,0)
;---> Tack on Error Delimiter and any error.
"RTN","BMXFIND",178,0)
S I=I+1
"RTN","BMXFIND",179,0)
S ^BMXTEMP($J,I)=BMX31_BMXERR
"RTN","BMXFIND",180,0)
;---> Column types and widths
"RTN","BMXFIND",181,0)
S C=0
"RTN","BMXFIND",182,0)
F S C=$O(BMXLEN(C)) Q:'C D
"RTN","BMXFIND",183,0)
. I BMXLEN(C)>99999 S BMXLEN(C)=99999
"RTN","BMXFIND",184,0)
. S ^BMXTEMP($J,C)=BMXTYP(C)_$$NUMCHAR(BMXLEN(C))_^BMXTEMP($J,C)
"RTN","BMXFIND",185,0)
Q
"RTN","BMXFIND",186,0)
;
"RTN","BMXFIND",187,0)
;
"RTN","BMXFIND",188,0)
NUMCHAR(BMXN) ;EP
"RTN","BMXFIND",189,0)
;---> Returns Field Length left-padded with 0
"RTN","BMXFIND",190,0)
;
"RTN","BMXFIND",191,0)
N BMXC
"RTN","BMXFIND",192,0)
S BMXC="00000"_BMXN
"RTN","BMXFIND",193,0)
Q $E(BMXC,$L(BMXC)-4,$L(BMXC))
"RTN","BMXFIND",194,0)
;
"RTN","BMXFIND",195,0)
;---> Dead code follows
"RTN","BMXFIND",196,0)
N C,BMXC,F,N,J
"RTN","BMXFIND",197,0)
S BMXC=""
"RTN","BMXFIND",198,0)
S N=BMXN
"RTN","BMXFIND",199,0)
S:N>99999 N=99999
"RTN","BMXFIND",200,0)
S:N<0 N=0
"RTN","BMXFIND",201,0)
F J=1:1:$L(N) D
"RTN","BMXFIND",202,0)
. S F=10**(J-1)
"RTN","BMXFIND",203,0)
. S C=65+(N-((N\(10*F))*(10*F))\F)
"RTN","BMXFIND",204,0)
. S C=$C(C)
"RTN","BMXFIND",205,0)
. S BMXC=C_BMXC
"RTN","BMXFIND",206,0)
S BMXC="AAAAA"_BMXC
"RTN","BMXFIND",207,0)
Q $E(BMXC,$L(BMXC)-4,$L(BMXC))
"RTN","BMXFIND",208,0)
;
"RTN","BMXFIND",209,0)
;
"RTN","BMXFIND",210,0)
FIELDS ;---> Write Field Names
"RTN","BMXFIND",211,0)
;Field name is TAAAAANAME
"RTN","BMXFIND",212,0)
;Where T is the field type (T=Text; D=Date)
"RTN","BMXFIND",213,0)
; AAAAA is the field size (see NUMCHAR routine)
"RTN","BMXFIND",214,0)
; NAME is the field name
"RTN","BMXFIND",215,0)
S BMXFLDF=1
"RTN","BMXFIND",216,0)
K BMXLEN,BMXTYP
"RTN","BMXFIND",217,0)
D:$D(A)
"RTN","BMXFIND",218,0)
. I BMXNUM S ^BMXTEMP($J,I)="IEN^",BMXLEN(I)=10,BMXTYP(I)="T",I=I+1 ;TODO: Change from text to number
"RTN","BMXFIND",219,0)
. S ASDXFNUM=0
"RTN","BMXFIND",220,0)
. S BMXIENS=$O(A(BMXFL,0))
"RTN","BMXFIND",221,0)
. F S ASDXFNUM=$O(A(BMXFL,BMXIENS,ASDXFNUM)) Q:'ASDXFNUM D
"RTN","BMXFIND",222,0)
. . S ASDXFNAM=$P(^DD(BMXFL,ASDXFNUM,0),"^") ;Get type here
"RTN","BMXFIND",223,0)
. . S ASDXFNAM=$TR(ASDXFNAM," ","_")
"RTN","BMXFIND",224,0)
. . S BMXTYP(I)="T"
"RTN","BMXFIND",225,0)
. . S BMXLEN(I)=0 ;Start with length zero
"RTN","BMXFIND",226,0)
. . S:ASDXFNAM="" ASDXFNAM="UNKNOWN"_I
"RTN","BMXFIND",227,0)
. . S ^BMXTEMP($J,I)=ASDXFNAM_"^"
"RTN","BMXFIND",228,0)
. . S I=I+1
"RTN","BMXFIND",229,0)
. S ^BMXTEMP($J,I-1)=$E(^BMXTEMP($J,I-1),1,$L(^BMXTEMP($J,I-1))-1)_$C(30)
"RTN","BMXFIND",230,0)
Q
"RTN","BMXFIND",231,0)
;
"RTN","BMXFIND",232,0)
;----------
"RTN","BMXFIND",233,0)
ERROUT(BMXERR,I) ;EP
"RTN","BMXFIND",234,0)
;---> Save next line for Error Code File if ever used.
"RTN","BMXFIND",235,0)
;---> If necessary, use I>1 to avoid overwriting valid data.
"RTN","BMXFIND",236,0)
S:'$G(I) I=1
"RTN","BMXFIND",237,0)
S ^BMXTEMP($J,I)=BMX31_BMXERR
"RTN","BMXFIND",238,0)
Q
"RTN","BMXFIND",239,0)
;
"RTN","BMXFIND",240,0)
;
"RTN","BMXFIND",241,0)
PASSERR(BMXGBL,BMXERR) ;EP
"RTN","BMXFIND",242,0)
;---> If the RPC routine calling the BMX Generic Lookup above
"RTN","BMXFIND",243,0)
;---> detects a specific error prior to the call and wants to pass
"RTN","BMXFIND",244,0)
;---> that error in the result global rather than a generic error,
"RTN","BMXFIND",245,0)
;---> then a call to this function (PASSERR) can be made.
"RTN","BMXFIND",246,0)
;---> This call will store the error text passed in the result global.
"RTN","BMXFIND",247,0)
;---> The calling routine should then quit (abort its call to the
"RTN","BMXFIND",248,0)
;---> BMX Generic Lookup function above).
"RTN","BMXFIND",249,0)
;
"RTN","BMXFIND",250,0)
;---> Parameters:
"RTN","BMXFIND",251,0)
; 1 - BMXGBL (ret) Name of result global for Broker.
"RTN","BMXFIND",252,0)
; 2 - BMXERR (req) Text of error to be stored in result global.
"RTN","BMXFIND",253,0)
;
"RTN","BMXFIND",254,0)
S:$G(BMXERR)="" BMXERR="Error not passed (software error)."
"RTN","BMXFIND",255,0)
;
"RTN","BMXFIND",256,0)
N BMX31 S BMX31=$C(31)_$C(31)
"RTN","BMXFIND",257,0)
K ^BMXTMP($J),^BMXTEMP($J)
"RTN","BMXFIND",258,0)
S BMXGBL="^BMXTEMP("_$J_")"
"RTN","BMXFIND",259,0)
S ^BMXTEMP($J,1)=BMX31_BMXERR
"RTN","BMXFIND",260,0)
Q
"RTN","BMXG")
0^80^B2718298
"RTN","BMXG",1,0)
BMXG ; IHS/OIT/HMW - UTIL: GET DATA ;
"RTN","BMXG",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXG",3,0)
;;Stolen from:* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
"RTN","BMXG",4,0)
;
"RTN","BMXG",5,0)
;
"RTN","BMXG",6,0)
;----------
"RTN","BMXG",7,0)
GET(FILE,Y,PC) ;EP
"RTN","BMXG",8,0)
;---> Return text of .01 Field of an entry in a file.
"RTN","BMXG",9,0)
;---> Parameters:
"RTN","BMXG",10,0)
; 1 - FILE (req) Number corresponding to desired file:
"RTN","BMXG",11,0)
; 1 = State File, #5
"RTN","BMXG",12,0)
; 2 = Community File, #9999999.5
"RTN","BMXG",13,0)
; 3 = Employer File, #9999999.75
"RTN","BMXG",14,0)
; 4 = Beneficiary File, #9999999.25
"RTN","BMXG",15,0)
; 5 = Tribe File, #9999999.03
"RTN","BMXG",16,0)
; 6 = Insurer File, #9999999.18
"RTN","BMXG",17,0)
; 7 = Suffix File, #9999999.32
"RTN","BMXG",18,0)
; 8 = Employer Group Insurance File, #9999999.77
"RTN","BMXG",19,0)
; 9 = Medicare Eligible File, #9000003
"RTN","BMXG",20,0)
; 10 = Medicaid Eligible File, #9000004
"RTN","BMXG",21,0)
; 11 = Private Insurance Eligible File, #9000006
"RTN","BMXG",22,0)
; 12 = Patient File, #9000001
"RTN","BMXG",23,0)
; 13 = VA Patient File, #2
"RTN","BMXG",24,0)
; 14 = Policy Holder File, #9000003.1
"RTN","BMXG",25,0)
; 15 = Relationship File, #9999999.36
"RTN","BMXG",26,0)
;
"RTN","BMXG",27,0)
; 2 - Y (req) IEN in the File storing the desired entry.
"RTN","BMXG",28,0)
; 3 - PC (opt) Piece of 0-Node to return (default=1).
"RTN","BMXG",29,0)
; If PC=0 return entire 0-node.
"RTN","BMXG",30,0)
;
"RTN","BMXG",31,0)
Q:($G(Y)'?1N.N) ""
"RTN","BMXG",32,0)
Q:'$G(FILE) ""
"RTN","BMXG",33,0)
S:$G(PC)="" PC=1 S U="^"
"RTN","BMXG",34,0)
;
"RTN","BMXG",35,0)
D
"RTN","BMXG",36,0)
.I FILE=1 S GLB="^DIC(5,"_Y_",0)" Q
"RTN","BMXG",37,0)
.I FILE=2 S GLB="^AUTTCOM("_Y_",0)" Q
"RTN","BMXG",38,0)
.I FILE=3 S GLB="^AUTNEMPL("_Y_",0)" Q
"RTN","BMXG",39,0)
.I FILE=4 S GLB="^AUTTBEN("_Y_",0)" Q
"RTN","BMXG",40,0)
.I FILE=5 S GLB="^AUTTTRI("_Y_",0)" Q
"RTN","BMXG",41,0)
.I FILE=6 S GLB="^AUTNINS("_Y_",0)" Q
"RTN","BMXG",42,0)
.I FILE=7 S GLB="^AUTTMCS("_Y_",0)" Q
"RTN","BMXG",43,0)
.I FILE=8 S GLB="^AUTNEGRP("_Y_",0)" Q
"RTN","BMXG",44,0)
.I FILE=9 S GLB="^AUPNMCR("_Y_",0)" Q
"RTN","BMXG",45,0)
.I FILE=10 S GLB="^AUPNMCD("_Y_",0)" Q
"RTN","BMXG",46,0)
.I FILE=11 S GLB="^AUPNPRVT("_Y_",0)" Q
"RTN","BMXG",47,0)
.I FILE=12 S GLB="^AUPNPAT("_Y_",0)" Q
"RTN","BMXG",48,0)
.I FILE=13 S GLB="^DPT("_Y_",0)" Q
"RTN","BMXG",49,0)
.I FILE=14 S GLB="^AUPN3PPH("_Y_",0)" Q
"RTN","BMXG",50,0)
.I FILE=15 S GLB="^AUTTRLSH("_Y_",0)" Q
"RTN","BMXG",51,0)
;
"RTN","BMXG",52,0)
Q:'FILE ""
"RTN","BMXG",53,0)
Q:PC=0 $G(@GLB)
"RTN","BMXG",54,0)
Q $P($G(@GLB),U,PC)
"RTN","BMXGETS")
0^81^B15016739
"RTN","BMXGETS",1,0)
BMXGETS ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
"RTN","BMXGETS",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXGETS",3,0)
;
"RTN","BMXGETS",4,0)
;;Horace Whitt
"RTN","BMXGETS",5,0)
;;Interface to GETS^DIQ
"RTN","BMXGETS",6,0)
;
"RTN","BMXGETS",7,0)
;----------
"RTN","BMXGETS",8,0)
GETS(BMXGBL,BMXFL,BMXIENS,BMXFLDS,BMXFLG,BMXMC,BMXNUM) ;EP
"RTN","BMXGETS",9,0)
;---> The final record (node) contains Error Delimiter,
"RTN","BMXGETS",10,0)
; $C(31)_$C(31), followed by error text, if any.
"RTN","BMXGETS",11,0)
;
"RTN","BMXGETS",12,0)
;---> Parameters:
"RTN","BMXGETS",13,0)
; 1 - BMXGBL (ret) Name of result global for Broker.
"RTN","BMXGETS",14,0)
; 2 - BMXFL (req) File number for lookup.
"RTN","BMXGETS",15,0)
; 3 - BMXFLDS (req) Fields to return w/each entry in IENS format.
"RTN","BMXGETS",16,0)
; 4 - BMXFLG (opt) Flags - See GETS^DIQ documentation
"RTN","BMXGETS",17,0)
; 9 - BMXMC (opt) Mixed Case: 1=mixed case, 0=no change.
"RTN","BMXGETS",18,0)
; (Converts data in uppercase to mixed case.)
"RTN","BMXGETS",19,0)
; 6 - BMXNUM (opt) Include IEN as first returned field (1=true)
"RTN","BMXGETS",20,0)
;
"RTN","BMXGETS",21,0)
;---> Set variables, kill temp globals.
"RTN","BMXGETS",22,0)
N BMX31
"RTN","BMXGETS",23,0)
S BMX31=$C(31)_$C(31)
"RTN","BMXGETS",24,0)
S BMXGBL="^BMXTEMP("_$J_")",BMXERR="",U="^"
"RTN","BMXGETS",25,0)
K ^BMXTMP($J),^BMXTEMP($J)
"RTN","BMXGETS",26,0)
;
"RTN","BMXGETS",27,0)
;---> If file number not provided, return error.
"RTN","BMXGETS",28,0)
I '$G(BMXFL) D ERROUT("File number not provided.",1) Q
"RTN","BMXGETS",29,0)
;
"RTN","BMXGETS",30,0)
I $G(BMXFLDS)="" S BMXFLDS=".01"
"RTN","BMXGETS",31,0)
;
"RTN","BMXGETS",32,0)
;---> Set Target Global for output and errors.
"RTN","BMXGETS",33,0)
S BMXG="^BMXTMP($J)"
"RTN","BMXGETS",34,0)
;
"RTN","BMXGETS",35,0)
;---> If Mixed Case not set, set to No Change.
"RTN","BMXGETS",36,0)
I '$D(BMXMC) S BMXMC=0
"RTN","BMXGETS",37,0)
;
"RTN","BMXGETS",38,0)
;---> If Return IEN not set, set to No
"RTN","BMXGETS",39,0)
I '$D(BMXNUM) S BMXNUM=0
"RTN","BMXGETS",40,0)
S BMXNUM=+BMXNUM
"RTN","BMXGETS",41,0)
;
"RTN","BMXGETS",42,0)
;---> Fileman call
"RTN","BMXGETS",43,0)
D GETS^DIQ(BMXFL,BMXIENS,BMXFLDS,BMXFLG,BMXG,BMXG)
"RTN","BMXGETS",44,0)
;
"RTN","BMXGETS",45,0)
D WRITE
"RTN","BMXGETS",46,0)
Q
"RTN","BMXGETS",47,0)
;
"RTN","BMXGETS",48,0)
;
"RTN","BMXGETS",49,0)
;----------
"RTN","BMXGETS",50,0)
WRITE ;EP
"RTN","BMXGETS",51,0)
;---> Collect data for matching records and write in result global.
"RTN","BMXGETS",52,0)
;
"RTN","BMXGETS",53,0)
;---> First, check for errors.
"RTN","BMXGETS",54,0)
;---> If errors exist, write them and quit.
"RTN","BMXGETS",55,0)
N I,N,X,F,ASDX,ASDC,ASDXFNUM,ASDXFNAM
"RTN","BMXGETS",56,0)
I $D(^BMXTMP($J,"DIERR")) I $O(^("DIERR",0)) D Q
"RTN","BMXGETS",57,0)
.S N=0,X=""
"RTN","BMXGETS",58,0)
.F S N=$O(^BMXTMP($J,"DIERR",N)) Q:'N D
"RTN","BMXGETS",59,0)
..N M S M=0
"RTN","BMXGETS",60,0)
..F S M=$O(^BMXTMP($J,"DIERR",N,"TEXT",M)) Q:'M D
"RTN","BMXGETS",61,0)
...S X=X_^BMXTMP($J,"DIERR",N,"TEXT",M)_" "
"RTN","BMXGETS",62,0)
.D ERROUT(X,1)
"RTN","BMXGETS",63,0)
;
"RTN","BMXGETS",64,0)
;
"RTN","BMXGETS",65,0)
;---> Write Field Names
"RTN","BMXGETS",66,0)
I BMXNUM S $P(ASDX,"^",1)="IEN"
"RTN","BMXGETS",67,0)
;F ASDC=1:1:$L(BMXFLDS,";") D
"RTN","BMXGETS",68,0)
S ASDC=1
"RTN","BMXGETS",69,0)
S ASDXFNUM=0
"RTN","BMXGETS",70,0)
F S ASDXFNUM=$O(^BMXTMP($J,BMXFL,BMXIENS,ASDXFNUM)) Q:'ASDXFNUM D
"RTN","BMXGETS",71,0)
. ;S ASDXFNUM=$P(BMXFLDS,";",ASDC)
"RTN","BMXGETS",72,0)
. S ASDXFNAM=$P(^DD(BMXFL,ASDXFNUM,0),"^")
"RTN","BMXGETS",73,0)
. S:ASDXFNAM="" ASDXFNAM="UNKNOWN"_ASDC
"RTN","BMXGETS",74,0)
. S $P(ASDX,"^",ASDC+BMXNUM)=ASDXFNAM
"RTN","BMXGETS",75,0)
. S ASDC=ASDC+1
"RTN","BMXGETS",76,0)
S ^BMXTEMP($J,1)=ASDX_$C(30)
"RTN","BMXGETS",77,0)
;---> Write valid results.
"RTN","BMXGETS",78,0)
AAA ;---> Loop through results global
"RTN","BMXGETS",79,0)
S I=2,N=0 F S N=$O(^BMXTMP($J,BMXFL,N)) Q:'N D
"RTN","BMXGETS",80,0)
. S X="",F=0
"RTN","BMXGETS",81,0)
. I BMXNUM S X=+N
"RTN","BMXGETS",82,0)
. F S F=$O(^BMXTMP($J,BMXFL,N,F)) Q:'F D
"RTN","BMXGETS",83,0)
. . S:X'="" X=X_U
"RTN","BMXGETS",84,0)
. . I $P(^DD(BMXFL,F,0),U,2) D I 1 ;Multiple or WP
"RTN","BMXGETS",85,0)
. . . ;Get the subfile number into FL1
"RTN","BMXGETS",86,0)
. . . S FL1=+$P(^DD(BMXFL,F,0),U,2)
"RTN","BMXGETS",87,0)
. . . S FLD1=$O(^DD(FL1,0))
"RTN","BMXGETS",88,0)
. . . I $P(^DD(FL1,FLD1,0),U,2)["W" D ;WP
"RTN","BMXGETS",89,0)
. . . . S WPL=0 F S WPL=$O(^BMXTMP($J,BMXFL,N,F,WPL)) Q:'WPL D
"RTN","BMXGETS",90,0)
. . . . . S X=X_^BMXTMP($J,BMXFL,N,F,WPL)_" "
"RTN","BMXGETS",91,0)
. . . . . Q
"RTN","BMXGETS",92,0)
. . . . Q
"RTN","BMXGETS",93,0)
. . . D ;It's a multiple. Implement in next phase
"RTN","BMXGETS",94,0)
. . . . Q ;
"RTN","BMXGETS",95,0)
. . . Q
"RTN","BMXGETS",96,0)
. . E D ;Not a multiple
"RTN","BMXGETS",97,0)
. . . S X=X_^BMXTMP($J,BMXFL,N,F)
"RTN","BMXGETS",98,0)
. . . Q
"RTN","BMXGETS",99,0)
. . Q
"RTN","BMXGETS",100,0)
. ;---> Convert data to mixed case if BMXMC=1.
"RTN","BMXGETS",101,0)
ZZZ . S:BMXMC X=$$T^BMXTRS(X)
"RTN","BMXGETS",102,0)
. ;
"RTN","BMXGETS",103,0)
. ;---> Set data in result global.
"RTN","BMXGETS",104,0)
. S ^BMXTEMP($J,I)=X_$C(30)
"RTN","BMXGETS",105,0)
. S I=I+1
"RTN","BMXGETS",106,0)
;
"RTN","BMXGETS",107,0)
;---> If no results, report it as an error.
"RTN","BMXGETS",108,0)
D:'$O(^BMXTEMP($J,0))
"RTN","BMXGETS",109,0)
.I BMXIN]"" S BMXERR="No entry matches """_BMXIN_"""." Q
"RTN","BMXGETS",110,0)
.S BMXERR="Either the lookup file is empty"
"RTN","BMXGETS",111,0)
.S BMXERR=BMXERR_" or all entries are screened (software error)."
"RTN","BMXGETS",112,0)
;
"RTN","BMXGETS",113,0)
;---> Tack on Error Delimiter and any error.
"RTN","BMXGETS",114,0)
S ^BMXTEMP($J,I)=BMX31_BMXERR
"RTN","BMXGETS",115,0)
Q
"RTN","BMXGETS",116,0)
;
"RTN","BMXGETS",117,0)
;
"RTN","BMXGETS",118,0)
;----------
"RTN","BMXGETS",119,0)
ERROUT(BMXERR,I) ;EP
"RTN","BMXGETS",120,0)
;---> Save next line for Error Code File if ever used.
"RTN","BMXGETS",121,0)
;---> If necessary, use I>1 to avoid overwriting valid data.
"RTN","BMXGETS",122,0)
S:'$G(I) I=1
"RTN","BMXGETS",123,0)
S ^BMXTEMP($J,I)=BMX31_BMXERR
"RTN","BMXGETS",124,0)
Q
"RTN","BMXGETS",125,0)
;
"RTN","BMXGETS",126,0)
;
"RTN","BMXGETS",127,0)
PASSERR(BMXGBL,BMXERR) ;EP
"RTN","BMXGETS",128,0)
;---> If the RPC routine calling the BMX Generic Lookup above
"RTN","BMXGETS",129,0)
;---> detects a specific error prior to the call and wants to pass
"RTN","BMXGETS",130,0)
;---> that error in the result global rather than a generic error,
"RTN","BMXGETS",131,0)
;---> then a call to this function (PASSERR) can be made.
"RTN","BMXGETS",132,0)
;---> This call will store the error text passed in the result global.
"RTN","BMXGETS",133,0)
;---> The calling routine should then quit (abort its call to the
"RTN","BMXGETS",134,0)
;---> BMX Generic Lookup function above).
"RTN","BMXGETS",135,0)
;
"RTN","BMXGETS",136,0)
;---> Parameters:
"RTN","BMXGETS",137,0)
; 1 - BMXGBL (ret) Name of result global for Broker.
"RTN","BMXGETS",138,0)
; 2 - BMXERR (req) Text of error to be stored in result global.
"RTN","BMXGETS",139,0)
;
"RTN","BMXGETS",140,0)
S:$G(BMXERR)="" BMXERR="Error not passed (software error)."
"RTN","BMXGETS",141,0)
;
"RTN","BMXGETS",142,0)
N BMX31 S BMX31=$C(31)_$C(31)
"RTN","BMXGETS",143,0)
K ^BMXTMP($J),^BMXTEMP($J)
"RTN","BMXGETS",144,0)
S BMXGBL="^BMXTEMP("_$J_")"
"RTN","BMXGETS",145,0)
S ^BMXTEMP($J,1)=BMX31_BMXERR
"RTN","BMXGETS",146,0)
Q
"RTN","BMXMBRK")
0^82^B32854296
"RTN","BMXMBRK",1,0)
BMXMBRK ; IHS/OIT/HMW - BMXNet MONITOR ;
"RTN","BMXMBRK",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXMBRK",3,0)
;
"RTN","BMXMBRK",4,0)
;
"RTN","BMXMBRK",5,0)
PRSP(P) ;EP -Parse Protocol
"RTN","BMXMBRK",6,0)
;M Extrinsic Function
"RTN","BMXMBRK",7,0)
;
"RTN","BMXMBRK",8,0)
;Inputs
"RTN","BMXMBRK",9,0)
;P Protocol string with the form
"RTN","BMXMBRK",10,0)
; Protocol := Protocol Header^Message where
"RTN","BMXMBRK",11,0)
; Protocol Header := LLLWKID;WINH;PRCH;WISH;MESG
"RTN","BMXMBRK",12,0)
; LLL := length of protocol header (3 numeric)
"RTN","BMXMBRK",13,0)
; WKID := Workstation ID (ALPHA)
"RTN","BMXMBRK",14,0)
; WINH := Window handle (ALPHA)
"RTN","BMXMBRK",15,0)
; PRCH := Process handle (ALPHA)
"RTN","BMXMBRK",16,0)
; WISH := Window server handle (ALPHA)
"RTN","BMXMBRK",17,0)
; MESG := Unparsed message
"RTN","BMXMBRK",18,0)
;Outputs
"RTN","BMXMBRK",19,0)
;ERR 0 for success, "-1^Text" if error
"RTN","BMXMBRK",20,0)
;
"RTN","BMXMBRK",21,0)
N ERR,C,M,R,X
"RTN","BMXMBRK",22,0)
S R=0,C=";",ERR=0,M=512 ;Maximum buffer input
"RTN","BMXMBRK",23,0)
IF $E(P,1,5)="{BMX}" S P=$E(P,6,$L(P)) ;drop out prefix
"RTN","BMXMBRK",24,0)
IF '+$G(P) S ERR="-1^Required input reference is NULL"
"RTN","BMXMBRK",25,0)
IF +ERR=0 D
"RTN","BMXMBRK",26,0)
. S BMXZ(R,"LENG")=+$E(P,1,3)
"RTN","BMXMBRK",27,0)
. S X=$E(P,4,BMXZ(R,"LENG")+3)
"RTN","BMXMBRK",28,0)
. S BMXZ(R,"MESG")=$E(P,BMXZ(R,"LENG")+4,M)
"RTN","BMXMBRK",29,0)
. S BMXZ(R,"WKID")=$P(X,C)
"RTN","BMXMBRK",30,0)
. S BMXZ(R,"WINH")=$P(X,C,2)
"RTN","BMXMBRK",31,0)
. S BMXZ(R,"PRCH")=$P(X,C,3)
"RTN","BMXMBRK",32,0)
. S BMXZ(R,"WISH")=$P(X,C,4)
"RTN","BMXMBRK",33,0)
Q ERR
"RTN","BMXMBRK",34,0)
;
"RTN","BMXMBRK",35,0)
PRSM(P) ;EP - Parse message
"RTN","BMXMBRK",36,0)
;M Extrinsic Function
"RTN","BMXMBRK",37,0)
;
"RTN","BMXMBRK",38,0)
;Inputs
"RTN","BMXMBRK",39,0)
;P Message string with the form
"RTN","BMXMBRK",40,0)
; Message := Header^Content
"RTN","BMXMBRK",41,0)
; Header := LLL;FLAG
"RTN","BMXMBRK",42,0)
; LLL := length of entire message (3 numeric)
"RTN","BMXMBRK",43,0)
; FLAG := 1 indicates variables follow
"RTN","BMXMBRK",44,0)
; Content := Contains API call information
"RTN","BMXMBRK",45,0)
;Outputs
"RTN","BMXMBRK",46,0)
;ERR 0 for success, "-1^Text" if error
"RTN","BMXMBRK",47,0)
N C,ERR,M,R,X,U
"RTN","BMXMBRK",48,0)
S U="^",R=1,C=";",ERR=0,M=512 ;Max buffer
"RTN","BMXMBRK",49,0)
IF '+$G(P) S ERR="-1^Required input reference is NULL"
"RTN","BMXMBRK",50,0)
IF +ERR=0 D
"RTN","BMXMBRK",51,0)
. S BMXZ(R,"LENG")=+$E(P,1,5)
"RTN","BMXMBRK",52,0)
. S BMXZ(R,"FLAG")=$E(P,6,6)
"RTN","BMXMBRK",53,0)
. S BMXZ(R,"TEXT")=$E(P,7,M)
"RTN","BMXMBRK",54,0)
Q ERR
"RTN","BMXMBRK",55,0)
;
"RTN","BMXMBRK",56,0)
PRSA(P) ;EP - Parse API information, get calling info
"RTN","BMXMBRK",57,0)
;M Extrinsic Function
"RTN","BMXMBRK",58,0)
;Inputs
"RTN","BMXMBRK",59,0)
;P Content := API Name^Param string
"RTN","BMXMBRK",60,0)
; API := .01 field of API file
"RTN","BMXMBRK",61,0)
; Param := Parameter information
"RTN","BMXMBRK",62,0)
;Outputs
"RTN","BMXMBRK",63,0)
;ERR 0 for success, "-1^Text" if error
"RTN","BMXMBRK",64,0)
;
"RTN","BMXMBRK",65,0)
N C,DR,ERR,M,R,T,X,U
"RTN","BMXMBRK",66,0)
S U="^",R=2,C=";",ERR=0,M=512 ;Max buffer
"RTN","BMXMBRK",67,0)
IF '+$L(P) S ERR="-1^Required input reference is NULL"
"RTN","BMXMBRK",68,0)
IF +ERR=0 D
"RTN","BMXMBRK",69,0)
. S BMXZ(R,"CAPI")=$P(P,U)
"RTN","BMXMBRK",70,0)
. S BMXZ(R,"PARM")=$E(P,$F(P,U),M)
"RTN","BMXMBRK",71,0)
. S T=$O(^XWB(8994,"B",BMXZ(R,"CAPI"),0))
"RTN","BMXMBRK",72,0)
. I '+T S ERR="-1^Remote Procedure '"_BMXZ(R,"CAPI")_"' doesn't exist on the server." Q ;P10 - dpc
"RTN","BMXMBRK",73,0)
. S T(0)=$G(^XWB(8994,T,0))
"RTN","BMXMBRK",74,0)
. I $P(T(0),U,6)=1!($P(T(0),U,6)=2) S ERR="-1^Remote Procedure '"_BMXZ(R,"CAPI")_"' cannot be run at this time." Q ;P10. Check INACTIVE field. - dpc.
"RTN","BMXMBRK",75,0)
. S BMXZ(R,"NAME")=$P(T(0),"^")
"RTN","BMXMBRK",76,0)
. S BMXZ(R,"RTAG")=$P(T(0),"^",2)
"RTN","BMXMBRK",77,0)
. S BMXZ(R,"RNAM")=$P(T(0),"^",3)
"RTN","BMXMBRK",78,0)
. S BMXPTYPE=$P(T(0),"^",4)
"RTN","BMXMBRK",79,0)
. S BMXWRAP=+$P(T(0),"^",8)
"RTN","BMXMBRK",80,0)
Q ERR
"RTN","BMXMBRK",81,0)
;
"RTN","BMXMBRK",82,0)
PRSB(P) ;EP - Parse Parameter information
"RTN","BMXMBRK",83,0)
;M Extrinsic Function
"RTN","BMXMBRK",84,0)
;Inputs
"RTN","BMXMBRK",85,0)
;P Param := M parameter list
"RTN","BMXMBRK",86,0)
; Param := LLL,Name,Value
"RTN","BMXMBRK",87,0)
; LLL := length of variable name and value
"RTN","BMXMBRK",88,0)
; Name := name of M variable
"RTN","BMXMBRK",89,0)
; Value := a string
"RTN","BMXMBRK",90,0)
;Outputs
"RTN","BMXMBRK",91,0)
;ERR 0 for success, "-1^Text" if error
"RTN","BMXMBRK",92,0)
;
"RTN","BMXMBRK",93,0)
N A,ERR,F,FL,I,K,L,M,P1,P2,P3,P4,P5,MAXP,R
"RTN","BMXMBRK",94,0)
S R=3,MAXP=+$E(P,1,5)
"RTN","BMXMBRK",95,0)
S P1=$E(P,6,MAXP+5) ;only param string
"RTN","BMXMBRK",96,0)
S ERR=0,F=3,M=512
"RTN","BMXMBRK",97,0)
IF '+$D(P) S ERR="-1^Required input reference is NULL"
"RTN","BMXMBRK",98,0)
S FL=+$G(BMXZ(1,"FLAG"))
"RTN","BMXMBRK",99,0)
S I=0
"RTN","BMXMBRK",100,0)
IF '+ERR D
"RTN","BMXMBRK",101,0)
. IF 'FL,+MAXP=0 S P1="",ERR=1 Q
"RTN","BMXMBRK",102,0)
. F D Q:P1=""
"RTN","BMXMBRK",103,0)
. . Q:P1=""
"RTN","BMXMBRK",104,0)
. . S L=+$E(P1,1,3)-1
"RTN","BMXMBRK",105,0)
. . S P3=+$E(P1,4,4)
"RTN","BMXMBRK",106,0)
. . S P1=$E(P1,5,MAXP)
"RTN","BMXMBRK",107,0)
. . S BMXZ(R,"P",I)=$S(P3'=1:$E(P1,1,L),1:$$GETV($E(P1,1,L)))
"RTN","BMXMBRK",108,0)
. . IF FL=1,P3=2 D ;XWB*1.1*2
"RTN","BMXMBRK",109,0)
. . . S A=$$OARY^BMXMBRK2,BMXARY=A
"RTN","BMXMBRK",110,0)
. . . S BMXZ(R,"P",I)=$$CREF^BMXMBRK2(A,BMXZ(R,"P",I))
"RTN","BMXMBRK",111,0)
. . S P1=$E(P1,L+1,MAXP)
"RTN","BMXMBRK",112,0)
. . S K=I,I=I+1
"RTN","BMXMBRK",113,0)
. IF 'FL Q
"RTN","BMXMBRK",114,0)
. S P3=P
"RTN","BMXMBRK",115,0)
. S L=+$E(P3,1,5)
"RTN","BMXMBRK",116,0)
. S P1=$E(P3,F+3,L+F)
"RTN","BMXMBRK",117,0)
. S P2=$E(P3,L+F+3,M)
"RTN","BMXMBRK",118,0)
. ;instantiate array
"RTN","BMXMBRK",119,0)
. F D Q:+L=0
"RTN","BMXMBRK",120,0)
. . S L=$$BREAD(3) Q:+L=0 S P3=$$BREAD(L)
"RTN","BMXMBRK",121,0)
. . S L=$$BREAD(3) IF +L'=0 S P4=$$BREAD(L)
"RTN","BMXMBRK",122,0)
. . IF +L=0 Q
"RTN","BMXMBRK",123,0)
. . IF P3=0,P4=0 S L=0 Q
"RTN","BMXMBRK",124,0)
. . IF FL=1 D LINST(A,P3,P4)
"RTN","BMXMBRK",125,0)
. . IF FL=2 D GINST
"RTN","BMXMBRK",126,0)
IF ERR Q P1
"RTN","BMXMBRK",127,0)
S P1=""
"RTN","BMXMBRK",128,0)
D Q P1
"RTN","BMXMBRK",129,0)
. F I=0:1:K D
"RTN","BMXMBRK",130,0)
. . IF FL,$E(BMXZ(R,"P",I),1,5)=".BMXS" D Q ;XWB*1.1*2
"RTN","BMXMBRK",131,0)
. . . S P1=P1_"."_$E(BMXZ(R,"P",I),2,$L(BMXZ(R,"P",I)))
"RTN","BMXMBRK",132,0)
. . . IF I'=K S P1=P1_","
"RTN","BMXMBRK",133,0)
. . S P1=P1_"BMXZ("_R_",""P"","_I_")"
"RTN","BMXMBRK",134,0)
. . IF I'=K S P1=P1_","
"RTN","BMXMBRK",135,0)
IF '+ERR Q P1
"RTN","BMXMBRK",136,0)
Q ERR
"RTN","BMXMBRK",137,0)
;
"RTN","BMXMBRK",138,0)
BREAD(L) ;read tcp buffer, L is length
"RTN","BMXMBRK",139,0)
N E,X,DONE
"RTN","BMXMBRK",140,0)
S (E,DONE)=0
"RTN","BMXMBRK",141,0)
R X#L:BMXDTIME(1)
"RTN","BMXMBRK",142,0)
S E=X
"RTN","BMXMBRK",143,0)
IF $L(E)<L F D Q:'DONE
"RTN","BMXMBRK",144,0)
. IF $L(E)=L S DONE=1 Q
"RTN","BMXMBRK",145,0)
. R X#(L-$L(E)):BMXDTIME(1)
"RTN","BMXMBRK",146,0)
. S E=E_X
"RTN","BMXMBRK",147,0)
Q E
"RTN","BMXMBRK",148,0)
;
"RTN","BMXMBRK",149,0)
CALLP(BMXP,P,DEBUG) ;EP - make API call using Protocol string
"RTN","BMXMBRK",150,0)
N ERR,S
"RTN","BMXMBRK",151,0)
S ERR=0
"RTN","BMXMBRK",152,0)
IF '$D(DEBUG) S DEBUG=0
"RTN","BMXMBRK",153,0)
S ERR=$$PRSP(P)
"RTN","BMXMBRK",154,0)
IF '+ERR S ERR=$$PRSM(BMXZ(0,"MESG"))
"RTN","BMXMBRK",155,0)
IF '+ERR S ERR=$$PRSA(BMXZ(1,"TEXT")) ;I $G(BMXZ(2,"CAPI"))="XUS SET SHARED" S XWBSHARE=1 Q
"RTN","BMXMBRK",156,0)
I +ERR S BMXSEC=$P(ERR,U,2) ;P10 -- dpc
"RTN","BMXMBRK",157,0)
IF '+ERR S S=$$PRSB(BMXZ(2,"PARM"))
"RTN","BMXMBRK",158,0)
;IF (+S=0)!(+S>0) D
"RTN","BMXMBRK",159,0)
I '+ERR D CHKPRMIT^BMXMSEC(BMXZ(2,"CAPI")) ;checks if RPC allowed to run
"RTN","BMXMBRK",160,0)
S:$L($G(BMXSEC)) ERR="-1^"_BMXSEC
"RTN","BMXMBRK",161,0)
;IF 'DEBUG S:$D(XRT0) XRTN="RPC BROKER READ/PARSE" D:$D(XRT0) T1^%ZOSV ;stop RTL
"RTN","BMXMBRK",162,0)
IF '+ERR,(+S=0)!(+S>0) D
"RTN","BMXMBRK",163,0)
. D CAPI^BMXMBRK2(.BMXP,BMXZ(2,"RTAG"),BMXZ(2,"RNAM"),S)
"RTN","BMXMBRK",164,0)
E D CLRBUF ;p10
"RTN","BMXMBRK",165,0)
IF 'DEBUG K BMXZ
"RTN","BMXMBRK",166,0)
IF $D(BMXARY) K @BMXARY,BMXARY
"RTN","BMXMBRK",167,0)
Q
"RTN","BMXMBRK",168,0)
;
"RTN","BMXMBRK",169,0)
LINST(A,X,BMXY) ;instantiate local array
"RTN","BMXMBRK",170,0)
IF BMXY=$C(1) S BMXY=""
"RTN","BMXMBRK",171,0)
S X=A_"("_X_")"
"RTN","BMXMBRK",172,0)
S @X=BMXY
"RTN","BMXMBRK",173,0)
Q
"RTN","BMXMBRK",174,0)
GINST ;instantiate global
"RTN","BMXMBRK",175,0)
N DONE,N,T,T1
"RTN","BMXMBRK",176,0)
S (DONE,I)=0
"RTN","BMXMBRK",177,0)
;find piece with global ref - recover $C(44)
"RTN","BMXMBRK",178,0)
S REF=$TR(REF,$C(23),$C(44))
"RTN","BMXMBRK",179,0)
F D Q:DONE
"RTN","BMXMBRK",180,0)
. S N=$NA(^TMP("BMXZ",$J,$P($H,",",2)))
"RTN","BMXMBRK",181,0)
. S BMXZ("FRM")=REF
"RTN","BMXMBRK",182,0)
. S BMXZ("TO")=N
"RTN","BMXMBRK",183,0)
. IF '$D(@N) S DONE=1 Q
"RTN","BMXMBRK",184,0)
;loop through all and instantiate
"RTN","BMXMBRK",185,0)
S DONE=0
"RTN","BMXMBRK",186,0)
F D Q:DONE
"RTN","BMXMBRK",187,0)
. S T=$E(@REF@(I),4,M)
"RTN","BMXMBRK",188,0)
. IF T="" S DONE=1 Q
"RTN","BMXMBRK",189,0)
. S @N@("BMXZ")="" ;set naked indicator
"RTN","BMXMBRK",190,0)
. S @T
"RTN","BMXMBRK",191,0)
. S I=I+1
"RTN","BMXMBRK",192,0)
K @N@("BMXZ")
"RTN","BMXMBRK",193,0)
Q
"RTN","BMXMBRK",194,0)
;
"RTN","BMXMBRK",195,0)
GETV(V) ;get value of V - reference parameter
"RTN","BMXMBRK",196,0)
N X
"RTN","BMXMBRK",197,0)
S X=V
"RTN","BMXMBRK",198,0)
IF $E(X,1,2)="$$" Q ""
"RTN","BMXMBRK",199,0)
IF $C(34,36)[$E(V) X "S V="_$$VCHK(V)
"RTN","BMXMBRK",200,0)
E S V=@V
"RTN","BMXMBRK",201,0)
Q V
"RTN","BMXMBRK",202,0)
;
"RTN","BMXMBRK",203,0)
VCHK(S) ;Parse string for first argument
"RTN","BMXMBRK",204,0)
N C,I,P
"RTN","BMXMBRK",205,0)
F I=1:1 S C=$E(S,I) D VCHKP:C="(",VCHKQ:C=$C(34) Q:" ,"[C
"RTN","BMXMBRK",206,0)
Q $E(S,1,I-1)
"RTN","BMXMBRK",207,0)
VCHKP S P=1 ;Find closing paren
"RTN","BMXMBRK",208,0)
F I=I+1:1 S C=$E(S,I) Q:P=0!(C="") I "()"""[C D VCHKQ:C=$C(34) S P=P+$S("("[C:1,")"[C:-1,1:0)
"RTN","BMXMBRK",209,0)
Q
"RTN","BMXMBRK",210,0)
VCHKQ ;Find closing quote
"RTN","BMXMBRK",211,0)
F I=I+1:1 S C=$E(S,I) Q:C=""!(C=$C(34))
"RTN","BMXMBRK",212,0)
Q
"RTN","BMXMBRK",213,0)
CLRBUF ;p10 Empties Input buffer
"RTN","BMXMBRK",214,0)
N %
"RTN","BMXMBRK",215,0)
F R %#1:BMXDTIME(1) Q:%=""
"RTN","BMXMBRK",216,0)
Q
"RTN","BMXMBRK2")
0^83^B17554247
"RTN","BMXMBRK2",1,0)
BMXMBRK2 ; IHS/OIT/HMW - BMXNet MONITOR ;
"RTN","BMXMBRK2",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXMBRK2",3,0)
;
"RTN","BMXMBRK2",4,0)
;
"RTN","BMXMBRK2",5,0)
CAPI(BMXY,TAG,NAM,PAR) ;EP - make API call
"RTN","BMXMBRK2",6,0)
N R,T,DX,DY
"RTN","BMXMBRK2",7,0)
IF BMXZ(1,"FLAG")=2 D
"RTN","BMXMBRK2",8,0)
. S PAR=$P(PAR,BMXZ("FRM"))_BMXZ("TO")_$P(PAR,BMXZ("FRM"),2)
"RTN","BMXMBRK2",9,0)
S R=$S(PAR'=+PAR&(PAR=""):TAG_"^"_NAM_"(.BMXY)",1:TAG_"^"_NAM_"(.BMXY,"_PAR_")")
"RTN","BMXMBRK2",10,0)
U IO
"RTN","BMXMBRK2",11,0)
D @R
"RTN","BMXMBRK2",12,0)
; D DEBUG^%Serenji("@R","10.10.10.104")
"RTN","BMXMBRK2",13,0)
U $P
"RTN","BMXMBRK2",14,0)
Q
"RTN","BMXMBRK2",15,0)
;
"RTN","BMXMBRK2",16,0)
BHDR(WKID,WINH,PRCH,WISH) ;Build a protocol header
"RTN","BMXMBRK2",17,0)
N S,L
"RTN","BMXMBRK2",18,0)
S S=""
"RTN","BMXMBRK2",19,0)
S S=WKID_";"_WINH_";"_PRCH_";"_WISH_";"
"RTN","BMXMBRK2",20,0)
S L=$L(S)
"RTN","BMXMBRK2",21,0)
S S=$E("000"_L,$L(L)+1,$L(L)+3)_S
"RTN","BMXMBRK2",22,0)
Q S
"RTN","BMXMBRK2",23,0)
;
"RTN","BMXMBRK2",24,0)
BARY(A,R,V) ;add array elements+values to storage array
"RTN","BMXMBRK2",25,0)
IF A'["BMXS" Q "-1^ARRAY NAME MUST BE BMXS"
"RTN","BMXMBRK2",26,0)
S @A@(R)=V
"RTN","BMXMBRK2",27,0)
Q 0
"RTN","BMXMBRK2",28,0)
;
"RTN","BMXMBRK2",29,0)
BLDB(P) ;Build formatted string
"RTN","BMXMBRK2",30,0)
N L
"RTN","BMXMBRK2",31,0)
S L=$L(P)
"RTN","BMXMBRK2",32,0)
Q $E("000"_L,$L(L)+1,$L(L)+3)_P
"RTN","BMXMBRK2",33,0)
;
"RTN","BMXMBRK2",34,0)
BLDA(N,P) ;Build API string
"RTN","BMXMBRK2",35,0)
;M Extrinsic Function
"RTN","BMXMBRK2",36,0)
;Inputs
"RTN","BMXMBRK2",37,0)
;N API name
"RTN","BMXMBRK2",38,0)
;P Comma delimited parameter string
"RTN","BMXMBRK2",39,0)
;Outputs
"RTN","BMXMBRK2",40,0)
;String API string if successful, "-1^Text" if error
"RTN","BMXMBRK2",41,0)
;
"RTN","BMXMBRK2",42,0)
N I,F,L,T,U,T1,T2
"RTN","BMXMBRK2",43,0)
IF '+$D(N) Q "-1^Required input reference is NULL"
"RTN","BMXMBRK2",44,0)
S U="^"
"RTN","BMXMBRK2",45,0)
S (F,T,Y)=0
"RTN","BMXMBRK2",46,0)
IF '$D(P) S P=""
"RTN","BMXMBRK2",47,0)
IF P'="" D
"RTN","BMXMBRK2",48,0)
. S L=$L(P)-$L($TR(P,$C(44)))+1
"RTN","BMXMBRK2",49,0)
. IF L=0 S L=1
"RTN","BMXMBRK2",50,0)
. F I=1:1:L D Q:T
"RTN","BMXMBRK2",51,0)
. . S T1=$P(P,",",I)
"RTN","BMXMBRK2",52,0)
. . S T2=$E(T1,1,1)="."
"RTN","BMXMBRK2",53,0)
. . IF T1=+T1 Q
"RTN","BMXMBRK2",54,0)
. . IF $E(T1,1,1)="^" S F=2,T=1 Q
"RTN","BMXMBRK2",55,0)
. . IF T2&($E(T1,2,$L(T1))?.ANP) S F=1,T=1 Q
"RTN","BMXMBRK2",56,0)
S P=$$BLDB(P)
"RTN","BMXMBRK2",57,0)
S L=$L(P)+$L(P)-3
"RTN","BMXMBRK2",58,0)
S P=F_N_U_P
"RTN","BMXMBRK2",59,0)
S L=$L(P)
"RTN","BMXMBRK2",60,0)
Q $E("000"_L,$L(L)+1,$L(L)+3)_P
"RTN","BMXMBRK2",61,0)
;
"RTN","BMXMBRK2",62,0)
BLDS(R) ;Build a parameter string from an array
"RTN","BMXMBRK2",63,0)
N L,T,Y
"RTN","BMXMBRK2",64,0)
S Y=""
"RTN","BMXMBRK2",65,0)
F D Q:R=""
"RTN","BMXMBRK2",66,0)
. S R=$Q(@R)
"RTN","BMXMBRK2",67,0)
. IF R="" Q
"RTN","BMXMBRK2",68,0)
. S L=$L(R)+$L(@R)+1
"RTN","BMXMBRK2",69,0)
. S T=@R
"RTN","BMXMBRK2",70,0)
. S T=$TR(T,$C(44),$C(23))
"RTN","BMXMBRK2",71,0)
. S Y=Y_$E("000"_L,$L(L)+1,$L(L)+3)_R_"="_T
"RTN","BMXMBRK2",72,0)
Q Y_"000"
"RTN","BMXMBRK2",73,0)
;
"RTN","BMXMBRK2",74,0)
BLDU(R) ;Build a parameter string from a scalar
"RTN","BMXMBRK2",75,0)
N DONE,L,N,N1,P1
"RTN","BMXMBRK2",76,0)
IF R=+R Q R
"RTN","BMXMBRK2",77,0)
S N=$F(R,$C(34))
"RTN","BMXMBRK2",78,0)
IF N=0 Q $C(34)_R_$C(34)
"RTN","BMXMBRK2",79,0)
S P1=$E(R,1,N-2)
"RTN","BMXMBRK2",80,0)
S (L,DONE)=0
"RTN","BMXMBRK2",81,0)
F D Q:DONE
"RTN","BMXMBRK2",82,0)
. S N1=$F(R,$C(34),N)
"RTN","BMXMBRK2",83,0)
. IF N1=0 S L=$L(R)+2,N1=L
"RTN","BMXMBRK2",84,0)
. S P1=P1_$C(34,34)_$E(R,N,N1-2)
"RTN","BMXMBRK2",85,0)
. IF N1=L S DONE=1,P1=$C(34)_P1_$C(34) Q
"RTN","BMXMBRK2",86,0)
. S N=N1
"RTN","BMXMBRK2",87,0)
Q $TR(P1,$C(44),$C(23))
"RTN","BMXMBRK2",88,0)
;
"RTN","BMXMBRK2",89,0)
BLDG(R) ;build a parameter string from a global reference
"RTN","BMXMBRK2",90,0)
N I,L,L1,M,T,T1,T2,Y
"RTN","BMXMBRK2",91,0)
K ^TMP("BMXZ",$J)
"RTN","BMXMBRK2",92,0)
IF '$D(R) Q "-1^Reference does not exist"
"RTN","BMXMBRK2",93,0)
S Y=$NA(^TMP("BMXZ",$J,$P($H,",",2)))
"RTN","BMXMBRK2",94,0)
S I=0
"RTN","BMXMBRK2",95,0)
S M=512
"RTN","BMXMBRK2",96,0)
S T1=$P(R,")")
"RTN","BMXMBRK2",97,0)
S L1=$L($P(R,"("))
"RTN","BMXMBRK2",98,0)
F D Q:R=""
"RTN","BMXMBRK2",99,0)
. S R=$Q(@R)
"RTN","BMXMBRK2",100,0)
. S T2=$F(R,"(")
"RTN","BMXMBRK2",101,0)
. IF R=""!(R'[T1) Q
"RTN","BMXMBRK2",102,0)
. S L=$L(R)+$L(@R)-L1
"RTN","BMXMBRK2",103,0)
. S T=@R
"RTN","BMXMBRK2",104,0)
. S T=$TR(T,$C(44),$C(23))
"RTN","BMXMBRK2",105,0)
. S @Y@(I)=$E("000"_L,$L(L)+1,$L(L)+3)_"^("_$E(R,T2,M)_"="_$$BLDU(T)
"RTN","BMXMBRK2",106,0)
. S I=I+1
"RTN","BMXMBRK2",107,0)
S @Y@(I)="000"
"RTN","BMXMBRK2",108,0)
S Y=$TR(Y,$C(44),$C(23))
"RTN","BMXMBRK2",109,0)
Q Y
"RTN","BMXMBRK2",110,0)
;
"RTN","BMXMBRK2",111,0)
OARY() ;EP - create storage array
"RTN","BMXMBRK2",112,0)
N A,DONE,I
"RTN","BMXMBRK2",113,0)
S (DONE,I)=0
"RTN","BMXMBRK2",114,0)
F I=1:1 D Q:DONE
"RTN","BMXMBRK2",115,0)
. S A="BMXS"_I
"RTN","BMXMBRK2",116,0)
. K @A ;temp fix for single array
"RTN","BMXMBRK2",117,0)
. IF '$D(@A) S DONE=1
"RTN","BMXMBRK2",118,0)
S @A="" ;set naked
"RTN","BMXMBRK2",119,0)
Q A
"RTN","BMXMBRK2",120,0)
;
"RTN","BMXMBRK2",121,0)
CREF(R,P) ;EP - Convert array contained in P to reference A
"RTN","BMXMBRK2",122,0)
N I,X,DONE,F1,S
"RTN","BMXMBRK2",123,0)
S DONE=0
"RTN","BMXMBRK2",124,0)
S S=""
"RTN","BMXMBRK2",125,0)
F I=1:1 D Q:DONE
"RTN","BMXMBRK2",126,0)
. IF $P(P,",",I)="" S DONE=1 Q
"RTN","BMXMBRK2",127,0)
. S X(I)=$P(P,",",I)
"RTN","BMXMBRK2",128,0)
. IF X(I)?1"."1A.E D
"RTN","BMXMBRK2",129,0)
. . S F1=$F(X(I),".")
"RTN","BMXMBRK2",130,0)
. . S X(I)="."_R
"RTN","BMXMBRK2",131,0)
. S S=S_X(I)_","
"RTN","BMXMBRK2",132,0)
Q $E(S,1,$L(S)-1)
"RTN","BMXMBRK2",133,0)
;
"RTN","BMXMBRK2",134,0)
GETP(P) ;returns various parameters out of the Protocol string
"RTN","BMXMBRK2",135,0)
N M,T,BMXZ
"RTN","BMXMBRK2",136,0)
S M=512
"RTN","BMXMBRK2",137,0)
S T=$$PRSP^BMXMBRK(P)
"RTN","BMXMBRK2",138,0)
IF '+T D
"RTN","BMXMBRK2",139,0)
. S T=$$PRSM^BMXMBRK(BMXZ(0,"MESG"))
"RTN","BMXMBRK2",140,0)
. IF '+T S T=BMXZ(0,"WKID")_";"_BMXZ(0,"WINH")_";"_BMXZ(0,"PRCH")_";"_BMXZ(0,"WISH")_";"_$P(BMXZ(1,"TEXT"),"^")
"RTN","BMXMBRK2",141,0)
Q T
"RTN","BMXMBRK2",142,0)
;
"RTN","BMXMBRK2",143,0)
CALLM(X,P,DEBUG) ;make call using Message string
"RTN","BMXMBRK2",144,0)
N ERR,S
"RTN","BMXMBRK2",145,0)
S X="",ERR=0
"RTN","BMXMBRK2",146,0)
S ERR=$$PRSM^BMXMBRK(P)
"RTN","BMXMBRK2",147,0)
IF '+ERR S ERR=$$PRSA^BMXMBRK(BMXZ(1,"TEXT"))
"RTN","BMXMBRK2",148,0)
IF '+ERR S S=$$PRSB^BMXMBRK(BMXZ(2,"PARM"))
"RTN","BMXMBRK2",149,0)
IF (+S=0)!(+S>0) D
"RTN","BMXMBRK2",150,0)
. D CAPI(.X,BMXZ(2,"RTAG"),BMXZ(2,"RNAM"),S)
"RTN","BMXMBRK2",151,0)
IF 'DEBUG K BMXZ
"RTN","BMXMBRK2",152,0)
K @(X("BMXS")),X("BMXS")
"RTN","BMXMBRK2",153,0)
Q
"RTN","BMXMBRK2",154,0)
;
"RTN","BMXMBRK2",155,0)
CALLA(X,P,DEBUG) ;make call using API string
"RTN","BMXMBRK2",156,0)
N ERR,S
"RTN","BMXMBRK2",157,0)
S X="",ERR=0
"RTN","BMXMBRK2",158,0)
S ERR=$$PRSA^BMXMBRK(P)
"RTN","BMXMBRK2",159,0)
IF '+ERR S S=$$PRSB^BMXMBRK(BMXZ(2,"PARM"))
"RTN","BMXMBRK2",160,0)
IF (+S=0)!(+S>0) D
"RTN","BMXMBRK2",161,0)
. D CAPI(.X,BMXZ(2,"RTAG"),BMXZ(2,"RNAM"),S)
"RTN","BMXMBRK2",162,0)
IF 'DEBUG K BMXZ
"RTN","BMXMBRK2",163,0)
K @(X("BMXS")),X("BMXS")
"RTN","BMXMBRK2",164,0)
Q
"RTN","BMXMBRK2",165,0)
;
"RTN","BMXMBRK2",166,0)
TRANSPRT() ;Determine the Transport Method
"RTN","BMXMBRK2",167,0)
;DDP is local :=0
"RTN","BMXMBRK2",168,0)
;TCP/IP is remote :=1
"RTN","BMXMBRK2",169,0)
;Serial/RS-232 is remote :=2
"RTN","BMXMBRK2",170,0)
Q 1
"RTN","BMXMBRK2",171,0)
;Q 0 ;Do DDP for Now
"RTN","BMXMEVN")
0^84^B41862703
"RTN","BMXMEVN",1,0)
BMXMEVN ; IHS/OIT/HMW - BMXNet MONITOR ;
"RTN","BMXMEVN",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXMEVN",3,0)
;
"RTN","BMXMEVN",4,0)
Q
"RTN","BMXMEVN",5,0)
;
"RTN","BMXMEVN",6,0)
REGET ;EP
"RTN","BMXMEVN",7,0)
;Error trap from REGEVNT, RAISEVNT, and UNREG
"RTN","BMXMEVN",8,0)
;
"RTN","BMXMEVN",9,0)
I '$D(BMXI) N BMXI S BMXI=999
"RTN","BMXMEVN",10,0)
S BMXI=BMXI+1
"RTN","BMXMEVN",11,0)
D REGERR(BMXI,99)
"RTN","BMXMEVN",12,0)
Q
"RTN","BMXMEVN",13,0)
;
"RTN","BMXMEVN",14,0)
REGERR(BMXI,BMXERID) ;Error processing
"RTN","BMXMEVN",15,0)
S BMXI=BMXI+1
"RTN","BMXMEVN",16,0)
S ^TMP("BMX",$J,BMXI)=BMXERID_$C(30)
"RTN","BMXMEVN",17,0)
S BMXI=BMXI+1
"RTN","BMXMEVN",18,0)
S ^TMP("BMX",$J,BMXI)=$C(31)
"RTN","BMXMEVN",19,0)
Q
"RTN","BMXMEVN",20,0)
;
"RTN","BMXMEVN",21,0)
REGEVNT(BMXY,BMXEVENT) ;EP
"RTN","BMXMEVN",22,0)
;RPC Called by BMX REGISTER EVENT to inform RPMS server
"RTN","BMXMEVN",23,0)
;of client's interest in BMXEVENT
"RTN","BMXMEVN",24,0)
;Returns RECORDSET with field ERRORID.
"RTN","BMXMEVN",25,0)
;If everything ok then ERRORID = 0;
"RTN","BMXMEVN",26,0)
;
"RTN","BMXMEVN",27,0)
N BMXI
"RTN","BMXMEVN",28,0)
S BMXI=0
"RTN","BMXMEVN",29,0)
S X="REGET^BMXMEVN",@^%ZOSF("TRAP")
"RTN","BMXMEVN",30,0)
S BMXY=$NA(^TMP("BMX",$J)) K @BMXY
"RTN","BMXMEVN",31,0)
S ^TMP("BMX",$J,0)="I00020ERRORID"_$C(30)
"RTN","BMXMEVN",32,0)
S ^TMP("BMX EVENT",$J,BMXEVENT)=$G(DUZ)
"RTN","BMXMEVN",33,0)
;
"RTN","BMXMEVN",34,0)
S BMXI=BMXI+1
"RTN","BMXMEVN",35,0)
S ^TMP("BMX",$J,BMXI)="0"_$C(30)_$C(31)
"RTN","BMXMEVN",36,0)
Q
"RTN","BMXMEVN",37,0)
;
"RTN","BMXMEVN",38,0)
RAISEVNT(BMXY,BMXEVENT,BMXPARAM,BMXBACK,BMXKEY) ;EP
"RTN","BMXMEVN",39,0)
;RPC Called to raise event BMXEVENT with parameter BMXPARAM
"RTN","BMXMEVN",40,0)
;If BMXBACK = 'TRUE' then event will be raised back to originator
"RTN","BMXMEVN",41,0)
;Calls EVENT
"RTN","BMXMEVN",42,0)
;Returns a RECORDSET wit the field ERRORID.
"RTN","BMXMEVN",43,0)
;If everything ok then ERRORID = 0;
"RTN","BMXMEVN",44,0)
;
"RTN","BMXMEVN",45,0)
N BMXI,BMXORIG
"RTN","BMXMEVN",46,0)
S BMXI=0
"RTN","BMXMEVN",47,0)
S BMXORIG=$S($G(BMXBACK)="TRUE":"",1:$J)
"RTN","BMXMEVN",48,0)
S BMXY=$NA(^TMP("BMX",$J)) K @BMXY
"RTN","BMXMEVN",49,0)
S ^TMP("BMX",$J,0)="I00020ERRORID"_$C(30)
"RTN","BMXMEVN",50,0)
S X="REGET^BMXMEVN",@^%ZOSF("TRAP")
"RTN","BMXMEVN",51,0)
;
"RTN","BMXMEVN",52,0)
D EVENT(BMXEVENT,BMXPARAM,BMXORIG,$G(BMXKEY))
"RTN","BMXMEVN",53,0)
;
"RTN","BMXMEVN",54,0)
S BMXI=BMXI+1
"RTN","BMXMEVN",55,0)
S ^TMP("BMX",$J,BMXI)="0"_$C(30)_$C(31)
"RTN","BMXMEVN",56,0)
Q
"RTN","BMXMEVN",57,0)
;
"RTN","BMXMEVN",58,0)
EVENT(BMXEVENT,BMXPARAM,BMXORIG,BMXKEY) ;PEP - Raise event to interested clients
"RTN","BMXMEVN",59,0)
;Clients are listed in ^TMP("BMX EVENT",BMXEVENT,BMXSESS)=DUZ
"RTN","BMXMEVN",60,0)
;BMXORIG represents the event originator's session
"RTN","BMXMEVN",61,0)
;The event will not be raised back to the originator if BMXORIG is the session of the originator
"RTN","BMXMEVN",62,0)
;BMXKEY is a ~-delimited list of security keys. Only holders of one of these keys
"RTN","BMXMEVN",63,0)
;will receive event notification. If BMXKEY is "" then all registered sessions
"RTN","BMXMEVN",64,0)
;will be notified.
"RTN","BMXMEVN",65,0)
;
"RTN","BMXMEVN",66,0)
L +^TMP("BMX EVENT RAISED"):30
"RTN","BMXMEVN",67,0)
N BMXSESS,BMXINC
"RTN","BMXMEVN",68,0)
S BMXSESS=0 F S BMXSESS=$O(^TMP("BMX EVENT",BMXSESS)) Q:'+BMXSESS D
"RTN","BMXMEVN",69,0)
. I BMXSESS=$G(BMXORIG) Q
"RTN","BMXMEVN",70,0)
. I '$D(^TMP("BMX EVENT",BMXSESS,BMXEVENT)) Q
"RTN","BMXMEVN",71,0)
. ;S BMXDUZ=^TMP("BMX EVENT",BMXEVENT,BMXSESS)
"RTN","BMXMEVN",72,0)
. S BMXDUZ=^TMP("BMX EVENT",BMXSESS,BMXEVENT)
"RTN","BMXMEVN",73,0)
. ;TODO: Test if DUZ holds at least one of the keys in BMXKEY
"RTN","BMXMEVN",74,0)
. S BMXINC=$O(^TMP("BMX EVENT RAISED",BMXSESS,BMXEVENT,99999999),-1)
"RTN","BMXMEVN",75,0)
. S:BMXINC="" BMXINC=0
"RTN","BMXMEVN",76,0)
. ;S ^TMP("BMXTRACK",$P($H,",",2))="Job "_$J_" Set "_$NA(^TMP("BMX EVENT RAISED",BMXSESS,BMXEVENT,BMXINC+1))_"="_$G(BMXPARAM)
"RTN","BMXMEVN",77,0)
. S ^TMP("BMX EVENT RAISED",BMXSESS,BMXEVENT,BMXINC+1)=$G(BMXPARAM) ;IHS/OIT/HMW SAC Exemption Applied For
"RTN","BMXMEVN",78,0)
. Q
"RTN","BMXMEVN",79,0)
L -^TMP("BMX EVENT RAISED")
"RTN","BMXMEVN",80,0)
Q
"RTN","BMXMEVN",81,0)
;
"RTN","BMXMEVN",82,0)
POLLD(BMXY) ;EP
"RTN","BMXMEVN",83,0)
;Debug Entry Point
"RTN","BMXMEVN",84,0)
D DEBUG^%Serenji("POLL^BMXMEVN(.BMXY)")
"RTN","BMXMEVN",85,0)
Q
"RTN","BMXMEVN",86,0)
;
"RTN","BMXMEVN",87,0)
POLL(BMXY) ;EP
"RTN","BMXMEVN",88,0)
;Check event queue for events of interest to current session
"RTN","BMXMEVN",89,0)
;Return DataSet of events and parameters
"RTN","BMXMEVN",90,0)
;Called by BMX EVENT POLL
"RTN","BMXMEVN",91,0)
;
"RTN","BMXMEVN",92,0)
N BMXI,BMXEVENT
"RTN","BMXMEVN",93,0)
S BMXI=0
"RTN","BMXMEVN",94,0)
S X="POLLET^BMXMEVN",@^%ZOSF("TRAP")
"RTN","BMXMEVN",95,0)
S BMXY=$NA(^TMP("BMX",$J)) K @BMXY
"RTN","BMXMEVN",96,0)
S ^TMP("BMX",$J,0)="T00030EVENT"_U_"T00030PARAM"_$C(30)
"RTN","BMXMEVN",97,0)
L +^TMP("BMX EVENT RAISED"):1 G:'$T POLLEND
"RTN","BMXMEVN",98,0)
;
"RTN","BMXMEVN",99,0)
G:'$D(^TMP("BMX EVENT RAISED",$J)) POLLEND
"RTN","BMXMEVN",100,0)
S BMXEVENT=0 F S BMXEVENT=$O(^TMP("BMX EVENT RAISED",$J,BMXEVENT)) Q:BMXEVENT']"" D
"RTN","BMXMEVN",101,0)
. N BMXINC
"RTN","BMXMEVN",102,0)
. S BMXINC=0
"RTN","BMXMEVN",103,0)
. F S BMXINC=$O(^TMP("BMX EVENT RAISED",$J,BMXEVENT,BMXINC)) Q:'+BMXINC D
"RTN","BMXMEVN",104,0)
. . ;Set output array node
"RTN","BMXMEVN",105,0)
. . S BMXPARAM=$G(^TMP("BMX EVENT RAISED",$J,BMXEVENT,BMXINC))
"RTN","BMXMEVN",106,0)
. . S BMXI=BMXI+1
"RTN","BMXMEVN",107,0)
. . S ^TMP("BMX",$J,BMXI)=BMXEVENT_U_BMXPARAM_$C(30)
"RTN","BMXMEVN",108,0)
. . Q
"RTN","BMXMEVN",109,0)
. Q
"RTN","BMXMEVN",110,0)
;S ^TMP("BMXTRACK",$P($H,",",2))="Job "_$J_" Killed "_$NA(^TMP("BMX EVENT RAISED",$J))
"RTN","BMXMEVN",111,0)
K ^TMP("BMX EVENT RAISED",$J)
"RTN","BMXMEVN",112,0)
;
"RTN","BMXMEVN",113,0)
POLLEND S BMXI=BMXI+1
"RTN","BMXMEVN",114,0)
S ^TMP("BMX",$J,BMXI)=$C(31)
"RTN","BMXMEVN",115,0)
L -^TMP("BMX EVENT RAISED")
"RTN","BMXMEVN",116,0)
Q
"RTN","BMXMEVN",117,0)
;
"RTN","BMXMEVN",118,0)
TTESTD(BMXY,BMXTIME) ;Debug entry point
"RTN","BMXMEVN",119,0)
;
"RTN","BMXMEVN",120,0)
D DEBUG^%Serenji("TTEST^BMXMEVN(.BMXY,BMXTIME)")
"RTN","BMXMEVN",121,0)
Q
"RTN","BMXMEVN",122,0)
;
"RTN","BMXMEVN",123,0)
TTEST(BMXY,BMXTIME) ;EP Timer Test
"RTN","BMXMEVN",124,0)
;
"RTN","BMXMEVN",125,0)
S X="REGET^BMXMEVN",@^%ZOSF("TRAP")
"RTN","BMXMEVN",126,0)
S BMXY=$NA(^BMXTMP("BMX",$J)) K @BMXY
"RTN","BMXMEVN",127,0)
S ^BMXTMP("BMX",$J,0)="I00020HANGTIME"_$C(30)
"RTN","BMXMEVN",128,0)
I +BMXTIME H BMXTIME
"RTN","BMXMEVN",129,0)
;
"RTN","BMXMEVN",130,0)
S BMXI=1
"RTN","BMXMEVN",131,0)
S BMXI=BMXI+1
"RTN","BMXMEVN",132,0)
S ^BMXTMP("BMX",$J,BMXI)=BMXTIME_$C(30)_$C(31)
"RTN","BMXMEVN",133,0)
;
"RTN","BMXMEVN",134,0)
Q
"RTN","BMXMEVN",135,0)
;
"RTN","BMXMEVN",136,0)
UNREGALL ;EP
"RTN","BMXMEVN",137,0)
;Unregister all events for current session
"RTN","BMXMEVN",138,0)
;Called on exit of each session
"RTN","BMXMEVN",139,0)
;
"RTN","BMXMEVN",140,0)
N BMXEVENT
"RTN","BMXMEVN",141,0)
S BMXEVENT=""
"RTN","BMXMEVN",142,0)
K ^TMP("BMX EVENT",$J)
"RTN","BMXMEVN",143,0)
Q
"RTN","BMXMEVN",144,0)
;
"RTN","BMXMEVN",145,0)
UNREG(BMXY,BMXEVENT) ;EP
"RTN","BMXMEVN",146,0)
;RPC Called by client to Unregister client's interest in BMXEVENT
"RTN","BMXMEVN",147,0)
;Returns RECORDSET with field ERRORID.
"RTN","BMXMEVN",148,0)
;If everything ok then ERRORID = 0;
"RTN","BMXMEVN",149,0)
;
"RTN","BMXMEVN",150,0)
N BMXI
"RTN","BMXMEVN",151,0)
S BMXI=0
"RTN","BMXMEVN",152,0)
S X="REGET^BMXMEVN",@^%ZOSF("TRAP")
"RTN","BMXMEVN",153,0)
S BMXY=$NA(^TMP("BMX",$J)) K @BMXY
"RTN","BMXMEVN",154,0)
S ^TMP("BMX",$J,0)="I00020ERRORID"_$C(30)
"RTN","BMXMEVN",155,0)
K ^TMP("BMX EVENT",$J,BMXEVENT)
"RTN","BMXMEVN",156,0)
;
"RTN","BMXMEVN",157,0)
S BMXI=BMXI+1
"RTN","BMXMEVN",158,0)
S ^TMP("BMX",$J,BMXI)="0"_$C(30)_$C(31)
"RTN","BMXMEVN",159,0)
Q
"RTN","BMXMEVN",160,0)
;
"RTN","BMXMEVN",161,0)
POLLET ;EP
"RTN","BMXMEVN",162,0)
;Error trap from REGEVNT, RAISEVNT, ASYNCQUE and UNREG
"RTN","BMXMEVN",163,0)
;
"RTN","BMXMEVN",164,0)
I '$D(BMXI) N BMXI S BMXI=999
"RTN","BMXMEVN",165,0)
S BMXI=BMXI+1
"RTN","BMXMEVN",166,0)
D POLLERR(BMXI,99)
"RTN","BMXMEVN",167,0)
Q
"RTN","BMXMEVN",168,0)
;
"RTN","BMXMEVN",169,0)
POLLERR(BMXI,BMXERID) ;Error processing
"RTN","BMXMEVN",170,0)
S BMXI=BMXI+1
"RTN","BMXMEVN",171,0)
S ^TMP("BMX",$J,BMXI)=BMXERID_U_$C(30)
"RTN","BMXMEVN",172,0)
S BMXI=BMXI+1
"RTN","BMXMEVN",173,0)
S ^TMP("BMX",$J,BMXI)=$C(31)
"RTN","BMXMEVN",174,0)
Q
"RTN","BMXMEVN",175,0)
;
"RTN","BMXMEVN",176,0)
ASYNCQUE(BMXY,BMXRPC,BMXEVN) ;EP
"RTN","BMXMEVN",177,0)
;RPC Queues taskman to job wrapper ASYNCZTM
"RTN","BMXMEVN",178,0)
;
"RTN","BMXMEVN",179,0)
;RETURNS EVENT NAME, ZTSK in PARAM
"RTN","BMXMEVN",180,0)
S X="POLLET^BMXMEVN",@^%ZOSF("TRAP")
"RTN","BMXMEVN",181,0)
S BMXY=$NA(^TMP("BMX ASYNC QUEUE",$J)) K @BMXY
"RTN","BMXMEVN",182,0)
S ^TMP("BMX ASYNC QUEUE",$J,0)="I00030ERRORID"_U_"I00030PARAM"_$C(30)
"RTN","BMXMEVN",183,0)
;
"RTN","BMXMEVN",184,0)
;K ZTSK
"RTN","BMXMEVN",185,0)
N ZTSK,ZTRTN,ZTSAVE,ZTDESC,ZTIO,ZTDTH
"RTN","BMXMEVN",186,0)
;S ZTRTN="ASYNCZTD^BMXMEVN" ;Debugging call
"RTN","BMXMEVN",187,0)
S ZTRTN="ASYNCZTM^BMXMEVN"
"RTN","BMXMEVN",188,0)
S BMXRPC=$TR(BMXRPC,"~",$C(30))
"RTN","BMXMEVN",189,0)
S ZTSAVE("BMXRPC")=""
"RTN","BMXMEVN",190,0)
S ZTSAVE("BMXEVN")=""
"RTN","BMXMEVN",191,0)
S ZTDESC="BMX ASYNC JOB"
"RTN","BMXMEVN",192,0)
S ZTIO="",ZTDTH=DT
"RTN","BMXMEVN",193,0)
D ^%ZTLOAD
"RTN","BMXMEVN",194,0)
;D @ZTRTN ;Debugging call
"RTN","BMXMEVN",195,0)
;
"RTN","BMXMEVN",196,0)
S ^TMP("BMX ASYNC QUEUE",$J,1)=1_U_$G(ZTSK)_$C(30)
"RTN","BMXMEVN",197,0)
S ^TMP("BMX ASYNC QUEUE",$J,2)=$C(31)
"RTN","BMXMEVN",198,0)
Q
"RTN","BMXMEVN",199,0)
;
"RTN","BMXMEVN",200,0)
ASYNCZTD ;EP Debug entry point
"RTN","BMXMEVN",201,0)
D DEBUG^%Serenji("ASYNCZTM^BMXMEVN")
"RTN","BMXMEVN",202,0)
Q
"RTN","BMXMEVN",203,0)
;
"RTN","BMXMEVN",204,0)
ASYNCZTM ;EP
"RTN","BMXMEVN",205,0)
;Called by Taskman with BMXRPC and BMXEVN defined to
"RTN","BMXMEVN",206,0)
; 1) invoke the BMXRPC (RPC NAME^PARAM1^...^PARAMN)
"RTN","BMXMEVN",207,0)
; 2) when done, raises event BMXEVN with ZTSK^$J in BMXPARAM
"RTN","BMXMEVN",208,0)
;
"RTN","BMXMEVN",209,0)
N BMXRTN,BMXTAG,BMXRPCD,BMXCALL,BMXJ,BMXY,BMXNOD,BMXY
"RTN","BMXMEVN",210,0)
N BMXT S BMXT=$C(30)
"RTN","BMXMEVN",211,0)
I $E(BMXRPC,1,6)="SELECT" S BMXRPC="BMX SQL"_$C(30)_BMXRPC
"RTN","BMXMEVN",212,0)
S BMXRPCD=$O(^XWB(8994,"B",$P(BMXRPC,BMXT),0))
"RTN","BMXMEVN",213,0)
S BMXNOD=^XWB(8994,BMXRPCD,0)
"RTN","BMXMEVN",214,0)
S BMXRTN=$P(BMXNOD,U,3)
"RTN","BMXMEVN",215,0)
S BMXTAG=$P(BMXNOD,U,2)
"RTN","BMXMEVN",216,0)
S BMXCALL="D "_BMXTAG_"^"_BMXRTN_"(.BMXY,"
"RTN","BMXMEVN",217,0)
F BMXJ=2:1:$L(BMXRPC,BMXT) D
"RTN","BMXMEVN",218,0)
. S BMXCALL=BMXCALL_$C(34)_$P(BMXRPC,BMXT,BMXJ)_$C(34)
"RTN","BMXMEVN",219,0)
. S:BMXJ<$L(BMXRPC,BMXT) BMXCALL=BMXCALL_","
"RTN","BMXMEVN",220,0)
. Q
"RTN","BMXMEVN",221,0)
S BMXCALL=BMXCALL_")"
"RTN","BMXMEVN",222,0)
X BMXCALL
"RTN","BMXMEVN",223,0)
D EVENT(BMXEVN,$G(ZTSK)_"~"_$P($G(BMXY),U,2),$J,"")
"RTN","BMXMEVN",224,0)
Q
"RTN","BMXMEVN",225,0)
;
"RTN","BMXMEVN",226,0)
;
"RTN","BMXMEVN",227,0)
;Windows event handler:
"RTN","BMXMEVN",228,0)
;Catches event with ZTSK^DataLocation parameter
"RTN","BMXMEVN",229,0)
;Matches ZTSK to process that called event
"RTN","BMXMEVN",230,0)
;Calls ASYNCGET rpc with DATALOCATION parameter
"RTN","BMXMEVN",231,0)
;
"RTN","BMXMEVN",232,0)
ASYNCGET(BMXY,BMXDATA) ;EP
"RTN","BMXMEVN",233,0)
;RPC Retrieves data queued by ASYNCZTM
"RTN","BMXMEVN",234,0)
;by setting BMXY to BMXDATA
"RTN","BMXMEVN",235,0)
;
"RTN","BMXMEVN",236,0)
S BMXY="^"_BMXDATA
"RTN","BMXMEVN",237,0)
Q
"RTN","BMXMEVN",238,0)
;
"RTN","BMXMEVN",239,0)
ASYNCET ;EP
"RTN","BMXMEVN",240,0)
;Error trap from ASYNCQUE
"RTN","BMXMEVN",241,0)
;
"RTN","BMXMEVN",242,0)
I '$D(BMXI) N BMXI S BMXI=999
"RTN","BMXMEVN",243,0)
S BMXI=BMXI+1
"RTN","BMXMEVN",244,0)
D ASYNCERR(BMXI,0)
"RTN","BMXMEVN",245,0)
Q
"RTN","BMXMEVN",246,0)
;
"RTN","BMXMEVN",247,0)
ASYNCERR(BMXI,BMXERID) ;Error processing
"RTN","BMXMEVN",248,0)
S BMXI=BMXI+1
"RTN","BMXMEVN",249,0)
S ^TMP("BMX ASYNC QUEUE",$J,BMXI)=BMXERID_U_$C(30)
"RTN","BMXMEVN",250,0)
S BMXI=BMXI+1
"RTN","BMXMEVN",251,0)
S ^TMP("BMX ASYNC QUEUE",$J,BMXI)=$C(31)
"RTN","BMXMEVN",252,0)
Q
"RTN","BMXMON")
0^58^B199224797
"RTN","BMXMON",1,0)
BMXMON ; IHS/OIT/HMW,VW/SMH - BMXNet MONITOR ; 7/20/2009 ; 7/25/11 9:32am
"RTN","BMXMON",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXMON",3,0)
;
"RTN","BMXMON",4,0)
;IHS/OIT/HMW Patch 1 added validity check for passed-in namespace
"RTN","BMXMON",5,0)
; 7/20/2009: Release of patch to support GT.M WV/SMH
"RTN","BMXMON",6,0)
; Changes:
"RTN","BMXMON",7,0)
; Addition of XINETD and GTMLNX entry points for support of GT.M
"RTN","BMXMON",8,0)
; Changes of W *-3 (which only works on Cache) to W !
"RTN","BMXMON",9,0)
; 9/7/2010: Minor bug fixes and enhancements
"RTN","BMXMON",10,0)
; In GTMLNX: Set process name
"RTN","BMXMON",11,0)
; In GTMLNX: Time out based now on the Kernel Broker Timeout field
"RTN","BMXMON",12,0)
; in kernel system parameters file
"RTN","BMXMON",13,0)
; 12/12/2010: Minor bug fixes
"RTN","BMXMON",14,0)
; ETRAP nows screens errors before logging them. If it is a network
"RTN","BMXMON",15,0)
; write error, it's not logged to the Error Trap
"RTN","BMXMON",16,0)
; Set Process Name crashed on Cache due to undefined IO("GT.M").
"RTN","BMXMON",17,0)
; Now this is surrounded by $Get to prevent this error.
"RTN","BMXMON",18,0)
; 6/25/2011: Fix to error trapping introduced by last patch.
"RTN","BMXMON",19,0)
; Having N $ETRAP before setting $ETRAP as the backup trap causes
"RTN","BMXMON",20,0)
; an infinite loop because of the restoration of the old trap
"RTN","BMXMON",21,0)
; which lead it there in the first place. Removing N $ETRAP.
"RTN","BMXMON",22,0)
;
"RTN","BMXMON",23,0)
STRT(BMXPORT,NS,IS,VB) ;EP
"RTN","BMXMON",24,0)
;Interactive monitor start
"RTN","BMXMON",25,0)
;Optional NS = namespace. If undefined, start in current ns
"RTN","BMXMON",26,0)
;Optional IS = Integrated Security. Default is 1
"RTN","BMXMON",27,0)
;Optional VB = Verbose. Default is 1
"RTN","BMXMON",28,0)
;
"RTN","BMXMON",29,0)
N Y,BMXNS,BMXWIN
"RTN","BMXMON",30,0)
;
"RTN","BMXMON",31,0)
;Verbose
"RTN","BMXMON",32,0)
S BMXVB=$G(VB,1)
"RTN","BMXMON",33,0)
;
"RTN","BMXMON",34,0)
;Check if port already running
"RTN","BMXMON",35,0)
I '$$SEMAPHOR(BMXPORT,"LOCK") W:BMXVB "BMXNet Monitor on port "_BMXPORT_" appears to be running already.",! Q
"RTN","BMXMON",36,0)
S %=$$SEMAPHOR(BMXPORT,"UNLOCK")
"RTN","BMXMON",37,0)
;
"RTN","BMXMON",38,0)
D MARKER(BMXPORT,1) ;record problem marker
"RTN","BMXMON",39,0)
; -- start the monitor
"RTN","BMXMON",40,0)
;
"RTN","BMXMON",41,0)
;Namespace
"RTN","BMXMON",42,0)
X ^%ZOSF("UCI")
"RTN","BMXMON",43,0)
S BMXNS=$G(NS,$P(Y,","))
"RTN","BMXMON",44,0)
;
"RTN","BMXMON",45,0)
;Integrated security
"RTN","BMXMON",46,0)
S BMXWIN=$G(IS,1)
"RTN","BMXMON",47,0)
;
"RTN","BMXMON",48,0)
;J DEBUG^%Serenji("MON^BMXMON("_BMXPORT_","_BMXNS_","_BMXWIN_")")
"RTN","BMXMON",49,0)
J MON^BMXMON(BMXPORT,BMXNS,BMXWIN)::5 I '$T W:BMXVB "Unable to run BMXNet Monitor in background.",! Q ;IHS/OIT/HMW SAC Exemption Applied For
"RTN","BMXMON",50,0)
F %=1:1:5 D Q:%=0
"RTN","BMXMON",51,0)
. W:BMXVB "Checking if BMXNet Monitor has started...",!
"RTN","BMXMON",52,0)
. H 1
"RTN","BMXMON",53,0)
. S:'$$MARKER(BMXPORT,0) %=0
"RTN","BMXMON",54,0)
I $$MARKER(BMXPORT,0) D
"RTN","BMXMON",55,0)
. W:BMXVB !,"BMXNet Monitor could not be started!",!
"RTN","BMXMON",56,0)
. W:BMXVB "Check if port "_BMXPORT_" is busy on this CPU.",!
"RTN","BMXMON",57,0)
. D MARKER(BMXPORT,-1) ;clear marker
"RTN","BMXMON",58,0)
E W:BMXVB "BMXNet Monitor started successfully."
"RTN","BMXMON",59,0)
;
"RTN","BMXMON",60,0)
Q
"RTN","BMXMON",61,0)
;
"RTN","BMXMON",62,0)
RESTART ;EP
"RTN","BMXMON",63,0)
;Stop and Start all monitors in BMX MONITOR file
"RTN","BMXMON",64,0)
;Called by option BMX MONITOR START
"RTN","BMXMON",65,0)
;
"RTN","BMXMON",66,0)
D STOPALL
"RTN","BMXMON",67,0)
D STRTALL
"RTN","BMXMON",68,0)
Q
"RTN","BMXMON",69,0)
;
"RTN","BMXMON",70,0)
STRTALL ;EP
"RTN","BMXMON",71,0)
;Start all monitors in BMX MONITOR file
"RTN","BMXMON",72,0)
;
"RTN","BMXMON",73,0)
N BMXIEN
"RTN","BMXMON",74,0)
S BMXIEN=0 F S BMXIEN=$O(^BMXMON(BMXIEN)) Q:'+BMXIEN D
"RTN","BMXMON",75,0)
. S BMXNOD=$G(^BMXMON(BMXIEN,0))
"RTN","BMXMON",76,0)
. Q:'+BMXNOD
"RTN","BMXMON",77,0)
. Q:'+$P(BMXNOD,U,2)
"RTN","BMXMON",78,0)
. S BMXWIN=$P(BMXNOD,U,3)
"RTN","BMXMON",79,0)
. S BMXNS=$P(BMXNOD,U,4)
"RTN","BMXMON",80,0)
. D STRT($P(BMXNOD,U),BMXNS,BMXWIN,0)
"RTN","BMXMON",81,0)
. Q
"RTN","BMXMON",82,0)
Q
"RTN","BMXMON",83,0)
;
"RTN","BMXMON",84,0)
STOPALL ;EP
"RTN","BMXMON",85,0)
;Stop all monitors in BMXNET MONITOR file
"RTN","BMXMON",86,0)
;
"RTN","BMXMON",87,0)
N BMXIEN,BMXPORT
"RTN","BMXMON",88,0)
S BMXIEN=0 F S BMXIEN=$O(^BMXMON(BMXIEN)) Q:'+BMXIEN D
"RTN","BMXMON",89,0)
. S BMXNOD=$G(^BMXMON(BMXIEN,0))
"RTN","BMXMON",90,0)
. Q:'+BMXNOD
"RTN","BMXMON",91,0)
. S BMXPORT=+BMXNOD
"RTN","BMXMON",92,0)
. D STOP(BMXPORT,0)
"RTN","BMXMON",93,0)
Q
"RTN","BMXMON",94,0)
;
"RTN","BMXMON",95,0)
STOP(BMXPORT,VB) ;EP Stop monitor on BMXPORT
"RTN","BMXMON",96,0)
;Open a channel to monitor on BMXPORT and send shutdown request
"RTN","BMXMON",97,0)
;Optional VB = Verbose. Default is 1
"RTN","BMXMON",98,0)
;
"RTN","BMXMON",99,0)
N IP,REF,X,DEV
"RTN","BMXMON",100,0)
S U="^" D HOME^%ZIS
"RTN","BMXMON",101,0)
;
"RTN","BMXMON",102,0)
;Verbose
"RTN","BMXMON",103,0)
S BMXVB=$G(VB,1)
"RTN","BMXMON",104,0)
;
"RTN","BMXMON",105,0)
D:BMXVB EN^DDIOL("Stop BMXNet Monitor...")
"RTN","BMXMON",106,0)
X ^%ZOSF("UCI") S REF=Y
"RTN","BMXMON",107,0)
S IP="0.0.0.0" ;get server IP
"RTN","BMXMON",108,0)
IF $G(BMXPORT)="" S BMXPORT=9200
"RTN","BMXMON",109,0)
; -- make sure the listener is running
"RTN","BMXMON",110,0)
I $$SEMAPHOR(BMXPORT,"LOCK") D Q
"RTN","BMXMON",111,0)
. S %=$$SEMAPHOR(BMXPORT,"UNLOCK")
"RTN","BMXMON",112,0)
. D:BMXVB EN^DDIOL("BMXNet Monitor does not appear to be running.")
"RTN","BMXMON",113,0)
; -- send the shutdown message to the TCP Listener process
"RTN","BMXMON",114,0)
D CALL^%ZISTCP("127.0.0.1",BMXPORT) I POP D Q
"RTN","BMXMON",115,0)
. S %=$$SEMAPHOR(BMXPORT,"UNLOCK")
"RTN","BMXMON",116,0)
. D:BMXVB EN^DDIOL("BMXNet Monitor does not appear to be running.")
"RTN","BMXMON",117,0)
U IO
"RTN","BMXMON",118,0)
S X=$T(+2),X=$P(X,";;",2),X=$P(X,";")
"RTN","BMXMON",119,0)
IF X="" S X=0
"RTN","BMXMON",120,0)
S X=$C($L(X))_X
"RTN","BMXMON",121,0)
W "{BMX}00011TCPshutdown",!
"RTN","BMXMON",122,0)
R X#3:5
"RTN","BMXMON",123,0)
D CLOSE^%ZISTCP
"RTN","BMXMON",124,0)
I X="ack" D:BMXVB EN^DDIOL("BMXNet Monitor has been shutdown.")
"RTN","BMXMON",125,0)
E D:BMXVB EN^DDIOL("Shutdown Failed!")
"RTN","BMXMON",126,0)
;change process name
"RTN","BMXMON",127,0)
D CHPRN($J)
"RTN","BMXMON",128,0)
Q
"RTN","BMXMON",129,0)
;
"RTN","BMXMON",130,0)
MON(BMXPORT,NS,IS) ;Monitor port for connection & shutdown requests
"RTN","BMXMON",131,0)
;NS = Namespace to Start monitor
"RTN","BMXMON",132,0)
;IS = 1: Enable integrated security
"RTN","BMXMON",133,0)
;
"RTN","BMXMON",134,0)
N BMXDEV,BMXQUIT,BMXDTIME,BMXLEN,BMXACT,BMXWIN,BMXNS
"RTN","BMXMON",135,0)
S BMXQUIT=0,BMXDTIME=999999
"RTN","BMXMON",136,0)
;
"RTN","BMXMON",137,0)
;Set lock
"RTN","BMXMON",138,0)
Q:'$$SEMAPHOR(BMXPORT,"LOCK")
"RTN","BMXMON",139,0)
;Clear problem marker
"RTN","BMXMON",140,0)
D MARKER(BMXPORT,-1)
"RTN","BMXMON",141,0)
;H 1
"RTN","BMXMON",142,0)
;
"RTN","BMXMON",143,0)
;Namespace
"RTN","BMXMON",144,0)
X ^%ZOSF("UCI")
"RTN","BMXMON",145,0)
S BMXNS=$G(NS,$P(Y,","))
"RTN","BMXMON",146,0)
;
"RTN","BMXMON",147,0)
;Integrated security
"RTN","BMXMON",148,0)
S BMXWIN=$G(IS,1)
"RTN","BMXMON",149,0)
;
"RTN","BMXMON",150,0)
;Open server port;
"RTN","BMXMON",151,0)
S BMXDEV="|TCP|"_BMXPORT
"RTN","BMXMON",152,0)
C BMXDEV ;IHS/OIT/HMW SAC Exemption Applied For
"RTN","BMXMON",153,0)
O BMXDEV:(:BMXPORT:"S"):5 I '$T Q ;IHS/OIT/HMW SAC Exemption Applied For
"RTN","BMXMON",154,0)
;
"RTN","BMXMON",155,0)
;S BMXDTIME(1)=BMXDTIME ; TODO: Set timeouts
"RTN","BMXMON",156,0)
S BMXDTIME(1)=.5 ;HMW 20050120
"RTN","BMXMON",157,0)
U BMXDEV
"RTN","BMXMON",158,0)
F D Q:BMXQUIT
"RTN","BMXMON",159,0)
. R BMXACT#5:BMXDTIME ;Read first 5 chars from TCP buffer, timeout=BMXDTIME
"RTN","BMXMON",160,0)
. I BMXACT'="{BMX}" S BMXQUIT=1 Q
"RTN","BMXMON",161,0)
. R BMXACT#5:BMXDTIME ;Read next 5 chars - message length
"RTN","BMXMON",162,0)
. S BMXLEN=+BMXACT
"RTN","BMXMON",163,0)
. R BMXACT#BMXLEN:BMXDTIME
"RTN","BMXMON",164,0)
. I $P(BMXACT,"^")="TCPconnect" D Q
"RTN","BMXMON",165,0)
. . ;IHS/OIT/HMW added validity check for namespace
"RTN","BMXMON",166,0)
. . N BMXNSJ,X,Y
"RTN","BMXMON",167,0)
. . S BMXNSJ=$P(BMXACT,"^",2) ;Namespace
"RTN","BMXMON",168,0)
. . S BMXNSJ=$P(BMXNSJ,",")
"RTN","BMXMON",169,0)
. . ;if passed in namespace is invalid, new job will start in listener namespace
"RTN","BMXMON",170,0)
. . I BMXNSJ]"" S X=BMXNSJ X ^%ZOSF("UCICHECK") S:Y=0 BMXNSJ=BMXNS
"RTN","BMXMON",171,0)
. . ;Job another MONITOR using concurrent connection
"RTN","BMXMON",172,0)
. . ;J DEBUG^%Serenji("SESSION^BMXMON("_BMXWIN_")"):(:5:BMXDEV:BMXDEV):5
"RTN","BMXMON",173,0)
. . ;J SESSION^BMXMON(BMXWIN)[$P(BMXNS,",")]:(:5:BMXDEV:BMXDEV):5 ;IHS/OIT/HMW SAC Exemption Applied For
"RTN","BMXMON",174,0)
. . J SESSION^BMXMON(BMXWIN)[BMXNSJ]:(:5:BMXDEV:BMXDEV):5 ;IHS/OIT/HMW SAC Exemption Applied For
"RTN","BMXMON",175,0)
. I $P(BMXACT,"^")="TCPshutdown" S BMXQUIT=1 W "ack",!
"RTN","BMXMON",176,0)
S %=$$SEMAPHOR(BMXPORT,"UNLOCK") ; destroy 'running flag'
"RTN","BMXMON",177,0)
Q
"RTN","BMXMON",178,0)
;
"RTN","BMXMON",179,0)
XINETD ;PEP Directly from xinetd or inetd for GT.M
"RTN","BMXMON",180,0)
N BMXDEV
"RTN","BMXMON",181,0)
S U="^",$ETRAP="D ^%ZTER H" ;Set up the error trap
"RTN","BMXMON",182,0)
S $ZT="" ;Clear old trap
"RTN","BMXMON",183,0)
; GT.M specific error and device code
"RTN","BMXMON",184,0)
S @("$ZINTERRUPT=""I $$JOBEXAM^ZU($ZPOSITION)""")
"RTN","BMXMON",185,0)
S BMXDEV=$P X "U BMXDEV:(nowrap:nodelimiter:ioerror=""TRAP"")"
"RTN","BMXMON",186,0)
S %="",@("%=$ZTRNLNM(""REMOTE_HOST"")") S:$L(%) IO("GTM-IP")=%
"RTN","BMXMON",187,0)
I %["::ffff:" S IO("GTM-IP")=$P(%,"::ffff:",2) ; IPv6 support
"RTN","BMXMON",188,0)
; Read message type
"RTN","BMXMON",189,0)
N BMXACT,BMXDTIME
"RTN","BMXMON",190,0)
S BMXDTIME=10 ; change in 2.2 instead of 9999999 - initial conn timout
"RTN","BMXMON",191,0)
R BMXACT#5:BMXDTIME
"RTN","BMXMON",192,0)
Q:BMXACT'="{BMX}" ; Not a BMX message - quit.
"RTN","BMXMON",193,0)
; Fall through to below...
"RTN","BMXMON",194,0)
GTMLNX ;EP from XWBTCPM for GT.M
"RTN","BMXMON",195,0)
; not implementing NS and integrated authentication
"RTN","BMXMON",196,0)
; Vars: Read timeout, msg len, msg, windows auth, Namespace
"RTN","BMXMON",197,0)
N BMXDTIME,BMXLEN,BMXACT,BMXWIN,BMXNS
"RTN","BMXMON",198,0)
S BMXNSJ="",BMXWIN=0 ; No NS on GT.M, no Windows Authentication
"RTN","BMXMON",199,0)
S BMXDTIME(1)=.5,BMXDTIME=180 ; sign on timeout like XWBTCPM
"RTN","BMXMON",200,0)
R BMXACT#5:BMXDTIME ;Read next 5 chars - message length
"RTN","BMXMON",201,0)
S BMXLEN=+BMXACT
"RTN","BMXMON",202,0)
R BMXACT#BMXLEN:BMXDTIME
"RTN","BMXMON",203,0)
I $P(BMXACT,"^")="TCPconnect" G SESSRES
"RTN","BMXMON",204,0)
I $P(BMXACT,"^")="TCPshutdown" W "ack",! Q
"RTN","BMXMON",205,0)
Q ; Should't hit this quit, but just in case
"RTN","BMXMON",206,0)
;
"RTN","BMXMON",207,0)
SESSION(BMXWIN) ;EP
"RTN","BMXMON",208,0)
;Start session monitor
"RTN","BMXMON",209,0)
;BMXWIN = 1: Enable integrated security
"RTN","BMXMON",210,0)
SESSRES ;EP - reentry point from trap
"RTN","BMXMON",211,0)
;IHS/OIT/HMW SAC Exemption Applied For
"RTN","BMXMON",212,0)
S BMXDTIME(1)=.5,BMXDTIME=$$BAT^XUPARAM ; new in 2.2: Use kernel rpc timeout instead of 9999999
"RTN","BMXMON",213,0)
;
"RTN","BMXMON",214,0)
; Change Process Name (new in 2.2 and 2.3)
"RTN","BMXMON",215,0)
; (GT.M doesn't store the IP in $P, but Cache does. We get GT.M
"RTN","BMXMON",216,0)
; remote process IP from linux env var $REMOTE_HOST)
"RTN","BMXMON",217,0)
D:+$G(IO("GTM-IP")) CHPRN("BMX:ip"_$P(IO("GTM-IP"),".",3,4)) ; GT.M
"RTN","BMXMON",218,0)
D:+$P CHPRN("BMX:ip_"_$P($P,".",3,4)) ; Cache
"RTN","BMXMON",219,0)
;
"RTN","BMXMON",220,0)
N $ESTACK S $ETRAP="D ETRAP^BMXMON"
"RTN","BMXMON",221,0)
S DIQUIET=1,U="^" D DT^DICRW
"RTN","BMXMON",222,0)
D UNREGALL^BMXMEVN ;Unregister all events for this session
"RTN","BMXMON",223,0)
U $P D SESSMAIN
"RTN","BMXMON",224,0)
;Turn off the error trap for the exit
"RTN","BMXMON",225,0)
S $ETRAP=""
"RTN","BMXMON",226,0)
I $G(DUZ) D LOGOUT^XUSRB
"RTN","BMXMON",227,0)
K BMXR,BMXARY
"RTN","BMXMON",228,0)
C $P ;IHS/OIT/HMW SAC Exemption Applied For
"RTN","BMXMON",229,0)
Q
"RTN","BMXMON",230,0)
;
"RTN","BMXMON",231,0)
SESSMAIN ;
"RTN","BMXMON",232,0)
N BMXTBUF
"RTN","BMXMON",233,0)
D SETUP^BMXMSEC(.RET) ;Setup required system vars
"RTN","BMXMON",234,0)
S U="^"
"RTN","BMXMON",235,0)
U $P
"RTN","BMXMON",236,0)
F D Q:BMXTBUF="#BYE#"
"RTN","BMXMON",237,0)
. R BMXTBUF#11:BMXDTIME IF '$T D TIMEOUT S BMXTBUF="#BYE#" Q
"RTN","BMXMON",238,0)
. I BMXTBUF["XQKEY" S HWMP=1
"RTN","BMXMON",239,0)
. I BMXTBUF="#BYE#" Q
"RTN","BMXMON",240,0)
. S BMXHTYPE=$S($E(BMXTBUF,1,5)="{BMX}":1,1:0) ;check HDR
"RTN","BMXMON",241,0)
. I 'BMXHTYPE S BMXTBUF="#BYE#" D SNDERR W BMXTBUF,$C(4),! Q
"RTN","BMXMON",242,0)
. S BMXTLEN=$E(BMXTBUF,6,10),L=$E(BMXTBUF,11,11)
"RTN","BMXMON",243,0)
. R BMXTBUF#4:BMXDTIME(1) S BMXTBUF=L_BMXTBUF
"RTN","BMXMON",244,0)
. S BMXPLEN=BMXTBUF
"RTN","BMXMON",245,0)
. R BMXTBUF#BMXPLEN:BMXDTIME(1)
"RTN","BMXMON",246,0)
. I $P(BMXTBUF,U)="TCPconnect" D Q
"RTN","BMXMON",247,0)
. . D SNDERR W "accept",$C(4),! ;Ack
"RTN","BMXMON",248,0)
. IF BMXHTYPE D
"RTN","BMXMON",249,0)
. . K BMXR,BMXARY
"RTN","BMXMON",250,0)
. . IF BMXTBUF="#BYE#" D SNDERR W "#BYE#",$C(4),! Q
"RTN","BMXMON",251,0)
. . S BMXTLEN=BMXTLEN-15
"RTN","BMXMON",252,0)
. . D CALLP^BMXMBRK(.BMXR,BMXTBUF)
"RTN","BMXMON",253,0)
. . S BMXPTYPE=$S('$D(BMXPTYPE):1,BMXPTYPE<1:1,BMXPTYPE>6:1,1:BMXPTYPE)
"RTN","BMXMON",254,0)
. IF BMXTBUF="#BYE#" Q
"RTN","BMXMON",255,0)
. U $P
"RTN","BMXMON",256,0)
. D SNDERR ;Clears SNDERR parameters
"RTN","BMXMON",257,0)
. D SND
"RTN","BMXMON",258,0)
. D WRITE($C(4)) W ! ;send eot and flush buffer
"RTN","BMXMON",259,0)
D UNREGALL^BMXMEVN ;Unregister all events for this session
"RTN","BMXMON",260,0)
Q ;End Of Main
"RTN","BMXMON",261,0)
;
"RTN","BMXMON",262,0)
SNDERR ;send error information
"RTN","BMXMON",263,0)
;BMXSEC is the security packet, BMXERROR is application packet
"RTN","BMXMON",264,0)
N X
"RTN","BMXMON",265,0)
S X=$E($G(BMXSEC),1,255)
"RTN","BMXMON",266,0)
W $C($L(X))_X W !
"RTN","BMXMON",267,0)
S X=$E($G(BMXERROR),1,255)
"RTN","BMXMON",268,0)
W $C($L(X))_X W !
"RTN","BMXMON",269,0)
S BMXERROR="",BMXSEC="" ;clears parameters
"RTN","BMXMON",270,0)
Q
"RTN","BMXMON",271,0)
;
"RTN","BMXMON",272,0)
WRITE(BMXSTR) ;Write a data string
"RTN","BMXMON",273,0)
;
"RTN","BMXMON",274,0)
I $L(BMXSTR)<511 W ! W BMXSTR Q
"RTN","BMXMON",275,0)
;Handle a long string
"RTN","BMXMON",276,0)
W ! ;Flush the buffer
"RTN","BMXMON",277,0)
F Q:'$L(BMXSTR) W $E(BMXSTR,1,510),! S BMXSTR=$E(BMXSTR,511,99999)
"RTN","BMXMON",278,0)
Q
"RTN","BMXMON",279,0)
SND ; -- send data for all, Let WRITE sort it out
"RTN","BMXMON",280,0)
N I,T
"RTN","BMXMON",281,0)
;
"RTN","BMXMON",282,0)
; -- error or abort occurred, send null
"RTN","BMXMON",283,0)
IF $L(BMXSEC)>0 D WRITE("") Q
"RTN","BMXMON",284,0)
; -- single value
"RTN","BMXMON",285,0)
IF BMXPTYPE=1 S BMXR=$G(BMXR) D WRITE(BMXR) Q
"RTN","BMXMON",286,0)
; -- table delimited by CR+LF
"RTN","BMXMON",287,0)
IF BMXPTYPE=2 D Q
"RTN","BMXMON",288,0)
. S I="" F S I=$O(BMXR(I)) Q:I="" D WRITE(BMXR(I)),WRITE($C(13,10))
"RTN","BMXMON",289,0)
; -- word processing
"RTN","BMXMON",290,0)
IF BMXPTYPE=3 D Q
"RTN","BMXMON",291,0)
. S I="" F S I=$O(BMXR(I)) Q:I="" D WRITE(BMXR(I)) D:BMXWRAP WRITE($C(13,10))
"RTN","BMXMON",292,0)
; -- global array
"RTN","BMXMON",293,0)
IF BMXPTYPE=4 D Q
"RTN","BMXMON",294,0)
. S I=$G(BMXR) Q:I="" S T=$E(I,1,$L(I)-1) D:$D(@I)>10 WRITE(@I)
"RTN","BMXMON",295,0)
. F S I=$Q(@I) Q:I=""!(I'[T) W ! W @I W:BMXWRAP&(@I'=$C(13,10)) $C(13,10)
"RTN","BMXMON",296,0)
. IF $D(@BMXR) K @BMXR
"RTN","BMXMON",297,0)
; -- global instance
"RTN","BMXMON",298,0)
IF BMXPTYPE=5 S BMXR=$G(@BMXR) D WRITE(BMXR) Q
"RTN","BMXMON",299,0)
; -- variable length records only good upto 255 char)
"RTN","BMXMON",300,0)
IF BMXPTYPE=6 S I="" F S I=$O(BMXR(I)) Q:I="" D WRITE($C($L(BMXR(I)))),WRITE(BMXR(I))
"RTN","BMXMON",301,0)
Q
"RTN","BMXMON",302,0)
;
"RTN","BMXMON",303,0)
TIMEOUT ;Do this on MAIN loop timeout
"RTN","BMXMON",304,0)
I $G(DUZ)>0 D SNDERR,WRITE("#BYE#"_$C(4)) Q
"RTN","BMXMON",305,0)
;Sign-on timeout
"RTN","BMXMON",306,0)
S BMXR(0)=0,BMXR(1)=1,BMXR(2)="",BMXR(3)="TIME-OUT",BMXPTYPE=2
"RTN","BMXMON",307,0)
D SNDERR,SND,WRITE($C(4))
"RTN","BMXMON",308,0)
Q
"RTN","BMXMON",309,0)
;
"RTN","BMXMON",310,0)
SEMAPHOR(BMXTSKT,BMXACT) ;Lock/Unlock BMXMON semaphore
"RTN","BMXMON",311,0)
N RESULT
"RTN","BMXMON",312,0)
S U="^",RESULT=1
"RTN","BMXMON",313,0)
D GETENV^%ZOSV ;get Y=UCI^VOL^NODE^BOXLOOKUP of current system
"RTN","BMXMON",314,0)
I BMXACT="LOCK" D
"RTN","BMXMON",315,0)
. L +^BMXMON("BMXMON",$P(Y,U,2),$P(Y,U),$P(Y,U,4),BMXTSKT):1
"RTN","BMXMON",316,0)
. S RESULT=$T
"RTN","BMXMON",317,0)
E L -^BMXMON("BMXMON",$P(Y,U,2),$P(Y,U),$P(Y,U,4),BMXTSKT)
"RTN","BMXMON",318,0)
Q RESULT
"RTN","BMXMON",319,0)
;
"RTN","BMXMON",320,0)
CHPRN(N) ;Change process name to N.
"RTN","BMXMON",321,0)
D SETNM^%ZOSV($E(N,1,15))
"RTN","BMXMON",322,0)
Q
"RTN","BMXMON",323,0)
;
"RTN","BMXMON",324,0)
MARKER(BMXPORT,BMXMODE) ;Set/Test/Clear Problem Marker, BMXMODE=0 is a function
"RTN","BMXMON",325,0)
N IP,Y,%,REF X ^%ZOSF("UCI") S REF=Y,IP="0.0.0.0",%=0
"RTN","BMXMON",326,0)
L +^BMX(IP,REF,BMXPORT,"PROBLEM MARKER"):1
"RTN","BMXMON",327,0)
I BMXMODE=1 S ^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")=1
"RTN","BMXMON",328,0)
I BMXMODE=0 S:$D(^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")) %=1
"RTN","BMXMON",329,0)
I BMXMODE=-1 K ^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")
"RTN","BMXMON",330,0)
L -^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")
"RTN","BMXMON",331,0)
Q:BMXMODE=0 % Q
"RTN","BMXMON",332,0)
;
"RTN","BMXMON",333,0)
ETRAP ; -- on trapped error, send error info to client
"RTN","BMXMON",334,0)
; Error Trap Vars: Code, Error, Last Global Reference
"RTN","BMXMON",335,0)
N BMXERC,BMXERR,BMXLGR
"RTN","BMXMON",336,0)
;
"RTN","BMXMON",337,0)
; Change trapping during trap.
"RTN","BMXMON",338,0)
; V:2.31: Removed N $ETRAP as it caused an infinite loop
"RTN","BMXMON",339,0)
; when combined with the penultimate line of this trap.
"RTN","BMXMON",340,0)
; N $ETRAP causes it to revert back to the old trap which
"RTN","BMXMON",341,0)
; is this EP when a quit happens to pop the $STACK.
"RTN","BMXMON",342,0)
;
"RTN","BMXMON",343,0)
S $ETRAP="D ^%ZTER HALT"
"RTN","BMXMON",344,0)
;
"RTN","BMXMON",345,0)
; If the error is simply that we can't write to the TCP device
"RTN","BMXMON",346,0)
; clear and log out
"RTN","BMXMON",347,0)
; GT.M Error Code.
"RTN","BMXMON",348,0)
I $ECODE=",Z150376602," S $ECODE="" D:$G(DUZ) LOGOUT^XUSRB HALT
"RTN","BMXMON",349,0)
; Cache Error Codes:
"RTN","BMXMON",350,0)
I ($EC["READ")!($EC["WRITE")!($EC["SYSTEM-F") S $ECODE="" D:$G(DUZ) LOGOUT^XUSRB HALT
"RTN","BMXMON",351,0)
;
"RTN","BMXMON",352,0)
; Otherwise, log the error and send it to the client
"RTN","BMXMON",353,0)
S BMXERC=$$EC^%ZOSV
"RTN","BMXMON",354,0)
S BMXERR="M ERROR="_BMXERC_$C(13,10)_"LAST REF="
"RTN","BMXMON",355,0)
S BMXLGR=$$LGR^%ZOSV_$C(4)
"RTN","BMXMON",356,0)
S BMXERR=BMXERR_BMXLGR
"RTN","BMXMON",357,0)
;
"RTN","BMXMON",358,0)
D ^%ZTER ;%ZTER clears $ZE and $ECODE
"RTN","BMXMON",359,0)
;
"RTN","BMXMON",360,0)
U $P
"RTN","BMXMON",361,0)
;
"RTN","BMXMON",362,0)
D SNDERR,WRITE(BMXERR) W !
"RTN","BMXMON",363,0)
;
"RTN","BMXMON",364,0)
S $ETRAP="Q:($ESTACK&'$QUIT) Q:$ESTACK -9 S $ECODE="""" G SESSRES^BMXMON",$ECODE=",U99,"
"RTN","BMXMON",365,0)
QUIT
"RTN","BMXMON",366,0)
;
"RTN","BMXMON",367,0)
MENU ;EP - ENTRY ACTION FROM BMXMENU OPTION
"RTN","BMXMON",368,0)
;
"RTN","BMXMON",369,0)
N BMX,BMXVER
"RTN","BMXMON",370,0)
;VERSION
"RTN","BMXMON",371,0)
D
"RTN","BMXMON",372,0)
. S BMXN="BMXNET ADO.NET DATA PROVIDER" I $D(^DIC(9.4,"B",BMXN)) Q
"RTN","BMXMON",373,0)
. S BMXN="BMXNET RPMS .NET UTILITIES" I $D(^DIC(9.4,"B",BMXN)) Q
"RTN","BMXMON",374,0)
. S BMXN=""
"RTN","BMXMON",375,0)
. Q
"RTN","BMXMON",376,0)
;
"RTN","BMXMON",377,0)
S BMXVER=""
"RTN","BMXMON",378,0)
I BMXN]"",$D(^DIC(9.4,"B",BMXN)) D
"RTN","BMXMON",379,0)
. S BMX=$O(^DIC(9.4,"B",BMXN,0))
"RTN","BMXMON",380,0)
. I $D(^DIC(9.4,BMX,"VERSION")) S BMXVER=$P(^DIC(9.4,BMX,"VERSION"),"^")
"RTN","BMXMON",381,0)
. E S BMXVER="VERSION NOT FOUND"
"RTN","BMXMON",382,0)
S:BMXVER="" BMXVER="VERSION NOT FOUND"
"RTN","BMXMON",383,0)
;
"RTN","BMXMON",384,0)
;LOCATION
"RTN","BMXMON",385,0)
N BMXLOC
"RTN","BMXMON",386,0)
S BMXLOC=""
"RTN","BMXMON",387,0)
I $G(DUZ(2)),$D(^DIC(4,DUZ(2),0)) S BMXLOC=$P(^DIC(4,DUZ(2),0),"^")
"RTN","BMXMON",388,0)
S:BMXLOC="" BMXLOC="LOCATION NOT FOUND"
"RTN","BMXMON",389,0)
;
"RTN","BMXMON",390,0)
;WRITE
"RTN","BMXMON",391,0)
W !
"RTN","BMXMON",392,0)
W !,"BMXNet Version: ",BMXVER
"RTN","BMXMON",393,0)
W !,"Location: ",BMXLOC
"RTN","BMXMON",394,0)
Q
"RTN","BMXMSEC")
0^85^B8709977
"RTN","BMXMSEC",1,0)
BMXMSEC ; IHS/OIT/HMW - BMXNet MONITOR ; 7/20/2009
"RTN","BMXMSEC",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXMSEC",3,0)
; Edit History
"RTN","BMXMSEC",4,0)
; Line SETUP+2 has been changed to support GT.M //SMH 7/5/09
"RTN","BMXMSEC",5,0)
; Per Wally Fort's GT.M code in XWBTCPM, IP for GT.M is stored
"RTN","BMXMSEC",6,0)
; in IP("GTM-IP"). Changes in BMXMON and here follow that model.
"RTN","BMXMSEC",7,0)
;
"RTN","BMXMSEC",8,0)
CHKPRMIT(BMXRP) ;EP - checks to see if remote procedure is permited to run
"RTN","BMXMSEC",9,0)
;Input: BMXRP - Remote procedure to check
"RTN","BMXMSEC",10,0)
Q:$$KCHK("XUPROGMODE")
"RTN","BMXMSEC",11,0)
N ERR,BMXALLOW
"RTN","BMXMSEC",12,0)
S U="^",BMXSEC="" ;clear
"RTN","BMXMSEC",13,0)
;
"RTN","BMXMSEC",14,0)
;In the beginning, when no DUZ is defined and no context exist, setup
"RTN","BMXMSEC",15,0)
;default signon context
"RTN","BMXMSEC",16,0)
S:'$G(DUZ) DUZ=0,XQY0="XUS SIGNON" ;set up default context
"RTN","BMXMSEC",17,0)
;
"RTN","BMXMSEC",18,0)
I BMXRP'="XWB IM HERE",BMXRP'="XWB CREATE CONTEXT",BMXRP'="XWB RPC LIST",BMXRP'="BMX AV CODE" D ;check exemptions. new exemption for XWB*1.1*6 - dpc
"RTN","BMXMSEC",19,0)
. I $G(XQY0)'="" D
"RTN","BMXMSEC",20,0)
. . S BMXALLOW=$$CHK^XQCS(DUZ,$P(XQY0,U),BMXRP) ;do the check
"RTN","BMXMSEC",21,0)
. . S:'BMXALLOW BMXSEC=BMXALLOW
"RTN","BMXMSEC",22,0)
. E S BMXSEC="Application context has not been created!"
"RTN","BMXMSEC",23,0)
Q
"RTN","BMXMSEC",24,0)
;
"RTN","BMXMSEC",25,0)
OWNSKEY(RET,LIST) ;EP Does user have Key
"RTN","BMXMSEC",26,0)
N I,K S I=""
"RTN","BMXMSEC",27,0)
I $G(DUZ)'>0 S RET(0)=0 Q
"RTN","BMXMSEC",28,0)
I $O(LIST(""))="" S RET(0)=$$KCHK(LIST) Q
"RTN","BMXMSEC",29,0)
F S I=$O(LIST(I)) Q:I="" S RET(I)=$$KCHK(LIST(I))
"RTN","BMXMSEC",30,0)
Q
"RTN","BMXMSEC",31,0)
KCHK(%) Q $S($G(DUZ)>0:$D(^XUSEC(%,DUZ)),1:0) ;EP Key Check
"RTN","BMXMSEC",32,0)
;
"RTN","BMXMSEC",33,0)
;
"RTN","BMXMSEC",34,0)
SETUP(RET) ;EP - sets up environment for GUI signon
"RTN","BMXMSEC",35,0)
;
"RTN","BMXMSEC",36,0)
K ^TMP("XQCS",$J)
"RTN","BMXMSEC",37,0)
; S IO("IP")=$P D ZIO^%ZIS4 ;IHS/OIT/HMW SAC Exemption Applied For
"RTN","BMXMSEC",38,0)
; --> Begin new code
"RTN","BMXMSEC",39,0)
I $$OS^XWBTCPM="GT.M" S IO("IP")=IO("GTM-IP")
"RTN","BMXMSEC",40,0)
I $$OS^XWBTCPM="OpenM" S IO("IP")=$P
"RTN","BMXMSEC",41,0)
D ZIO^%ZIS4
"RTN","BMXMSEC",42,0)
; <-- End new code //SMH
"RTN","BMXMSEC",43,0)
D SET1(0),SET^BMXMSEC("XUS XOPT",XOPT),SET^BMXMSEC("XUS CNT",0)
"RTN","BMXMSEC",44,0)
S %ZIS="0H",IOP="NULL" D ^%ZIS
"RTN","BMXMSEC",45,0)
;0=server name, 1=volume, 2=uci, 3=device, 4=# attempts, 5=skip signon-screen
"RTN","BMXMSEC",46,0)
S RET(0)=$P(XUENV,U,3),RET(1)=$P(XUVOL,U),RET(2)=XUCI
"RTN","BMXMSEC",47,0)
S RET(3)=$I,RET(4)=$P(XOPT,U,2),RET(5)=0 ;IHS/OIT/HMW SAC Exemption Applied For
"RTN","BMXMSEC",48,0)
I $$INHIBIT() Q
"RTN","BMXMSEC",49,0)
Q
"RTN","BMXMSEC",50,0)
;
"RTN","BMXMSEC",51,0)
SET1(FLAG) ;Setup parameters
"RTN","BMXMSEC",52,0)
D GETENV^%ZOSV S U="^",XUENV=Y,XUCI=$P(Y,U,1),XQVOL=$P(Y,U,2),XUEON=^%ZOSF("EON"),XUEOFF=^("EOFF")
"RTN","BMXMSEC",53,0)
S X=$O(^XTV(8989.3,1,4,"B",XQVOL,0)),XUVOL=$S(X>0:^XTV(8989.3,1,4,X,0),1:XQVOL_"^y^1") S:$P(XUVOL,U,6)="y" XRTL=XUCI_","_XQVOL
"RTN","BMXMSEC",54,0)
S XOPT=$S($D(^XTV(8989.3,1,"XUS")):^("XUS"),1:"") F I=2:1:15 I $P(XOPT,U,I)="" S $P(XOPT,U,I)=$P("^5^900^1^1^^^^1^300^^^^N^90",U,I)
"RTN","BMXMSEC",55,0)
Q
"RTN","BMXMSEC",56,0)
;
"RTN","BMXMSEC",57,0)
INHIBIT() ;Is Logon to this system Inhibited?
"RTN","BMXMSEC",58,0)
I $G(^%ZIS(14.5,"LOGON",XQVOL)) Q 1
"RTN","BMXMSEC",59,0)
I $D(^%ZOSF("ACTJ")) X ^("ACTJ") I $P(XUVOL,U,3),($P(XUVOL,U,3)'>Y) Q 2
"RTN","BMXMSEC",60,0)
Q 0
"RTN","BMXMSEC",61,0)
;
"RTN","BMXMSEC",62,0)
NOW S U="^",XUNOW=$$NOW^XLFDT(),DT=$P(XUNOW,"."),XUDEV=0
"RTN","BMXMSEC",63,0)
Q
"RTN","BMXMSEC",64,0)
;
"RTN","BMXMSEC",65,0)
STATE(%) ;Return a state value
"RTN","BMXMSEC",66,0)
;XWBSTATE is required by XUSRB
"RTN","BMXMSEC",67,0)
Q:'$L($G(%)) $G(XWBSTATE)
"RTN","BMXMSEC",68,0)
Q $G(XWBSTATE(%))
"RTN","BMXMSEC",69,0)
;
"RTN","BMXMSEC",70,0)
;
"RTN","BMXMSEC",71,0)
SET(%,VALUE) ;Set the state variable
"RTN","BMXMSEC",72,0)
I $G(%)="" S XWBSTATE=VALUE
"RTN","BMXMSEC",73,0)
S XWBSTATE(%)=VALUE
"RTN","BMXMSEC",74,0)
Q
"RTN","BMXMSEC",75,0)
KILL(%) ;Kill state variable
"RTN","BMXMSEC",76,0)
I $L($G(%)) K XWBSTATE(%)
"RTN","BMXMSEC",77,0)
Q
"RTN","BMXNTEG")
0^115^B7300059
"RTN","BMXNTEG",1,0)
BMXNTEG ;INTEGRITY CHECKER;FEB 26, 2007
"RTN","BMXNTEG",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXNTEG",3,0)
;
"RTN","BMXNTEG",4,0)
START ;
"RTN","BMXNTEG",5,0)
NEW BYTE,COUNT,RTN
"RTN","BMXNTEG",6,0)
K ^UTILITY($J)
"RTN","BMXNTEG",7,0)
F I=1:1 S X=$T(LIST+I) Q:X="" S X=$P(X,";;",2),R=$P(X,"^",1),B=$P(X,"^",2),C=$P(X,"^",3),^UTILITY($J,R)=B_"^"_C
"RTN","BMXNTEG",8,0)
F I=1:1:6 S X=$P($T(@("LINE"_I)),";;",2,99),@("XBSUMBLD("_I_")=X")
"RTN","BMXNTEG",9,0)
X XBSUMBLD(1)
"RTN","BMXNTEG",10,0)
Q
"RTN","BMXNTEG",11,0)
;
"RTN","BMXNTEG",12,0)
LINE1 ;;X XBSUMBLD(2),XBSUMBLD(6)
"RTN","BMXNTEG",13,0)
LINE2 ;;S RTN=0 F S RTN=$O(^UTILITY($J,RTN)) Q:RTN="" W !,RTN ZL @RTN S (BYTE,COUNT)=0 S X=$T(+1),X=$P(X," [ ",1) X XBSUMBLD(4),XBSUMBLD(3),XBSUMBLD(5)
"RTN","BMXNTEG",14,0)
LINE3 ;;F I=2:1 S X=$T(+I) Q:X="" X XBSUMBLD(4)
"RTN","BMXNTEG",15,0)
LINE4 ;;F J=1:1 S Y=$E(X,J) Q:Y="" S BYTE=BYTE+1,COUNT=COUNT+$A(Y)
"RTN","BMXNTEG",16,0)
LINE5 ;;S B=$P(^UTILITY($J,RTN),"^",1),C=$P(^(RTN),"^",2) I B'=BYTE!(C'=COUNT) W " has been modified"
"RTN","BMXNTEG",17,0)
LINE6 ;;K XBSUMBLD,B,C,I,J,R,X,Y
"RTN","BMXNTEG",18,0)
;
"RTN","BMXNTEG",19,0)
LIST ;
"RTN","BMXNTEG",20,0)
;;BMXADE1^3028^202865
"RTN","BMXNTEG",21,0)
;;BMXADE2^3250^215372
"RTN","BMXNTEG",22,0)
;;BMXADO^6547^418026
"RTN","BMXNTEG",23,0)
;;BMXADO2^3489^255546
"RTN","BMXNTEG",24,0)
;;BMXADOF^11562^731974
"RTN","BMXNTEG",25,0)
;;BMXADOF1^3281^207224
"RTN","BMXNTEG",26,0)
;;BMXADOF2^2138^139496
"RTN","BMXNTEG",27,0)
;;BMXADOFD^2831^178610
"RTN","BMXNTEG",28,0)
;;BMXADOFS^6515^393782
"RTN","BMXNTEG",29,0)
;;BMXADOI^2215^134605
"RTN","BMXNTEG",30,0)
;;BMXADOS^9145^575000
"RTN","BMXNTEG",31,0)
;;BMXADOS1^2590^161592
"RTN","BMXNTEG",32,0)
;;BMXADOV^5739^373823
"RTN","BMXNTEG",33,0)
;;BMXADOV1^9072^554887
"RTN","BMXNTEG",34,0)
;;BMXADOV2^4690^289898
"RTN","BMXNTEG",35,0)
;;BMXADOVJ^3530^225534
"RTN","BMXNTEG",36,0)
;;BMXADOX^13904^870277
"RTN","BMXNTEG",37,0)
;;BMXADOX1^11753^751110
"RTN","BMXNTEG",38,0)
;;BMXADOX2^3126^199406
"RTN","BMXNTEG",39,0)
;;BMXADOXX^12226^762799
"RTN","BMXNTEG",40,0)
;;BMXADOXY^11992^769511
"RTN","BMXNTEG",41,0)
;;BMXE01^2111^148783
"RTN","BMXNTEG",42,0)
;;BMXFIND^7919^562996
"RTN","BMXNTEG",43,0)
;;BMXG^1970^120467
"RTN","BMXNTEG",44,0)
;;BMXGETS^4309^308726
"RTN","BMXNTEG",45,0)
;;BMXMBRK^5919^389568
"RTN","BMXNTEG",46,0)
;;BMXMBRK2^3621^233089
"RTN","BMXNTEG",47,0)
;;BMXMEVN^6627^468908
"RTN","BMXNTEG",48,0)
;;BMXMON^9356^664477
"RTN","BMXNTEG",49,0)
;;BMXMSEC^2302^160584
"RTN","BMXNTEG",50,0)
;;BMXNTEG^2045^127438
"RTN","BMXNTEG",51,0)
;;BMXPO^1522^101987
"RTN","BMXNTEG",52,0)
;;BMXPRS^2153^134429
"RTN","BMXNTEG",53,0)
;;BMXRPC^5716^425699
"RTN","BMXNTEG",54,0)
;;BMXRPC1^7622^559198
"RTN","BMXNTEG",55,0)
;;BMXRPC2^3531^243875
"RTN","BMXNTEG",56,0)
;;BMXRPC3^6466^450166
"RTN","BMXNTEG",57,0)
;;BMXRPC4^4967^312485
"RTN","BMXNTEG",58,0)
;;BMXRPC5^3896^288926
"RTN","BMXNTEG",59,0)
;;BMXRPC6^3757^270667
"RTN","BMXNTEG",60,0)
;;BMXRPC7^5687^404431
"RTN","BMXNTEG",61,0)
;;BMXRPC8^2236^165523
"RTN","BMXNTEG",62,0)
;;BMXRPC9^6408^421855
"RTN","BMXNTEG",63,0)
;;BMXSQL^10869^727499
"RTN","BMXNTEG",64,0)
;;BMXSQL1^9921^616204
"RTN","BMXNTEG",65,0)
;;BMXSQL2^2748^183754
"RTN","BMXNTEG",66,0)
;;BMXSQL3^13516^868578
"RTN","BMXNTEG",67,0)
;;BMXSQL4^1313^88477
"RTN","BMXNTEG",68,0)
;;BMXSQL5^6648^433290
"RTN","BMXNTEG",69,0)
;;BMXSQL6^10606^683062
"RTN","BMXNTEG",70,0)
;;BMXSQL7^8102^528283
"RTN","BMXNTEG",71,0)
;;BMXSQL91^4328^281351
"RTN","BMXNTEG",72,0)
;;BMXTABLE^159^9961
"RTN","BMXNTEG",73,0)
;;BMXTRS^1300^81264
"RTN","BMXNTEG",74,0)
;;BMXUTL1^7818^520369
"RTN","BMXNTEG",75,0)
;;BMXUTL2^900^60457
"RTN","BMXNTEG",76,0)
;;BMXUTL5^5330^358866
"RTN","BMXNTEG",77,0)
;;BMXUTL6^942^62126
"RTN","BMXNTEG",78,0)
;;BMXUTL7^163^10646
"RTN","BMXPO")
0^116^B4666839
"RTN","BMXPO",1,0)
BMXPO ; IHS/CMI/MAW - Populate appcontext with all namespaced RPC's ;
"RTN","BMXPO",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXPO",3,0)
;
"RTN","BMXPO",4,0)
;
"RTN","BMXPO",5,0)
MAIN ;EP - this is the main routine driver
"RTN","BMXPO",6,0)
N BMXQFLG
"RTN","BMXPO",7,0)
D ASK
"RTN","BMXPO",8,0)
I $G(BMXQFLG) D XIT Q
"RTN","BMXPO",9,0)
;D CLEAN(BMXAPP)
"RTN","BMXPO",10,0)
D POP(BMXAPP,BMXNS)
"RTN","BMXPO",11,0)
D XIT
"RTN","BMXPO",12,0)
Q
"RTN","BMXPO",13,0)
;
"RTN","BMXPO",14,0)
GUIEP(RETVAL,BMXSTR) ;EP - gui entry point
"RTN","BMXPO",15,0)
N P,BMXAPP,BMXNS
"RTN","BMXPO",16,0)
S P="|"
"RTN","BMXPO",17,0)
S BMXGUI=1
"RTN","BMXPO",18,0)
S BMXAPP=$P(BMXSTR,P)
"RTN","BMXPO",19,0)
S BMXNS=$P(BMXSTR,P,2)
"RTN","BMXPO",20,0)
K ^BMXTMP($J)
"RTN","BMXPO",21,0)
S RETVAL="^BMXTMP("_$J_")"
"RTN","BMXPO",22,0)
S ^BMXTMP($J,0)="T00250DATA"_$C(30)
"RTN","BMXPO",23,0)
;D CLEAN(BMXAPP)
"RTN","BMXPO",24,0)
D POP(BMXAPP,BMXNS)
"RTN","BMXPO",25,0)
D XIT
"RTN","BMXPO",26,0)
Q
"RTN","BMXPO",27,0)
;
"RTN","BMXPO",28,0)
ASK ;-- ask the name of the OPTION to populate
"RTN","BMXPO",29,0)
W !
"RTN","BMXPO",30,0)
S DIC=19,DIC(0)="AEMQZ",DIC("A")="Populate which Application Context: "
"RTN","BMXPO",31,0)
D ^DIC
"RTN","BMXPO",32,0)
I '$G(Y) S BMXQFLG=1 Q
"RTN","BMXPO",33,0)
S BMXAPP=+Y
"RTN","BMXPO",34,0)
W !
"RTN","BMXPO",35,0)
K DIC
"RTN","BMXPO",36,0)
S DIR(0)="F^1:3",DIR("A")="Populate RPC's from which Namespace: "
"RTN","BMXPO",37,0)
D ^DIR
"RTN","BMXPO",38,0)
I $D(DIRUT) S BMXQFLG=1 Q
"RTN","BMXPO",39,0)
S BMXNS=$G(Y)
"RTN","BMXPO",40,0)
Q
"RTN","BMXPO",41,0)
;
"RTN","BMXPO",42,0)
CLEAN(APP) ;-- clean out the RPC multiple first
"RTN","BMXPO",43,0)
S DA(1)=APP
"RTN","BMXPO",44,0)
S DIK="^DIC(19,"_DA(1)_","_"""RPC"""_","
"RTN","BMXPO",45,0)
N BMXDA
"RTN","BMXPO",46,0)
S BMXDA=0 F S BDMDA=$O(^DIC(19,APP,"RPC",BMXDA)) Q:'BMXDA D
"RTN","BMXPO",47,0)
. S DA=BMXDA
"RTN","BMXPO",48,0)
. D ^DIK
"RTN","BMXPO",49,0)
K ^DIC(19,APP,"RPC","B")
"RTN","BMXPO",50,0)
Q
"RTN","BMXPO",51,0)
;
"RTN","BMXPO",52,0)
POP(APP,NS) ;populate the app context with RPC's
"RTN","BMXPO",53,0)
I '$G(BMXGUI) W !,"Populating Application Context"
"RTN","BMXPO",54,0)
N BMXDA
"RTN","BMXPO",55,0)
S BMXDA=NS
"RTN","BMXPO",56,0)
F S BMXDA=$O(^XWB(8994,"B",BMXDA)) Q:BMXDA=""!($E(BMXDA,1,3)'=NS) D
"RTN","BMXPO",57,0)
. N BMXIEN
"RTN","BMXPO",58,0)
. S BMXIEN=0 F S BMXIEN=$O(^XWB(8994,"B",BMXDA,BMXIEN)) Q:'BMXIEN D
"RTN","BMXPO",59,0)
.. Q:$O(^DIC(19,APP,"RPC","B",BMXIEN,0))
"RTN","BMXPO",60,0)
.. N BDMIENS,BDMFDA,BDMERR
"RTN","BMXPO",61,0)
.. S BDMIENS(1)=APP
"RTN","BMXPO",62,0)
.. S BDMIENS="+2,"_APP_","
"RTN","BMXPO",63,0)
.. S BDMFDA(19.05,BDMIENS,.01)=BMXIEN
"RTN","BMXPO",64,0)
.. D UPDATE^DIE("","BDMFDA","BDMIENS","BDMERR(1)")
"RTN","BMXPO",65,0)
.. I '$G(BMXGUI) W "."
"RTN","BMXPO",66,0)
Q
"RTN","BMXPO",67,0)
;
"RTN","BMXPO",68,0)
XIT ;-- clean vars
"RTN","BMXPO",69,0)
D EN^XBVK("BMX")
"RTN","BMXPO",70,0)
Q
"RTN","BMXPO",71,0)
;
"RTN","BMXPRS")
0^86^B8898368
"RTN","BMXPRS",1,0)
BMXPRS ; IHS/OIT/HMW - BMX WINDOWS UTILS ;
"RTN","BMXPRS",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXPRS",3,0)
;
"RTN","BMXPRS",4,0)
;
"RTN","BMXPRS",5,0)
PARSE(X) ;EP-Parse SQL Statement into array
"RTN","BMXPRS",6,0)
;Input SQL statement as X
"RTN","BMXPRS",7,0)
;Returns BMXTK() array
"RTN","BMXPRS",8,0)
;Errors returned in BMXERR
"RTN","BMXPRS",9,0)
;
"RTN","BMXPRS",10,0)
D PRE
"RTN","BMXPRS",11,0)
Q:$D(BMXERR)
"RTN","BMXPRS",12,0)
D POST
"RTN","BMXPRS",13,0)
Q
"RTN","BMXPRS",14,0)
;
"RTN","BMXPRS",15,0)
POST2 ;EP - Remove commas from BMXTK
"RTN","BMXPRS",16,0)
N J,K
"RTN","BMXPRS",17,0)
S J=0 F S J=$O(BMXTK(J)) Q:'+J D
"RTN","BMXPRS",18,0)
. S K=$O(BMXTK(J))
"RTN","BMXPRS",19,0)
. I +K,","=$G(BMXTK(K)) D
"RTN","BMXPRS",20,0)
. . K BMXTK(K)
"RTN","BMXPRS",21,0)
. . D PACK(J)
"RTN","BMXPRS",22,0)
. . Q
"RTN","BMXPRS",23,0)
. Q
"RTN","BMXPRS",24,0)
Q
"RTN","BMXPRS",25,0)
;
"RTN","BMXPRS",26,0)
POST ;
"RTN","BMXPRS",27,0)
;Combine multi-character operators
"RTN","BMXPRS",28,0)
N J
"RTN","BMXPRS",29,0)
S J=0 F S J=$O(BMXTK(J)) Q:'+J D
"RTN","BMXPRS",30,0)
. I ">"=BMXTK(J) D Q
"RTN","BMXPRS",31,0)
. . I "="[$G(BMXTK(J+1)) D Q
"RTN","BMXPRS",32,0)
. . . S BMXTK(J)=BMXTK(J)_"="
"RTN","BMXPRS",33,0)
. . . K BMXTK(J+1)
"RTN","BMXPRS",34,0)
. . . D PACK(J)
"RTN","BMXPRS",35,0)
. . I "<"[$G(BMXTK(J+1)) D Q
"RTN","BMXPRS",36,0)
. . . S BMXTK(J)="<"_BMXTK(J)
"RTN","BMXPRS",37,0)
. . . K BMXTK(J+1)
"RTN","BMXPRS",38,0)
. . . D PACK(J)
"RTN","BMXPRS",39,0)
. I "<"=BMXTK(J) D Q
"RTN","BMXPRS",40,0)
. . I "=>"[$G(BMXTK(J+1)) D
"RTN","BMXPRS",41,0)
. . . S BMXTK(J)=BMXTK(J)_BMXTK(J+1)
"RTN","BMXPRS",42,0)
. . . K BMXTK(J+1)
"RTN","BMXPRS",43,0)
. . . D PACK(J)
"RTN","BMXPRS",44,0)
. I "="=BMXTK(J) D Q
"RTN","BMXPRS",45,0)
. . I "<>"[$G(BMXTK(J+1)) D
"RTN","BMXPRS",46,0)
. . . S BMXTK(J)=BMXTK(J+1)_BMXTK(J)
"RTN","BMXPRS",47,0)
. . . K BMXTK(J+1)
"RTN","BMXPRS",48,0)
. . . D PACK(J)
"RTN","BMXPRS",49,0)
Q
"RTN","BMXPRS",50,0)
;
"RTN","BMXPRS",51,0)
PACK(J) ;
"RTN","BMXPRS",52,0)
F S J=$O(BMXTK(J)) Q:'+J D
"RTN","BMXPRS",53,0)
. S BMXTK(J-1)=BMXTK(J)
"RTN","BMXPRS",54,0)
. K BMXTK(J)
"RTN","BMXPRS",55,0)
Q
"RTN","BMXPRS",56,0)
;
"RTN","BMXPRS",57,0)
PRE N P,T,Q,Q1,A,B S (P,T,Q)=0,BMXTK="",A=0
"RTN","BMXPRS",58,0)
START S A=A+1
"RTN","BMXPRS",59,0)
S B=$E(X,A)
"RTN","BMXPRS",60,0)
I B="" G B5
"RTN","BMXPRS",61,0)
I 'Q G QUOTE
"RTN","BMXPRS",62,0)
I B=$C(39) G QUOTE
"RTN","BMXPRS",63,0)
S BMXTK=BMXTK_B G START
"RTN","BMXPRS",64,0)
QUOTE I B'=$C(39) G SPACE
"RTN","BMXPRS",65,0)
I Q G QUOTE2
"RTN","BMXPRS",66,0)
;S Q=1,BMXTK=B G START
"RTN","BMXPRS",67,0)
S Q=1,BMXTK=BMXTK_B G START
"RTN","BMXPRS",68,0)
QUOTE2 S Q1=B,A=A+1,B=$E(X,A)
"RTN","BMXPRS",69,0)
I B']"" G QUOTE3
"RTN","BMXPRS",70,0)
I B'=$C(39) G QUOTE3
"RTN","BMXPRS",71,0)
S BMXTK=BMXTK_Q1_B G START
"RTN","BMXPRS",72,0)
QUOTE3 S A=A-1,B=Q1,BMXTK=BMXTK_B,Q=0 G START
"RTN","BMXPRS",73,0)
SPACE I B'=" " G OP
"RTN","BMXPRS",74,0)
I BMXTK]"" S T=T+1,BMXTK(T)=BMXTK,BMXTK=""
"RTN","BMXPRS",75,0)
G START
"RTN","BMXPRS",76,0)
OP I "=><"'[B G OPAREN
"RTN","BMXPRS",77,0)
I BMXTK]"" S T=T+1,BMXTK(T)=BMXTK,BMXTK=""
"RTN","BMXPRS",78,0)
S T=T+1,BMXTK(T)=B,BMXTK=""
"RTN","BMXPRS",79,0)
G START
"RTN","BMXPRS",80,0)
OPAREN I B'="(" G CPAREN
"RTN","BMXPRS",81,0)
S P=P+1
"RTN","BMXPRS",82,0)
I BMXTK]"" S T=T+1,BMXTK(T)=BMXTK,BMXTK=""
"RTN","BMXPRS",83,0)
S T=T+1,BMXTK(T)=B G START
"RTN","BMXPRS",84,0)
CPAREN I B'=")" G B2
"RTN","BMXPRS",85,0)
I P G B1
"RTN","BMXPRS",86,0)
G B0
"RTN","BMXPRS",87,0)
;
"RTN","BMXPRS",88,0)
B0 S BMXERR="SQL SYNTAX ERROR" D ERROR G B5
"RTN","BMXPRS",89,0)
B1 S P=P-1
"RTN","BMXPRS",90,0)
I BMXTK]"" S T=T+1,BMXTK(T)=BMXTK,BMXTK=""
"RTN","BMXPRS",91,0)
S T=T+1,BMXTK(T)=B G START
"RTN","BMXPRS",92,0)
B2 I B'="," G B3
"RTN","BMXPRS",93,0)
S T=T+1,BMXTK(T)=BMXTK,T=T+1,BMXTK(T)=",",BMXTK="" G START
"RTN","BMXPRS",94,0)
B3 S BMXTK=BMXTK_B
"RTN","BMXPRS",95,0)
B4 G START
"RTN","BMXPRS",96,0)
B5 I BMXTK]"" S T=T+1,BMXTK(T)=BMXTK
"RTN","BMXPRS",97,0)
I $D(BMXERR) G B6
"RTN","BMXPRS",98,0)
I P S BMXERR="SQL SYNTAX ERROR: MATCHING PARENTHESIS NOT FOUND" D ERROR
"RTN","BMXPRS",99,0)
E I Q S BMXERR="SQL SYNTAX ERROR: MATCHING QUOTE NOT FOUND" D ERROR
"RTN","BMXPRS",100,0)
I P>0 G START
"RTN","BMXPRS",101,0)
B6 Q
"RTN","BMXPRS",102,0)
;
"RTN","BMXPRS",103,0)
ERROR ;W !,"ERROR=",BMXERR,! Q
"RTN","BMXPRS",104,0)
Q
"RTN","BMXRPC")
0^87^B21470311
"RTN","BMXRPC",1,0)
BMXRPC ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; 9/7/10 5:04am
"RTN","BMXRPC",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXRPC",3,0)
;;Stolen from:* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
"RTN","BMXRPC",4,0)
;; GENERIC LOOKUP UTILITY FOR RETURNING MATCHING RECORDS
"RTN","BMXRPC",5,0)
;; OR TABLES TO RPC'S.
"RTN","BMXRPC",6,0)
;
"RTN","BMXRPC",7,0)
; *** NOTE: I have discovered a number of cases where these calls
"RTN","BMXRPC",8,0)
; produce errors (with error messages to IO) or simply
"RTN","BMXRPC",9,0)
; do not work correctly. ANY CALL to this utility
"RTN","BMXRPC",10,0)
; should be thoroughly tested in the M environment
"RTN","BMXRPC",11,0)
; before being used as an RPC.
"RTN","BMXRPC",12,0)
;
"RTN","BMXRPC",13,0)
;----------
"RTN","BMXRPC",14,0)
; Change Log:
"RTN","BMXRPC",15,0)
; UJO/SMH on 7 Sep 2010 -- added RPC for determining UTF-8 support
"RTN","BMXRPC",16,0)
; Tag: UTF-8
"RTN","BMXRPC",17,0)
LOOKUP(BMXGBL,BMXFL,BMXFLDS,BMXFLG,BMXIN,BMXMX,BMXIX,BMXSCR,BMXMC) ;EP
"RTN","BMXRPC",18,0)
;---> Places matching records from requested file into a
"RTN","BMXRPC",19,0)
;---> result global, ^BMXTEMP($J). The exact global name
"RTN","BMXRPC",20,0)
;---> is returned in the first parameter (BMXGBL).
"RTN","BMXRPC",21,0)
;---> Records are returned one per node in the result global.
"RTN","BMXRPC",22,0)
;---> Each record is terminated with a $C(30), for parsing out
"RTN","BMXRPC",23,0)
;---> on the VB side, since the Broker concatenates all nodes
"RTN","BMXRPC",24,0)
;---> into a single string when passing the data out of M.
"RTN","BMXRPC",25,0)
;---> Requested fields within records are delimited by "^".
"RTN","BMXRPC",26,0)
;---> NOTE: The first "^"-piece of every node is the IEN of
"RTN","BMXRPC",27,0)
;---> that entry in its file; the requested fields follow.
"RTN","BMXRPC",28,0)
;---> The final record (node) contains Error Delimiter,
"RTN","BMXRPC",29,0)
; $C(31)_$C(31), followed by error text, if any.
"RTN","BMXRPC",30,0)
;
"RTN","BMXRPC",31,0)
;---> Parameters:
"RTN","BMXRPC",32,0)
; 1 - BMXGBL (ret) Name of result global for Broker.
"RTN","BMXRPC",33,0)
; 2 - BMXFL (req) File for lookup.
"RTN","BMXRPC",34,0)
; 3 - BMXFLDS (opt) Fields to return w/each entry.
"RTN","BMXRPC",35,0)
; 4 - BMXFLG (opt) Flags in DIC(0); If null, "M" is sent.
"RTN","BMXRPC",36,0)
; 5 - BMXIN (opt) Input to match on (see Algorithm below).
"RTN","BMXRPC",37,0)
; 6 - BMXMX (opt) Maximum number of entries to return.
"RTN","BMXRPC",38,0)
; 7 - BMXIX (opt) Indexes to search.
"RTN","BMXRPC",39,0)
; 8 - BMXSCR (opt) Screen/filter (M code).
"RTN","BMXRPC",40,0)
; 9 - BMXMC (opt) Mixed Case: 1=mixed case, 0=no change.
"RTN","BMXRPC",41,0)
; (Converts data in uppercase to mixed case.)
"RTN","BMXRPC",42,0)
;
"RTN","BMXRPC",43,0)
;---> Set variables, kill temp globals.
"RTN","BMXRPC",44,0)
N (BMXGBL,BMXFL,BMXFLDS,BMXFLG,BMXIN,BMXMX,BMXIX,BMXSCR,BMXMC)
"RTN","BMXRPC",45,0)
S BMX31=$C(31)_$C(31)
"RTN","BMXRPC",46,0)
S BMXGBL="^BMXTEMP("_$J_")",BMXERR="",U="^"
"RTN","BMXRPC",47,0)
K ^BMXTMP($J),^BMXTEMP($J)
"RTN","BMXRPC",48,0)
;
"RTN","BMXRPC",49,0)
;---> If file number not provided, return error.
"RTN","BMXRPC",50,0)
I '$G(BMXFL) D ERROUT("File number not provided.",1) Q
"RTN","BMXRPC",51,0)
;
"RTN","BMXRPC",52,0)
;---> If no fields provided, pass .01.
"RTN","BMXRPC",53,0)
;---> IEN will always be the first piece of data returned.
"RTN","BMXRPC",54,0)
;---> NOTE: If .01 is NOT included, but the Index to lookup on is
"RTN","BMXRPC",55,0)
;---> NOT on the .01, then the .01 will be returned
"RTN","BMXRPC",56,0)
;---> automatically as the second ^-piece of data in the
"RTN","BMXRPC",57,0)
;---> Result Global.
"RTN","BMXRPC",58,0)
;---> So it would be: IEN^.01^requested fields...
"RTN","BMXRPC",59,0)
I $G(BMXFLDS)="" S BMXFLDS=".01"
"RTN","BMXRPC",60,0)
;
"RTN","BMXRPC",61,0)
;---> If no index or flag provided, set flag="M".
"RTN","BMXRPC",62,0)
I $G(BMXFLG)="" D
"RTN","BMXRPC",63,0)
.I $G(BMXIX)="" S BMXFLG="M" Q
"RTN","BMXRPC",64,0)
.S BMXFLG=""
"RTN","BMXRPC",65,0)
;
"RTN","BMXRPC",66,0)
;---> If no Maximum Number provided, set it to 200.
"RTN","BMXRPC",67,0)
I '$G(BMXMX) S BMXMX=200
"RTN","BMXRPC",68,0)
;
"RTN","BMXRPC",69,0)
;---> Define index and screen.
"RTN","BMXRPC",70,0)
S:'$D(BMXIX) BMXIX=""
"RTN","BMXRPC",71,0)
S:'$D(BMXSCR) BMXSCR=""
"RTN","BMXRPC",72,0)
;
"RTN","BMXRPC",73,0)
;---> Set Target Global for output and errors.
"RTN","BMXRPC",74,0)
S BMXG="^BMXTMP($J)"
"RTN","BMXRPC",75,0)
;
"RTN","BMXRPC",76,0)
;---> If Mixed Case not set, set to No Change.
"RTN","BMXRPC",77,0)
I '$D(BMXMC) S BMXMC=0
"RTN","BMXRPC",78,0)
;
"RTN","BMXRPC",79,0)
;---> Silent Fileman call.
"RTN","BMXRPC",80,0)
D
"RTN","BMXRPC",81,0)
.I $G(BMXIN)="" D Q
"RTN","BMXRPC",82,0)
..D LIST^DIC(BMXFL,,BMXFLDS,,BMXMX,0,,BMXIX,BMXSCR,,BMXG,BMXG)
"RTN","BMXRPC",83,0)
.D FIND^DIC(BMXFL,,BMXFLDS,BMXFLG,BMXIN,BMXMX,BMXIX,BMXSCR,,BMXG,BMXG)
"RTN","BMXRPC",84,0)
;
"RTN","BMXRPC",85,0)
D WRITE
"RTN","BMXRPC",86,0)
Q
"RTN","BMXRPC",87,0)
;
"RTN","BMXRPC",88,0)
;
"RTN","BMXRPC",89,0)
;----------
"RTN","BMXRPC",90,0)
WRITE ;EP
"RTN","BMXRPC",91,0)
;---> Collect data for matching records and write in result global.
"RTN","BMXRPC",92,0)
;
"RTN","BMXRPC",93,0)
;---> First, check for errors.
"RTN","BMXRPC",94,0)
;---> If errors exist, write them and quit.
"RTN","BMXRPC",95,0)
N I,N,X
"RTN","BMXRPC",96,0)
I $D(^BMXTMP($J,"DIERR")) I $O(^("DIERR",0)) D Q
"RTN","BMXRPC",97,0)
.S N=0,X=""
"RTN","BMXRPC",98,0)
.F S N=$O(^BMXTMP($J,"DIERR",N)) Q:'N D
"RTN","BMXRPC",99,0)
..N M S M=0
"RTN","BMXRPC",100,0)
..F S M=$O(^BMXTMP($J,"DIERR",N,"TEXT",M)) Q:'M D
"RTN","BMXRPC",101,0)
...S X=X_^BMXTMP($J,"DIERR",N,"TEXT",M)_" "
"RTN","BMXRPC",102,0)
.D ERROUT(X,1)
"RTN","BMXRPC",103,0)
;
"RTN","BMXRPC",104,0)
;
"RTN","BMXRPC",105,0)
;---> Write Field Names
"RTN","BMXRPC",106,0)
S $P(ASDX,"^",1)="IEN"
"RTN","BMXRPC",107,0)
F ASDC=1:1:$L(BMXFLDS,";") D
"RTN","BMXRPC",108,0)
. S ASDXFNUM=$P(BMXFLDS,";",ASDC)
"RTN","BMXRPC",109,0)
. S ASDXFNAM=$P(^DD(BMXFL,ASDXFNUM,0),"^")
"RTN","BMXRPC",110,0)
. S:ASDXFNAM="" ASDXFNAM="UNKNOWN"_ASDC
"RTN","BMXRPC",111,0)
. S $P(ASDX,"^",ASDC+1)=ASDXFNAM
"RTN","BMXRPC",112,0)
S ^BMXTEMP($J,1)=ASDX_$C(30)
"RTN","BMXRPC",113,0)
;---> Write valid results.
"RTN","BMXRPC",114,0)
;---> Loop through the IEN node (...2,N) of the temp global.
"RTN","BMXRPC",115,0)
N I,N,X S N=0
"RTN","BMXRPC",116,0)
F I=2:1 S N=$O(^BMXTMP($J,"DILIST",2,N)) Q:'N D
"RTN","BMXRPC",117,0)
.;---> Always set first piece of X=IEN of entry.
"RTN","BMXRPC",118,0)
.S X=^BMXTMP($J,"DILIST",2,N)
"RTN","BMXRPC",119,0)
.;
"RTN","BMXRPC",120,0)
.;---> Collect other fields and concatenate to X.
"RTN","BMXRPC",121,0)
.N M S M=0
"RTN","BMXRPC",122,0)
.F S M=$O(^BMXTMP($J,"DILIST","ID",N,M)) Q:'M D
"RTN","BMXRPC",123,0)
..S X=X_U_^BMXTMP($J,"DILIST","ID",N,M)
"RTN","BMXRPC",124,0)
.;
"RTN","BMXRPC",125,0)
.;---> Convert data to mixed case if BMXMC=1.
"RTN","BMXRPC",126,0)
.S:BMXMC X=$$T^BMXTRS(X)
"RTN","BMXRPC",127,0)
.;
"RTN","BMXRPC",128,0)
.;---> Set data in result global.
"RTN","BMXRPC",129,0)
.S ^BMXTEMP($J,I)=X_$C(30)
"RTN","BMXRPC",130,0)
;
"RTN","BMXRPC",131,0)
;---> If no results, report it as an error.
"RTN","BMXRPC",132,0)
D:'$O(^BMXTEMP($J,0))
"RTN","BMXRPC",133,0)
.I BMXIN]"" S BMXERR="No entry matches """_BMXIN_"""." Q
"RTN","BMXRPC",134,0)
.S BMXERR="Either the lookup file is empty"
"RTN","BMXRPC",135,0)
.S BMXERR=BMXERR_" or all entries are screened (software error)."
"RTN","BMXRPC",136,0)
;
"RTN","BMXRPC",137,0)
;---> Tack on Error Delimiter and any error.
"RTN","BMXRPC",138,0)
S ^BMXTEMP($J,I)=BMX31_BMXERR
"RTN","BMXRPC",139,0)
Q
"RTN","BMXRPC",140,0)
;
"RTN","BMXRPC",141,0)
;
"RTN","BMXRPC",142,0)
;----------
"RTN","BMXRPC",143,0)
ERROUT(BMXERR,I) ;EP
"RTN","BMXRPC",144,0)
;---> Save next line for Error Code File if ever used.
"RTN","BMXRPC",145,0)
;---> If necessary, use I>1 to avoid overwriting valid data.
"RTN","BMXRPC",146,0)
S:'$G(I) I=1
"RTN","BMXRPC",147,0)
S ^BMXTEMP($J,I)=BMX31_BMXERR
"RTN","BMXRPC",148,0)
Q
"RTN","BMXRPC",149,0)
;
"RTN","BMXRPC",150,0)
;
"RTN","BMXRPC",151,0)
PASSERR(BMXGBL,BMXERR) ;EP
"RTN","BMXRPC",152,0)
;---> If the RPC routine calling the BMX Generic Lookup above
"RTN","BMXRPC",153,0)
;---> detects a specific error prior to the call and wants to pass
"RTN","BMXRPC",154,0)
;---> that error in the result global rather than a generic error,
"RTN","BMXRPC",155,0)
;---> then a call to this function (PASSERR) can be made.
"RTN","BMXRPC",156,0)
;---> This call will store the error text passed in the result global.
"RTN","BMXRPC",157,0)
;---> The calling routine should then quit (abort its call to the
"RTN","BMXRPC",158,0)
;---> BMX Generic Lookup function above).
"RTN","BMXRPC",159,0)
;
"RTN","BMXRPC",160,0)
;---> Parameters:
"RTN","BMXRPC",161,0)
; 1 - BMXGBL (ret) Name of result global for Broker.
"RTN","BMXRPC",162,0)
; 2 - BMXERR (req) Text of error to be stored in result global.
"RTN","BMXRPC",163,0)
;
"RTN","BMXRPC",164,0)
S:$G(BMXERR)="" BMXERR="Error not passed (software error)."
"RTN","BMXRPC",165,0)
;
"RTN","BMXRPC",166,0)
N BMX31 S BMX31=$C(31)_$C(31)
"RTN","BMXRPC",167,0)
K ^BMXTMP($J),^BMXTEMP($J)
"RTN","BMXRPC",168,0)
S BMXGBL="^BMXTEMP("_$J_")"
"RTN","BMXRPC",169,0)
S ^BMXTEMP($J,1)=BMX31_BMXERR
"RTN","BMXRPC",170,0)
Q
"RTN","BMXRPC",171,0)
UTF8(BMXRET)
"RTN","BMXRPC",172,0)
; RPC: BMX UTF-8
"RTN","BMXRPC",173,0)
; UJO/SMH - tests if this database supports UTF-8 encoding
"RTN","BMXRPC",174,0)
; 0 for FALSE for 1 for TRUE.
"RTN","BMXRPC",175,0)
I ^%ZOSF("OS")'["GT.M" S BMXRET=0 QUIT
"RTN","BMXRPC",176,0)
I $ZCHSET="M" S BMXRET=0 QUIT
"RTN","BMXRPC",177,0)
I $ZCHSET="UTF-8" S BMXRET=1 QUIT
"RTN","BMXRPC",178,0)
S BMXRET=0 QUIT ;default
"RTN","BMXRPC1")
0^88^B52168951
"RTN","BMXRPC1",1,0)
BMXRPC1 ; IHS/OIT/HMW - UTIL: REMOTE PROCEDURE CALLS ;
"RTN","BMXRPC1",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXRPC1",3,0)
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
"RTN","BMXRPC1",4,0)
;; UTILITY: CODE FOR REMOTE PROCEDURE CALLS.
"RTN","BMXRPC1",5,0)
;; RETURNS PATIENT DATA, HEALTH SUMMARY, FACE SHEET.
"RTN","BMXRPC1",6,0)
;
"RTN","BMXRPC1",7,0)
;
"RTN","BMXRPC1",8,0)
;----------
"RTN","BMXRPC1",9,0)
PDATA(BMXDATA,BMXDFN) ;EP
"RTN","BMXRPC1",10,0)
;---> Return Patient Data in 5 ^-delimited pieces:
"RTN","BMXRPC1",11,0)
;---> 1 - DOB in format: OCT 01,1994.
"RTN","BMXRPC1",12,0)
;---> 2 - Age in format: 35 Months.
"RTN","BMXRPC1",13,0)
;---> 3 - Text of Patient's sex.
"RTN","BMXRPC1",14,0)
;---> 4 - HRCN in the format XX-XX-XX.
"RTN","BMXRPC1",15,0)
;---> 5 - Text of ACTIVE/INACTIVE Status.
"RTN","BMXRPC1",16,0)
;---> Parameters:
"RTN","BMXRPC1",17,0)
; 1 - BMXDATA (ret) String of patient data||error.
"RTN","BMXRPC1",18,0)
; 2 - BMXDFN (req) DFN of patient.
"RTN","BMXRPC1",19,0)
;
"RTN","BMXRPC1",20,0)
;---> Delimiter to pass error with result to GUI.
"RTN","BMXRPC1",21,0)
N BMX31,BMXERR S BMX31=$C(31)_$C(31)
"RTN","BMXRPC1",22,0)
S BMXDATA="",BMXERR=""
"RTN","BMXRPC1",23,0)
;
"RTN","BMXRPC1",24,0)
;---> If DFN not supplied, set Error Code and quit.
"RTN","BMXRPC1",25,0)
I '$G(BMXDFN) D Q
"RTN","BMXRPC1",26,0)
.;D ERRCD^BMXUTL2(201,.BMXERR) S BMXDATA=BMX31_BMXERR
"RTN","BMXRPC1",27,0)
;
"RTN","BMXRPC1",28,0)
;---> DOB.
"RTN","BMXRPC1",29,0)
S BMXDATA=$$TXDT1^BMXUTL5($$DOB^BMXUTL1(BMXDFN))
"RTN","BMXRPC1",30,0)
;
"RTN","BMXRPC1",31,0)
;---> Age.
"RTN","BMXRPC1",32,0)
S BMXDATA=BMXDATA_U_$$AGEF^BMXUTL1(BMXDFN)
"RTN","BMXRPC1",33,0)
;
"RTN","BMXRPC1",34,0)
;---> Text of sex.
"RTN","BMXRPC1",35,0)
S BMXDATA=BMXDATA_U_$$SEXW^BMXUTL1(BMXDFN)
"RTN","BMXRPC1",36,0)
;
"RTN","BMXRPC1",37,0)
;---> HRCN, format XX-XX-XX.
"RTN","BMXRPC1",38,0)
S BMXDATA=BMXDATA_U_$$HRCN^BMXUTL1(BMXDFN)
"RTN","BMXRPC1",39,0)
;
"RTN","BMXRPC1",40,0)
;---> Active/Inactive Status.
"RTN","BMXRPC1",41,0)
;S BMXDATA=BMXDATA_U_$$ACTIVE^BMXUTL1(BMXDFN)
"RTN","BMXRPC1",42,0)
;
"RTN","BMXRPC1",43,0)
S BMXDATA=BMXDATA_BMX31
"RTN","BMXRPC1",44,0)
;
"RTN","BMXRPC1",45,0)
Q
"RTN","BMXRPC1",46,0)
;
"RTN","BMXRPC1",47,0)
;
"RTN","BMXRPC1",48,0)
;----------
"RTN","BMXRPC1",49,0)
HS(BMXGBL,BMXDFN) ;EP
"RTN","BMXRPC1",50,0)
;---> Return patient's Health Summary in global array, ^BMXTEMP($J,"HS".
"RTN","BMXRPC1",51,0)
;---> Lines delimited by "^".
"RTN","BMXRPC1",52,0)
;---> Called by RPC: BMX IMMSERVE PT PROFILE
"RTN","BMXRPC1",53,0)
;---> Parameters:
"RTN","BMXRPC1",54,0)
; 1 - BMXGBL (ret) Name of result global containing patient's
"RTN","BMXRPC1",55,0)
; Health Summary, passed to Broker.
"RTN","BMXRPC1",56,0)
; 2 - BMXDFN (req) DFN of patient.
"RTN","BMXRPC1",57,0)
;
"RTN","BMXRPC1",58,0)
;---> Delimiter to pass error with result to GUI.
"RTN","BMXRPC1",59,0)
N BMX30,BMX31,BMXERR,X
"RTN","BMXRPC1",60,0)
S BMX30=$C(30),BMX31=$C(31)_$C(31)
"RTN","BMXRPC1",61,0)
S BMXGBL="^BMXTEMP("_$J_",""HS"")",BMXERR=""
"RTN","BMXRPC1",62,0)
K ^BMXTEMP($J,"HS")
"RTN","BMXRPC1",63,0)
;
"RTN","BMXRPC1",64,0)
;---> If DFN not supplied, set Error Code and quit.
"RTN","BMXRPC1",65,0)
I '$G(BMXDFN) D Q
"RTN","BMXRPC1",66,0)
.;D ERRCD^BMXUTL2(201,.BMXERR) S ^BMXTEMP($J,"HS",I)=BMX31_BMXERR
"RTN","BMXRPC1",67,0)
;
"RTN","BMXRPC1",68,0)
;---> If patient does not exist, set Error Code and quit.
"RTN","BMXRPC1",69,0)
I '$D(^AUPNPAT(BMXDFN,0)) D Q
"RTN","BMXRPC1",70,0)
.;D ERRCD^BMXUTL2(203,.BMXERR) S ^BMXTEMP($J,"HS",I)=BMX31_BMXERR
"RTN","BMXRPC1",71,0)
;
"RTN","BMXRPC1",72,0)
N APCHSPAT,APCHSTYP
"RTN","BMXRPC1",73,0)
S APCHSPAT=BMXDFN,APCHSTYP=7
"RTN","BMXRPC1",74,0)
;---> Doesn't work from Device 56.
"RTN","BMXRPC1",75,0)
;D GUIR^XBLM("EN^APCHS","^TMP(""BMXHS"",$J,")
"RTN","BMXRPC1",76,0)
;
"RTN","BMXRPC1",77,0)
;---> Generate a host file name.
"RTN","BMXRPC1",78,0)
N BMXFN S BMXFN="XB"_$J
"RTN","BMXRPC1",79,0)
;
"RTN","BMXRPC1",80,0)
D
"RTN","BMXRPC1",81,0)
.;---> Important to preserve IO variables for when $I returns to 56.
"RTN","BMXRPC1",82,0)
.N IO,IOBS,IOF,IOHG,IOM,ION,IOPAR,IOS,IOSL,IOST,IOT,IOUPAR,IOXY
"RTN","BMXRPC1",83,0)
.;
"RTN","BMXRPC1",84,0)
.;---> Open host file to receive legacy code display.
"RTN","BMXRPC1",85,0)
.;S Y=$$OPEN^%ZISH($$HFSPATH^BMXUTL1,BMXFN,"W")
"RTN","BMXRPC1",86,0)
.;
"RTN","BMXRPC1",87,0)
.;---> Call to legacy code for Health Summary display.
"RTN","BMXRPC1",88,0)
.D EN^APCHS
"RTN","BMXRPC1",89,0)
.;---> Write End of File (EOF) marker.
"RTN","BMXRPC1",90,0)
.W $C(9)
"RTN","BMXRPC1",91,0)
.;
"RTN","BMXRPC1",92,0)
.;---> %ZISC doesn't close Device 51 when called from TCPIP socket?
"RTN","BMXRPC1",93,0)
.;D ^%ZISC
"RTN","BMXRPC1",94,0)
.;---> Buffer won't write out to file until the device is closed
"RTN","BMXRPC1",95,0)
.;---> or the buffer is flushed by some other command.
"RTN","BMXRPC1",96,0)
.;---> At this point, host file exists but has 0 bytes.
"RTN","BMXRPC1",97,0)
.;C 51
"RTN","BMXRPC1",98,0)
.;---> Now host file contains legacy code display data.
"RTN","BMXRPC1",99,0)
.;
"RTN","BMXRPC1",100,0)
.;---> For some reason %ZISH cannot open the host file a second time.
"RTN","BMXRPC1",101,0)
.;S Y=$$OPEN^%ZISH($$HFSPATH^BMXUTL1,BMXFN,"R")
"RTN","BMXRPC1",102,0)
.;O 51:($$HFSPATH^BMXUTL1_BMXFN:"R")
"RTN","BMXRPC1",103,0)
.;U 51
"RTN","BMXRPC1",104,0)
.;
"RTN","BMXRPC1",105,0)
.;---> Read in the host file.
"RTN","BMXRPC1",106,0)
.D
"RTN","BMXRPC1",107,0)
..;---> Stop reading Host File if line contains EOF $C(9).
"RTN","BMXRPC1",108,0)
..;N I,Y F I=1:1 R Y Q:Y[$C(9) S ^TMP("BMXHS",$J,I)=Y
"RTN","BMXRPC1",109,0)
.;
"RTN","BMXRPC1",110,0)
.;---> %ZISC doesn't close Device 51 when called from TCPIP socket?
"RTN","BMXRPC1",111,0)
.;D ^%ZISC
"RTN","BMXRPC1",112,0)
.;C 51
"RTN","BMXRPC1",113,0)
;
"RTN","BMXRPC1",114,0)
;---> At this point $I=1. The job has "forgotten" its $I, even
"RTN","BMXRPC1",115,0)
;---> though %SS shows 56 as the current device. $I=1 causes a
"RTN","BMXRPC1",116,0)
;---> <NOPEN> at CAPI+10^XWBBRK2. A simple USE 56 command
"RTN","BMXRPC1",117,0)
;---> appears to "remind" the job its $I is 56, and it works.
"RTN","BMXRPC1",118,0)
;---> Possibly this is something %ZISC ordinarily does.
"RTN","BMXRPC1",119,0)
;U 56
"RTN","BMXRPC1",120,0)
;
"RTN","BMXRPC1",121,0)
;---> Copy Health Summary to global array for passing back to GUI.
"RTN","BMXRPC1",122,0)
N I,N,U,X S U="^"
"RTN","BMXRPC1",123,0)
S N=0
"RTN","BMXRPC1",124,0)
F I=1:1 S N=$O(^TMP("BMXHS",$J,N)) Q:'N D
"RTN","BMXRPC1",125,0)
.;---> Set null lines (line breaks) equal to one space, so that
"RTN","BMXRPC1",126,0)
.;---> Windows reader will quit only at the final "null" line.
"RTN","BMXRPC1",127,0)
.S X=^TMP("BMXHS",$J,N) S:X="" X=" "
"RTN","BMXRPC1",128,0)
.S ^BMXTEMP($J,"HS",I)=X_BMX30
"RTN","BMXRPC1",129,0)
;
"RTN","BMXRPC1",130,0)
;---> If no Health Summary produced, report it as an error.
"RTN","BMXRPC1",131,0)
D:'$O(^BMXTEMP($J,"HS",0))
"RTN","BMXRPC1",132,0)
.;D ERRCD^BMXUTL2(407,.BMXERR) S ^BMXTEMP($J,"HS",I)=BMX31_BMXERR
"RTN","BMXRPC1",133,0)
;
"RTN","BMXRPC1",134,0)
;---> Tack on Error Delimiter and any error.
"RTN","BMXRPC1",135,0)
S ^BMXTEMP($J,"HS",I)=BMX31_BMXERR
"RTN","BMXRPC1",136,0)
;
"RTN","BMXRPC1",137,0)
;---> This works; host file gets deleted.
"RTN","BMXRPC1",138,0)
;S Y=$$DEL^%ZISH($$HFSPATH^BMXUTL1,BMXFN)
"RTN","BMXRPC1",139,0)
K ^TMP("BMXHS",$J)
"RTN","BMXRPC1",140,0)
Q
"RTN","BMXRPC1",141,0)
;
"RTN","BMXRPC1",142,0)
;
"RTN","BMXRPC1",143,0)
;----------
"RTN","BMXRPC1",144,0)
FACE(BMXGBL,BMXDFN) ;EP
"RTN","BMXRPC1",145,0)
;---> Return patient's Face Sheet in global array, ^BMXTEMP($J,"FACE".
"RTN","BMXRPC1",146,0)
;---> Lines delimited by "^".
"RTN","BMXRPC1",147,0)
;---> Called by RPC: BMX IMMSERVE PT PROFILE
"RTN","BMXRPC1",148,0)
;---> Parameters:
"RTN","BMXRPC1",149,0)
; 1 - BMXGBL (ret) Name of result global containing patient's
"RTN","BMXRPC1",150,0)
; Face Sheet, passed to Broker.
"RTN","BMXRPC1",151,0)
; 2 - BMXDFN (req) DFN of patient.
"RTN","BMXRPC1",152,0)
;
"RTN","BMXRPC1",153,0)
;---> Delimiter to pass error with result to GUI.
"RTN","BMXRPC1",154,0)
N BMX30,BMX31,BMXERR,X
"RTN","BMXRPC1",155,0)
S BMX30=$C(30),BMX31=$C(31)_$C(31)
"RTN","BMXRPC1",156,0)
S BMXGBL="^BMXTEMP("_$J_",""FACE"")",BMXERR=""
"RTN","BMXRPC1",157,0)
K ^BMXTEMP($J,"FACE")
"RTN","BMXRPC1",158,0)
;
"RTN","BMXRPC1",159,0)
;---> If DFN not supplied, set Error Code and quit.
"RTN","BMXRPC1",160,0)
I '$G(BMXDFN) D Q
"RTN","BMXRPC1",161,0)
.;D ERRCD^BMXUTL2(201,.BMXERR) S ^BMXTEMP($J,"FACE",I)=BMX31_BMXERR
"RTN","BMXRPC1",162,0)
;
"RTN","BMXRPC1",163,0)
;---> If patient does not exist, set Error Code and quit.
"RTN","BMXRPC1",164,0)
I '$D(^AUPNPAT(BMXDFN,0)) D Q
"RTN","BMXRPC1",165,0)
.;D ERRCD^BMXUTL2(203,.BMXERR) S ^BMXTEMP($J,"FACE",I)=BMX31_BMXERR
"RTN","BMXRPC1",166,0)
;
"RTN","BMXRPC1",167,0)
N DFN S DFN=BMXDFN
"RTN","BMXRPC1",168,0)
;---> Doesn't work from Device 56.
"RTN","BMXRPC1",169,0)
;---> Generate a host file name.
"RTN","BMXRPC1",170,0)
N BMXFN S BMXFN="XB"_$J
"RTN","BMXRPC1",171,0)
;
"RTN","BMXRPC1",172,0)
D
"RTN","BMXRPC1",173,0)
.;---> Important to preserve IO variables for when $I returns to 56.
"RTN","BMXRPC1",174,0)
.N IO,IOBS,IOF,IOHG,IOM,ION,IOPAR,IOS,IOSL,IOST,IOT,IOUPAR,IOXY
"RTN","BMXRPC1",175,0)
.;
"RTN","BMXRPC1",176,0)
.;---> Open host file to receive legacy code display.
"RTN","BMXRPC1",177,0)
.;S Y=$$OPEN^%ZISH($$HFSPATH^BMXUTL1,BMXFN,"W")
"RTN","BMXRPC1",178,0)
.;
"RTN","BMXRPC1",179,0)
.;---> Call to legacy code for Face Sheet display.
"RTN","BMXRPC1",180,0)
.U 51
"RTN","BMXRPC1",181,0)
.;D ^BMXFACE
"RTN","BMXRPC1",182,0)
.;---> Write End of File (EOF) marker.
"RTN","BMXRPC1",183,0)
.W $C(9)
"RTN","BMXRPC1",184,0)
.;
"RTN","BMXRPC1",185,0)
.;---> %ZISC doesn't close Device 51 when called from TCPIP socket?
"RTN","BMXRPC1",186,0)
.;D ^%ZISC
"RTN","BMXRPC1",187,0)
.;---> Buffer won't write out to file until the device is closed
"RTN","BMXRPC1",188,0)
.;---> or the buffer is flushed by some other command.
"RTN","BMXRPC1",189,0)
.;---> At this point, host file exists but has 0 bytes.
"RTN","BMXRPC1",190,0)
.;C 51
"RTN","BMXRPC1",191,0)
.;---> Now host file contains legacy code display data.
"RTN","BMXRPC1",192,0)
.;
"RTN","BMXRPC1",193,0)
.;---> For some reason %ZISH cannot open the host file a second time.
"RTN","BMXRPC1",194,0)
.;S Y=$$OPEN^%ZISH($$HFSPATH^BMXUTL1,BMXFN,"R")
"RTN","BMXRPC1",195,0)
.;O 51:($$HFSPATH^BMXUTL1_BMXFN:"R")
"RTN","BMXRPC1",196,0)
.U 51
"RTN","BMXRPC1",197,0)
.;
"RTN","BMXRPC1",198,0)
.;---> Read in the host file.
"RTN","BMXRPC1",199,0)
.D
"RTN","BMXRPC1",200,0)
..;---> Need some way to mark the end of legacy code output.
"RTN","BMXRPC1",201,0)
..;---> Stop reading Host File if line contains EOF $C(9).
"RTN","BMXRPC1",202,0)
..;---> (I added $C(9) above, after ^BMXFACE completed.)
"RTN","BMXRPC1",203,0)
..;N I,Y F I=1:1 R Y Q:Y[$C(9) S ^TMP("BMXFACE",$J,I)=Y
"RTN","BMXRPC1",204,0)
.;
"RTN","BMXRPC1",205,0)
.;---> %ZISC doesn't close Device 51 when called from TCPIP socket?
"RTN","BMXRPC1",206,0)
.;D ^%ZISC
"RTN","BMXRPC1",207,0)
.;C 51
"RTN","BMXRPC1",208,0)
;
"RTN","BMXRPC1",209,0)
;---> At this point $I=1. The job has "forgotten" its $I, even
"RTN","BMXRPC1",210,0)
;---> though %SS shows 56 as the current device. $I=1 causes a
"RTN","BMXRPC1",211,0)
;---> <NOPEN> at CAPI+10^XWBBRK2. A simple USE 56 command
"RTN","BMXRPC1",212,0)
;---> appears to "remind" the job its $I is 56, and it works.
"RTN","BMXRPC1",213,0)
;---> Possibly this is something %ZISC ordinarily does.
"RTN","BMXRPC1",214,0)
U 56
"RTN","BMXRPC1",215,0)
;
"RTN","BMXRPC1",216,0)
;---> Copy Face Sheet to global array for passing back to GUI.
"RTN","BMXRPC1",217,0)
N I,N,U,X S U="^"
"RTN","BMXRPC1",218,0)
S N=0
"RTN","BMXRPC1",219,0)
F I=1:1 S N=$O(^TMP("BMXFACE",$J,N)) Q:'N D
"RTN","BMXRPC1",220,0)
.;---> Set null lines (line breaks) equal to one space, so that
"RTN","BMXRPC1",221,0)
.;---> Windows reader will quit only at the final "null" line.
"RTN","BMXRPC1",222,0)
.S X=^TMP("BMXFACE",$J,N) S:X="" X=" "
"RTN","BMXRPC1",223,0)
.;---> Remove Carriage Return (13)_Formfeed (12) characters.
"RTN","BMXRPC1",224,0)
.I X[$C(13)_$C(12) S X=$P(X,$C(13)_$C(12),2)
"RTN","BMXRPC1",225,0)
.;
"RTN","BMXRPC1",226,0)
.S ^BMXTEMP($J,"FACE",I)=X_BMX30
"RTN","BMXRPC1",227,0)
;
"RTN","BMXRPC1",228,0)
;---> If no Health Summary produced, report it as an error.
"RTN","BMXRPC1",229,0)
D:'$O(^BMXTEMP($J,"FACE",0))
"RTN","BMXRPC1",230,0)
.;D ERRCD^BMXUTL2(408,.BMXERR) S ^BMXTEMP($J,"FACE",I)=BMX31_BMXERR
"RTN","BMXRPC1",231,0)
;
"RTN","BMXRPC1",232,0)
;---> Tack on Error Delimiter and any error.
"RTN","BMXRPC1",233,0)
S ^BMXTEMP($J,"FACE",I)=BMX31_BMXERR
"RTN","BMXRPC1",234,0)
;
"RTN","BMXRPC1",235,0)
;---> This works; host file gets deleted.
"RTN","BMXRPC1",236,0)
;S Y=$$DEL^%ZISH($$HFSPATH^BMXUTL1,BMXFN)
"RTN","BMXRPC1",237,0)
K ^TMP("BMXFACE",$J)
"RTN","BMXRPC1",238,0)
Q
"RTN","BMXRPC2")
0^89^B11504982
"RTN","BMXRPC2",1,0)
BMXRPC2 ; IHS/OIT/HMW - FIELD LIST ;
"RTN","BMXRPC2",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXRPC2",3,0)
;
"RTN","BMXRPC2",4,0)
FLDLIST(BMXGBL,BMXFL,BMXATTR,BMXSCR) ;EP
"RTN","BMXRPC2",5,0)
;TODO: Change all this to be a hard-coded $O thru ^DD
"RTN","BMXRPC2",6,0)
;Returns info in BMXATTR for all fields in file number BMXFL
"RTN","BMXRPC2",7,0)
;BMXSCR is executable code to set $T
"RTN","BMXRPC2",8,0)
; When BMXSCR is executed, the field number is in BMXFLD
"RTN","BMXRPC2",9,0)
;See FileMan documentation for FIELD^DD for description
"RTN","BMXRPC2",10,0)
;of Attributes
"RTN","BMXRPC2",11,0)
;
"RTN","BMXRPC2",12,0)
;---> Set variables, kill temp globals.
"RTN","BMXRPC2",13,0)
;S ^HW("F",BMXFL)=""
"RTN","BMXRPC2",14,0)
;S ^HW("F",BMXATTR)=""
"RTN","BMXRPC2",15,0)
N BMX31,BMXERR,BMXG,BMXFLD,BMX,BMXC,BMXT
"RTN","BMXRPC2",16,0)
S BMX31=$C(31)_$C(31)
"RTN","BMXRPC2",17,0)
S BMXGBL="BMXTMP("_$J_")",BMXERR="",U="^"
"RTN","BMXRPC2",18,0)
K BMXTMP($J)
"RTN","BMXRPC2",19,0)
;
"RTN","BMXRPC2",20,0)
;---> If file number not provided, return error.
"RTN","BMXRPC2",21,0)
;I '+BMXFL D ERROUT^BMXRPC("File number not provided.",1) Q
"RTN","BMXRPC2",22,0)
;---> If file number not provided check for file name.
"RTN","BMXRPC2",23,0)
I +BMXFL'=BMXFL D
"RTN","BMXRPC2",24,0)
. S BMXFL=$TR(BMXFL,"_"," ")
"RTN","BMXRPC2",25,0)
. I '$D(^DIC("B",BMXFL)) S BMXFL="" Q
"RTN","BMXRPC2",26,0)
. S BMXFL=$O(^DIC("B",BMXFL,0))
"RTN","BMXRPC2",27,0)
I '$G(BMXFL) D ERROUT^BMXRPC("File number not provided.",1) Q
"RTN","BMXRPC2",28,0)
;
"RTN","BMXRPC2",29,0)
;---> If no such file, return error.
"RTN","BMXRPC2",30,0)
I '$D(^DD(BMXFL,0)) D ERROUT^BMXRPC("File does not exist.",1) Q
"RTN","BMXRPC2",31,0)
;
"RTN","BMXRPC2",32,0)
;---> Validate screen code
"RTN","BMXRPC2",33,0)
I $G(BMXSCR)="" S BMXSCR="I 1"
"RTN","BMXRPC2",34,0)
S X=$G(BMXSCR)
"RTN","BMXRPC2",35,0)
I X]"" D ^DIM
"RTN","BMXRPC2",36,0)
I '$D(X) S BMXSCR="I 1" ;Default to no screen
"RTN","BMXRPC2",37,0)
;
"RTN","BMXRPC2",38,0)
;---> Set Target Global for output and errors.
"RTN","BMXRPC2",39,0)
S BMXG="BMXTMP($J,""DID"")"
"RTN","BMXRPC2",40,0)
;
"RTN","BMXRPC2",41,0)
;---> Loop through ^DD(FileNumber,FieldNumber,0) to get field names
"RTN","BMXRPC2",42,0)
K BMXTMP($J)
"RTN","BMXRPC2",43,0)
I $G(BMXATTR)="" S BMXATTR="LABEL" ;Changed from NAME to LABEL
"RTN","BMXRPC2",44,0)
;---> Attribute Names
"RTN","BMXRPC2",45,0)
F I=1:1:$L(BMXATTR,";") S BMXT($P(BMXATTR,";",I))=""
"RTN","BMXRPC2",46,0)
S (BMX,BMXC)=0 F S BMX=$O(BMXT(BMX)) Q:BMX="" D
"RTN","BMXRPC2",47,0)
. S BMXC=BMXC+1
"RTN","BMXRPC2",48,0)
. S $P(BMXT,U,BMXC)="T00030"_BMX
"RTN","BMXRPC2",49,0)
S BMXTMP($J,1)="T00030NUMBER"_U_BMXT_$C(30)
"RTN","BMXRPC2",50,0)
;
"RTN","BMXRPC2",51,0)
;S BMXFLD=0 F I=2:1 S BMXFLD=$O(^DD(BMXFL,BMXFLD)) Q:'+BMXFLD D
"RTN","BMXRPC2",52,0)
S BMXTMP($J,2)=".001^BMXIEN"_$C(30)
"RTN","BMXRPC2",53,0)
S BMXFLDN=0 F I=3:1 S BMXFLDN=$O(^DD(BMXFL,"B",BMXFLDN)) Q:BMXFLDN="" D
"RTN","BMXRPC2",54,0)
. S BMXFLD=$O(^DD(BMXFL,"B",BMXFLDN,0)) Q:'+BMXFLD
"RTN","BMXRPC2",55,0)
. X BMXSCR Q:'$T
"RTN","BMXRPC2",56,0)
. D FIELD^DID(BMXFL,BMXFLD,,BMXATTR,BMXG,BMXG)
"RTN","BMXRPC2",57,0)
. K BMXT S (BMXC,BMX)=0
"RTN","BMXRPC2",58,0)
. F S BMX=$O(BMXTMP($J,"DID",BMX)) Q:BMX="" D
"RTN","BMXRPC2",59,0)
. . S BMXC=BMXC+1
"RTN","BMXRPC2",60,0)
. . S $P(BMXT,U,BMXC)=BMXTMP($J,"DID",BMX)
"RTN","BMXRPC2",61,0)
. S BMXTMP($J,I)=BMXFLD_U_$TR(BMXT," ","_")_$C(30)
"RTN","BMXRPC2",62,0)
;S I=I+1,BMXTMP($J,I)=".001^BMXIEN"_$C(30)
"RTN","BMXRPC2",63,0)
S I=I+1
"RTN","BMXRPC2",64,0)
K BMXTMP($J,"DID")
"RTN","BMXRPC2",65,0)
;---> Tack on Error Delimiter and any error.
"RTN","BMXRPC2",66,0)
S BMXTMP($J,I)=BMX31_BMXERR
"RTN","BMXRPC2",67,0)
Q
"RTN","BMXRPC2",68,0)
;
"RTN","BMXRPC2",69,0)
MLTLIST(BMXGBL,BMXFL,BMXONEOK) ;EP
"RTN","BMXRPC2",70,0)
;Returns list of multiple fields in file BMXFL, returns only one field
"RTN","BMXRPC2",71,0)
;if BMXONEOK is TRUE
"RTN","BMXRPC2",72,0)
;S ^HW($H,"MLTLIST","FL")=BMXFL
"RTN","BMXRPC2",73,0)
;S ^HW($H,"MLTLIST","ONE")=BMXONEOK
"RTN","BMXRPC2",74,0)
N BMX31,BMXERR,BMXG,BMXFLD,BMX,BMXC,BMXT,I
"RTN","BMXRPC2",75,0)
S BMX31=$C(31)_$C(31)
"RTN","BMXRPC2",76,0)
S BMXGBL="BMXTMP("_$J_")",BMXERR="",U="^"
"RTN","BMXRPC2",77,0)
K BMXTMP($J)
"RTN","BMXRPC2",78,0)
;
"RTN","BMXRPC2",79,0)
;---> If file number not provided check for file name.
"RTN","BMXRPC2",80,0)
I +BMXFL'=BMXFL D
"RTN","BMXRPC2",81,0)
. S BMXFL=$TR(BMXFL,"_"," ")
"RTN","BMXRPC2",82,0)
. I '$D(^DIC("B",BMXFL)) S BMXFL="" Q
"RTN","BMXRPC2",83,0)
. S BMXFL=$O(^DIC("B",BMXFL,0))
"RTN","BMXRPC2",84,0)
I '$G(BMXFL) D ERROUT^BMXRPC("File number not provided.",1) Q
"RTN","BMXRPC2",85,0)
;
"RTN","BMXRPC2",86,0)
;---> If no such file, return error.
"RTN","BMXRPC2",87,0)
I '$D(^DD(BMXFL,0)) D ERROUT^BMXRPC("File does not exist.",1) Q
"RTN","BMXRPC2",88,0)
;
"RTN","BMXRPC2",89,0)
;---> Column Headers
"RTN","BMXRPC2",90,0)
S BMXTMP($J,1)="T00030NUMBER"_U_"T00030NAME"_$C(30)
"RTN","BMXRPC2",91,0)
;
"RTN","BMXRPC2",92,0)
;---> $O thru ^DD(BMXFL,"SB" to get subfile numbers and names
"RTN","BMXRPC2",93,0)
S I=2
"RTN","BMXRPC2",94,0)
N BMXSB,BMXSBN,BMXSBF,BMXFOUND
"RTN","BMXRPC2",95,0)
S BMXFOUND=0
"RTN","BMXRPC2",96,0)
I $D(^DD(BMXFL,"SB")) D
"RTN","BMXRPC2",97,0)
. S BMXSB=0
"RTN","BMXRPC2",98,0)
. F S BMXSB=$O(^DD(BMXFL,"SB",BMXSB)) Q:'+BMXSB D I BMXFOUND Q:BMXONEOK=1
"RTN","BMXRPC2",99,0)
. . S BMXSBF=$O(^DD(BMXFL,"SB",BMXSB,0))
"RTN","BMXRPC2",100,0)
. . Q:'+BMXSBF
"RTN","BMXRPC2",101,0)
. . S BMXSBN=$G(^DD(BMXFL,BMXSBF,0))
"RTN","BMXRPC2",102,0)
. . Q:BMXSBN=""
"RTN","BMXRPC2",103,0)
. . S BMXZ=$G(^DD(BMXSB,.01,0))
"RTN","BMXRPC2",104,0)
. . Q:$P(BMXZ,U,2)["W"
"RTN","BMXRPC2",105,0)
. . S BMXFOUND=1
"RTN","BMXRPC2",106,0)
. . S BMXSBN=$P(BMXSBN,U)
"RTN","BMXRPC2",107,0)
. . S BMXTMP($J,I)=BMXSB_U_BMXSBN_$C(30)
"RTN","BMXRPC2",108,0)
. . S I=I+1
"RTN","BMXRPC2",109,0)
;
"RTN","BMXRPC2",110,0)
;---> Tack on Error Delimiter and any error.
"RTN","BMXRPC2",111,0)
S BMXTMP($J,I)=BMX31_BMXERR
"RTN","BMXRPC2",112,0)
Q
"RTN","BMXRPC3")
0^90^B39843476
"RTN","BMXRPC3",1,0)
BMXRPC3 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; ; 8/30/10 2:56pm
"RTN","BMXRPC3",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXRPC3",3,0)
;Mods by WV/SMH
"RTN","BMXRPC3",4,0)
;7/26/09 Removed references to ^AUTTSITE, an IHS file in GETFAC*
"RTN","BMXRPC3",5,0)
;8/30/10 Changed GETFCRS to return a better list of user divisions
"RTN","BMXRPC3",6,0)
; - Checks to see if there are any divisions
"RTN","BMXRPC3",7,0)
;
"RTN","BMXRPC3",8,0)
VARVAL(RESULT,VARIABLE) ;returns value of passed in variable
"RTN","BMXRPC3",9,0)
S VARIABLE=$TR(VARIABLE,"~","^")
"RTN","BMXRPC3",10,0)
S RESULT=VARIABLE ;can do this with the REFERENCE type parameter
"RTN","BMXRPC3",11,0)
Q
"RTN","BMXRPC3",12,0)
;See GETV^XWBBRK for how we get the REFERENCE type parameter
"RTN","BMXRPC3",13,0)
;
"RTN","BMXRPC3",14,0)
USER(RESULT,D) ;
"RTN","BMXRPC3",15,0)
;
"RTN","BMXRPC3",16,0)
I '+D S RESULT="" Q
"RTN","BMXRPC3",17,0)
S RESULT=$P($G(^VA(200,D,0)),"^")
"RTN","BMXRPC3",18,0)
Q
"RTN","BMXRPC3",19,0)
;
"RTN","BMXRPC3",20,0)
NTUSER(BMXY,BMXNTUSER) ;EP
"RTN","BMXRPC3",21,0)
;Old code. Retain for reference
"RTN","BMXRPC3",22,0)
;Returns NTDomain^NTUserName^RPMSName for user having DUZ=D
"RTN","BMXRPC3",23,0)
;TODO: Move ANMC NT USERS file
"RTN","BMXRPC3",24,0)
;from AZZWNT to BMX namespace and numberspace
"RTN","BMXRPC3",25,0)
;
"RTN","BMXRPC3",26,0)
;N BMX,BMXNOD,BMXDOM,BMXNAM,BMXCOL,BMXRNAM
"RTN","BMXRPC3",27,0)
;S (BMXDOM,BMXNAM,BMXRNAM)=""
"RTN","BMXRPC3",28,0)
;S U="^"
"RTN","BMXRPC3",29,0)
;I '+D S RESULT="" Q
"RTN","BMXRPC3",30,0)
;S BMXRNAM=$G(^VA(200,D,0)),BMXRNAM=$P(BMXRNAM,U)
"RTN","BMXRPC3",31,0)
;I '$D(^AZZWNT("DUZ",D)) D NTU1 Q
"RTN","BMXRPC3",32,0)
;S BMX=$O(^AZZWNT("DUZ",D,0))
"RTN","BMXRPC3",33,0)
;I '+BMX D NTU1 Q
"RTN","BMXRPC3",34,0)
;I '$D(^AZZWNT(BMX,0)) D NTU1 Q
"RTN","BMXRPC3",35,0)
;S BMXNOD=^AZZWNT(BMX,0)
"RTN","BMXRPC3",36,0)
;S BMXDOM=$P(BMXNOD,U,2)
"RTN","BMXRPC3",37,0)
;S BMXNAM=$P(BMXNOD,U) ;,4)
"RTN","BMXRPC3",38,0)
;D NTU1
"RTN","BMXRPC3",39,0)
Q
"RTN","BMXRPC3",40,0)
;
"RTN","BMXRPC3",41,0)
;
"RTN","BMXRPC3",42,0)
NTUGETD(BMXY,BMXNTNAME) ;EP
"RTN","BMXRPC3",43,0)
;Entry point for debugging
"RTN","BMXRPC3",44,0)
;
"RTN","BMXRPC3",45,0)
D DEBUG^%Serenji("NTUGET^BMXRPC3(.BMXY,BMXNTNAME)")
"RTN","BMXRPC3",46,0)
Q
"RTN","BMXRPC3",47,0)
;
"RTN","BMXRPC3",48,0)
NTUGET(BMXY,BMXNTNAME) ;EP
"RTN","BMXRPC3",49,0)
;
"RTN","BMXRPC3",50,0)
;Returns A ENCRYPTED and V ENCRYPTED for NT User BMXNTNAME
"RTN","BMXRPC3",51,0)
;Called by RPC BMXNetGetCodes
"RTN","BMXRPC3",52,0)
N BMXI,BMXNTID,BMXNTID,BMXNOD,BMXA,BMXV
"RTN","BMXRPC3",53,0)
S BMXI=0
"RTN","BMXRPC3",54,0)
S BMXY="^BMXTMP("_$J_")"
"RTN","BMXRPC3",55,0)
S X="NTUET^BMXRPC3",@^%ZOSF("TRAP")
"RTN","BMXRPC3",56,0)
S BMXI=BMXI+1
"RTN","BMXRPC3",57,0)
I BMXNTNAME="" S ^BMXTMP($J,BMXI)="^" Q
"RTN","BMXRPC3",58,0)
S BMXNTID=$O(^BMXUSER("B",BMXNTNAME,0))
"RTN","BMXRPC3",59,0)
I '+BMXNTID S ^BMXTMP($J,BMXI)="^" Q
"RTN","BMXRPC3",60,0)
S BMXNOD=$G(^BMXUSER(BMXNTID,0))
"RTN","BMXRPC3",61,0)
S BMXA=$P(BMXNOD,U,2)
"RTN","BMXRPC3",62,0)
S BMXV=$P(BMXNOD,U,3)
"RTN","BMXRPC3",63,0)
S ^BMXTMP($J,BMXI)=BMXA_"^"_BMXV_"^"
"RTN","BMXRPC3",64,0)
Q
"RTN","BMXRPC3",65,0)
;
"RTN","BMXRPC3",66,0)
WINUGET(BMXWINID) ;EP
"RTN","BMXRPC3",67,0)
;Returns DUZ for user having Windows Identity BMXWINID
"RTN","BMXRPC3",68,0)
;Returns 0 if no Windows user found
"RTN","BMXRPC3",69,0)
;
"RTN","BMXRPC3",70,0)
N BMXIEN,BMXNOD,BMXDUZ
"RTN","BMXRPC3",71,0)
I BMXWINID="" Q 0
"RTN","BMXRPC3",72,0)
S BMXIEN=$O(^BMXUSER("B",BMXWINID,0))
"RTN","BMXRPC3",73,0)
I '+BMXIEN Q 0
"RTN","BMXRPC3",74,0)
S BMXNOD=$G(^BMXUSER(BMXIEN,0))
"RTN","BMXRPC3",75,0)
S BMXDUZ=$P(BMXNOD,U,2)
"RTN","BMXRPC3",76,0)
Q BMXDUZ
"RTN","BMXRPC3",77,0)
;
"RTN","BMXRPC3",78,0)
NTUSETD(BMXY,BMXNTNAME) ;EP
"RTN","BMXRPC3",79,0)
;Entry point for debugging
"RTN","BMXRPC3",80,0)
;
"RTN","BMXRPC3",81,0)
D DEBUG^%Serenji("NTUSET^BMXRPC3(.BMXY,BMXNTNAME)")
"RTN","BMXRPC3",82,0)
Q
"RTN","BMXRPC3",83,0)
;
"RTN","BMXRPC3",84,0)
NTUSET(BMXY,BMXNTNAME) ;EP
"RTN","BMXRPC3",85,0)
;Sets NEW PERSON map entry for Windows Identity BMXNTNAME
"RTN","BMXRPC3",86,0)
;Returns ERRORID 0 if all ok
"RTN","BMXRPC3",87,0)
;Called by RPC BMXNetSetUser
"RTN","BMXRPC3",88,0)
;
"RTN","BMXRPC3",89,0)
;
"RTN","BMXRPC3",90,0)
N BMXI,BMXNTID,BMXFDA,BMXF,BMXIEN,BMXMSG,BMXAPPTID
"RTN","BMXRPC3",91,0)
S BMXI=0
"RTN","BMXRPC3",92,0)
S BMXY="^BMXTMP("_$J_")"
"RTN","BMXRPC3",93,0)
S X="NTUET^BMXRPC3",@^%ZOSF("TRAP")
"RTN","BMXRPC3",94,0)
S BMXI=BMXI+1
"RTN","BMXRPC3",95,0)
; Quit with error if no DUZ exists
"RTN","BMXRPC3",96,0)
I '+$G(DUZ) D NTUERR(BMXI,500) Q
"RTN","BMXRPC3",97,0)
; Create entry or file in existing entry in BMX USER
"RTN","BMXRPC3",98,0)
I $D(^BMXUSER("B",BMXNTNAME)) S BMXF="?1,"
"RTN","BMXRPC3",99,0)
E S BMXF="+1,"
"RTN","BMXRPC3",100,0)
S BMXFDA(90093.1,BMXF,.01)=BMXNTNAME
"RTN","BMXRPC3",101,0)
S BMXFDA(90093.1,BMXF,.02)=$G(DUZ)
"RTN","BMXRPC3",102,0)
K BMXIEN,BMXMSG
"RTN","BMXRPC3",103,0)
D UPDATE^DIE("","BMXFDA","BMXIEN","BMXMSG")
"RTN","BMXRPC3",104,0)
S BMXAPPTID=+$G(BMXIEN(1))
"RTN","BMXRPC3",105,0)
S BMXI=BMXI+1
"RTN","BMXRPC3",106,0)
S ^BMXTMP($J,BMXI)=BMXAPPTID_"^0"
"RTN","BMXRPC3",107,0)
Q
"RTN","BMXRPC3",108,0)
;
"RTN","BMXRPC3",109,0)
NTUET ;EP
"RTN","BMXRPC3",110,0)
;Error trap from REGEVNT
"RTN","BMXRPC3",111,0)
;
"RTN","BMXRPC3",112,0)
I '$D(BMXI) N BMXI S BMXI=999
"RTN","BMXRPC3",113,0)
S BMXI=BMXI+1
"RTN","BMXRPC3",114,0)
D NTUERR(BMXI,99)
"RTN","BMXRPC3",115,0)
Q
"RTN","BMXRPC3",116,0)
;
"RTN","BMXRPC3",117,0)
NTUERR(BMXI,BMXERID) ;Error processing
"RTN","BMXRPC3",118,0)
S BMXI=BMXI+1
"RTN","BMXRPC3",119,0)
S ^BMXTMP($J,BMXI)="^"_BMXERID
"RTN","BMXRPC3",120,0)
Q
"RTN","BMXRPC3",121,0)
;
"RTN","BMXRPC3",122,0)
;
"RTN","BMXRPC3",123,0)
NTU1 ;S BMXCOL="T00030NT_DOMAIN^T00030NT_USERNAME^T00030RPMS_USERNAME"_$C(30)
"RTN","BMXRPC3",124,0)
;S RESULT=BMXCOL_BMXDOM_U_BMXNAM_U_BMXRNAM_$C(30)_$C(31)
"RTN","BMXRPC3",125,0)
Q
"RTN","BMXRPC3",126,0)
;
"RTN","BMXRPC3",127,0)
GETFC(BMXFACS,DUZ) ;Gets all facilities for a user
"RTN","BMXRPC3",128,0)
; Input DUZ - user IEN from the NEW PERSON FILE
"RTN","BMXRPC3",129,0)
; Output - Number of facilities;facility1 name&facility1 IEN;...facilityN&facilityN IEN
"RTN","BMXRPC3",130,0)
N BMXFN,BMXN
"RTN","BMXRPC3",131,0)
S BMXFN=0,BMXFACS=""
"RTN","BMXRPC3",132,0)
F BMXN=1:1 S BMXFN=$O(^VA(200,DUZ,2,BMXFN)) Q:BMXFN="" D
"RTN","BMXRPC3",133,0)
. S:BMXN>1 BMXFACS=BMXFACS_";" S BMXFACS=BMXFACS_$P(^DIC(4,BMXFN,0),U,1)_"&"_BMXFN
"RTN","BMXRPC3",134,0)
;//smh I BMXN=1 S BMXFN=$P(^AUTTSITE(1,0),U,1) D
"RTN","BMXRPC3",135,0)
;//smh . S BMXFACS=BMXFACS_$P(^DIC(4,BMXFN,0),U,1)_"&"_BMXFN
"RTN","BMXRPC3",136,0)
S BMXFACS=BMXN-(BMXN>1)_";"_BMXFACS
"RTN","BMXRPC3",137,0)
Q
"RTN","BMXRPC3",138,0)
;
"RTN","BMXRPC3",139,0)
GETFCRS(BMXY,BMXDUZ) ;Gets all facilities for a user - returns RECORDSET
"RTN","BMXRPC3",140,0)
;/mods by //smh for WV
"RTN","BMXRPC3",141,0)
N $ET S $ET="G ERFC^BMXRPC3"
"RTN","BMXRPC3",142,0)
N BMXFN ; Facility Number
"RTN","BMXRPC3",143,0)
S BMXDUZ=$TR(BMXDUZ,$C(13)) ; Strip CR,LF,tab
"RTN","BMXRPC3",144,0)
S BMXDUZ=$TR(BMXDUZ,$C(10))
"RTN","BMXRPC3",145,0)
S BMXDUZ=$TR(BMXDUZ,$C(9))
"RTN","BMXRPC3",146,0)
S BMXY="T00030FACILITY_NAME^T00030FACILITY_IEN^T00002DEFAULT"_$C(30)
"RTN","BMXRPC3",147,0)
S BMXFN=0
"RTN","BMXRPC3",148,0)
F S BMXFN=$O(^VA(200,BMXDUZ,2,BMXFN)) Q:'BMXFN D
"RTN","BMXRPC3",149,0)
. ; DD for ^VA(200,DUZ,2,DUZ(2)) is DUZ(2)^default. DUZ(2) is dinummed.
"RTN","BMXRPC3",150,0)
. S BMXY=BMXY_$P(^DIC(4,BMXFN,0),U,1)_U_^VA(200,BMXDUZ,2,BMXFN,0)_$C(30)
"RTN","BMXRPC3",151,0)
; Crazy line: if we have no results, then use kernel's DUZ(2) set
"RTN","BMXRPC3",152,0)
; during sign-on
"RTN","BMXRPC3",153,0)
I $L(BMXY,$C(30))<3 S BMXY=BMXY_$P(^DIC(4,DUZ(2),0),U,1)_U_DUZ(2)_$C(30)
"RTN","BMXRPC3",154,0)
S BMXY=BMXY_$C(31)
"RTN","BMXRPC3",155,0)
Q
"RTN","BMXRPC3",156,0)
;
"RTN","BMXRPC3",157,0)
SETFCRS(BMXY,BMXFAC) ;
"RTN","BMXRPC3",158,0)
;
"RTN","BMXRPC3",159,0)
;Sets DUZ(2) to value in BMXFAC
"RTN","BMXRPC3",160,0)
;Fails if BMXFAC is not one of the current user's divisions
"RTN","BMXRPC3",161,0)
;Returns Recordset
"RTN","BMXRPC3",162,0)
;
"RTN","BMXRPC3",163,0)
S X="ERFC^BMXRPC3",@^%ZOSF("TRAP")
"RTN","BMXRPC3",164,0)
S BMXY="T00030DUZ^T00030FACILITY_IEN^T00030FACILITY_NAME"_$C(30)
"RTN","BMXRPC3",165,0)
N BMXSUB,BMXFACN
"RTN","BMXRPC3",166,0)
I '+DUZ S BMXY=BMXY_0_"^"_0_"^"_0_$C(30)_$C(31) Q
"RTN","BMXRPC3",167,0)
I '+BMXFAC S BMXY=BMXY_DUZ_"^"_0_"^"_0_$C(30)_$C(31) Q
"RTN","BMXRPC3",168,0)
; //SMH Line below is incorrect. Facility valid if not in user profile
"RTN","BMXRPC3",169,0)
; if it is default kernel facility
"RTN","BMXRPC3",170,0)
; I '$D(^VA(200,DUZ,2,+BMXFAC)) S BMXY=BMXY_DUZ_"^"_0_"^"_0_$C(30)_$C(31) Q
"RTN","BMXRPC3",171,0)
S DUZ(2)=BMXFAC ;IHS/OIT/HMW SAC Exemption Applied For
"RTN","BMXRPC3",172,0)
S BMXFACN=$G(^DIC(4,+DUZ(2),0))
"RTN","BMXRPC3",173,0)
S BMXFACN=$P(BMXFACN,"^")
"RTN","BMXRPC3",174,0)
S BMXSUB="^VA(200,"_DUZ_",2,"
"RTN","BMXRPC3",175,0)
S ^DISV(DUZ,BMXSUB)=BMXFAC
"RTN","BMXRPC3",176,0)
S BMXY=BMXY_DUZ_"^"_BMXFAC_"^"_BMXFACN_$C(30)_$C(31)
"RTN","BMXRPC3",177,0)
Q
"RTN","BMXRPC3",178,0)
;
"RTN","BMXRPC3",179,0)
ERFC ;
"RTN","BMXRPC3",180,0)
D ^%ZTER
"RTN","BMXRPC3",181,0)
S BMXY=$G(BMXY)_0_"^"_0_$C(30)_$C(31) Q
"RTN","BMXRPC3",182,0)
Q
"RTN","BMXRPC3",183,0)
;
"RTN","BMXRPC3",184,0)
SETFC(BMXY,BMXFAC) ;
"RTN","BMXRPC3",185,0)
;Sets DUZ(2) to value in BMXFAC
"RTN","BMXRPC3",186,0)
;Fails if BMXFAC is not one of the current user's divisions
"RTN","BMXRPC3",187,0)
;Returns 1 if successful, 0 if failed
"RTN","BMXRPC3",188,0)
;
"RTN","BMXRPC3",189,0)
S BMXY=0
"RTN","BMXRPC3",190,0)
N BMXSUB
"RTN","BMXRPC3",191,0)
I '+DUZ S BMXY=0 Q
"RTN","BMXRPC3",192,0)
I '+BMXFAC S BMXY=0 Q
"RTN","BMXRPC3",193,0)
I '$D(^VA(200,DUZ,2,+BMXFAC)) S BMXY=0 Q
"RTN","BMXRPC3",194,0)
S DUZ(2)=BMXFAC ;IHS/OIT/HMW SAC Exemption Applied For
"RTN","BMXRPC3",195,0)
S BMXSUB="^VA(200,"_DUZ_",2,"
"RTN","BMXRPC3",196,0)
S ^DISV(DUZ,BMXSUB)=BMXFAC
"RTN","BMXRPC3",197,0)
S BMXY=1
"RTN","BMXRPC3",198,0)
Q
"RTN","BMXRPC3",199,0)
;
"RTN","BMXRPC3",200,0)
APSEC(BMXY,BMXKEY) ;EP
"RTN","BMXRPC3",201,0)
;Return IHSCD_SUCCEEDED (-1) if user has key BMXKEY
"RTN","BMXRPC3",202,0)
;OR if user has key XUPROGMODE
"RTN","BMXRPC3",203,0)
;Otherwise, returns IHSCD_FAILED (0)
"RTN","BMXRPC3",204,0)
N BMXIEN,BMXPROG,BMXPKEY
"RTN","BMXRPC3",205,0)
I '$G(DUZ) S BMXY=0 Q
"RTN","BMXRPC3",206,0)
I BMXKEY="" S BMXY=0 Q
"RTN","BMXRPC3",207,0)
;
"RTN","BMXRPC3",208,0)
;Test for programmer mode key
"RTN","BMXRPC3",209,0)
S BMXPROG=0
"RTN","BMXRPC3",210,0)
I $D(^DIC(19.1,"B","XUPROGMODE")) D
"RTN","BMXRPC3",211,0)
. S BMXPKEY=$O(^DIC(19.1,"B","XUPROGMODE",0))
"RTN","BMXRPC3",212,0)
. I '+BMXPKEY Q
"RTN","BMXRPC3",213,0)
. I '$D(^VA(200,DUZ,51,BMXPKEY,0)) Q
"RTN","BMXRPC3",214,0)
. S BMXPROG=1
"RTN","BMXRPC3",215,0)
I BMXPROG S BMXY=-1 Q
"RTN","BMXRPC3",216,0)
;
"RTN","BMXRPC3",217,0)
I '$D(^DIC(19.1,"B",BMXKEY)) S BMXY=0 Q
"RTN","BMXRPC3",218,0)
S BMXIEN=$O(^DIC(19.1,"B",BMXKEY,0))
"RTN","BMXRPC3",219,0)
I '+BMXIEN S BMXY=0 Q
"RTN","BMXRPC3",220,0)
I '$D(^VA(200,DUZ,51,BMXIEN,0)) S BMXY=0 Q
"RTN","BMXRPC3",221,0)
S BMXY=-1
"RTN","BMXRPC3",222,0)
Q
"RTN","BMXRPC3",223,0)
;
"RTN","BMXRPC3",224,0)
SIGCHK(BMXY,BMXSIG) ;EP
"RTN","BMXRPC3",225,0)
;Checks BMXSIG against hashed value in NEW PERSON
"RTN","BMXRPC3",226,0)
;Return IHSCD_SUCCEEDED (-1) if BMXSIG matches
"RTN","BMXRPC3",227,0)
;Otherwise, returns IHSCD_FAILED (0)
"RTN","BMXRPC3",228,0)
N X
"RTN","BMXRPC3",229,0)
S BMXY=0
"RTN","BMXRPC3",230,0)
I '$G(DUZ) Q
"RTN","BMXRPC3",231,0)
I '$D(^VA(200,DUZ,20)) Q ;TODO What if no signature?
"RTN","BMXRPC3",232,0)
S BMXHSH=$P(^VA(200,DUZ,20),U,4)
"RTN","BMXRPC3",233,0)
S X=$G(BMXSIG)
"RTN","BMXRPC3",234,0)
D HASH^XUSHSHP
"RTN","BMXRPC3",235,0)
I X=BMXHSH S BMXY=-1
"RTN","BMXRPC3",236,0)
Q
"RTN","BMXRPC4")
0^91^B28124037
"RTN","BMXRPC4",1,0)
BMXRPC4 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
"RTN","BMXRPC4",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXRPC4",3,0)
;
"RTN","BMXRPC4",4,0)
PTINFORS(BMXY,BMXIEN) ;EP Patient Info Recordset
"RTN","BMXRPC4",5,0)
;
"RTN","BMXRPC4",6,0)
N BMXDPT,BMXZ,BMXDLIM,BMXXX,BMXRET,BMXAGE,BMXNEXT,BMXSEX,BMXERR,BMXHRN
"RTN","BMXRPC4",7,0)
S BMXDLIM="^",BMXERR=""
"RTN","BMXRPC4",8,0)
S BMXRET="T00030NAME^T00030HRN^T00030SSN^D00030DOB^T00030IEN^T00020AGE^T00080NEXT_APPT^T00010SEX"_$C(30)
"RTN","BMXRPC4",9,0)
I '$D(DUZ(2)) S BMXY=BMXRET_$C(31)_"No DUZ2" Q
"RTN","BMXRPC4",10,0)
I +$G(DUZ) D
"RTN","BMXRPC4",11,0)
. S ^DISV(DUZ,"^AUPNPAT(")=BMXIEN
"RTN","BMXRPC4",12,0)
. S ^DISV(DUZ,"^DPT(")=BMXIEN
"RTN","BMXRPC4",13,0)
I '$D(^DPT(BMXIEN)) S BMXY=BMXRET_$C(31)_"No such patient" Q
"RTN","BMXRPC4",14,0)
S BMXDPT=$G(^DPT(BMXIEN,0))
"RTN","BMXRPC4",15,0)
S BMXZ=$P(BMXDPT,U) ;NAME
"RTN","BMXRPC4",16,0)
;S $P(BMXZ,BMXDLIM,2)=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART
"RTN","BMXRPC4",17,0)
S BMXHRN=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART
"RTN","BMXRPC4",18,0)
;I BMXHRN="" Q ;NO CHART AT THIS DUZ2
"RTN","BMXRPC4",19,0)
I $P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,3) S BMXHRN=BMXHRN_"(*)"
"RTN","BMXRPC4",20,0)
S $P(BMXZ,BMXDLIM,2)=BMXHRN
"RTN","BMXRPC4",21,0)
;
"RTN","BMXRPC4",22,0)
S $P(BMXZ,BMXDLIM,3)=$P(BMXDPT,U,9) ;SSN
"RTN","BMXRPC4",23,0)
S Y=$P(BMXDPT,U,3) X ^DD("DD")
"RTN","BMXRPC4",24,0)
S $P(BMXZ,BMXDLIM,4)=Y ;DOB
"RTN","BMXRPC4",25,0)
S $P(BMXZ,BMXDLIM,5)=BMXIEN
"RTN","BMXRPC4",26,0)
S BMXAGE=$$AGEF^BMXUTL1(BMXIEN)
"RTN","BMXRPC4",27,0)
S $P(BMXZ,BMXDLIM,6)=BMXAGE
"RTN","BMXRPC4",28,0)
S BMXNEXT=$$NEXTAPPT^BMXUTL2(BMXIEN)
"RTN","BMXRPC4",29,0)
S $P(BMXZ,BMXDLIM,7)=BMXNEXT
"RTN","BMXRPC4",30,0)
S BMXSEX=$$SEXW^BMXUTL1(BMXIEN)
"RTN","BMXRPC4",31,0)
S $P(BMXZ,BMXDLIM,8)=BMXSEX
"RTN","BMXRPC4",32,0)
S BMXRET=BMXRET_BMXZ
"RTN","BMXRPC4",33,0)
S BMXY=BMXRET_$C(30)_$C(31)_BMXERR
"RTN","BMXRPC4",34,0)
Q
"RTN","BMXRPC4",35,0)
;
"RTN","BMXRPC4",36,0)
PTLOOKRS(BMXY,BMXP,BMXC) ;EP Patient Lookup
"RTN","BMXRPC4",37,0)
;
"RTN","BMXRPC4",38,0)
;Find up to BMXC patients matching BMXP*
"RTN","BMXRPC4",39,0)
;Supports DOB Lookup, SSN Lookup
"RTN","BMXRPC4",40,0)
;
"RTN","BMXRPC4",41,0)
;S ^HW("PTLOOK","INPUT")=BMXP
"RTN","BMXRPC4",42,0)
;S ^HW("PTLOOK","DUZ2")=$G(DUZ(2))
"RTN","BMXRPC4",43,0)
S BMXP=$TR(BMXP,$C(13),"")
"RTN","BMXRPC4",44,0)
S BMXP=$TR(BMXP,$C(10),"")
"RTN","BMXRPC4",45,0)
S BMXP=$TR(BMXP,$C(9),"")
"RTN","BMXRPC4",46,0)
S:BMXC="" BMXC=10
"RTN","BMXRPC4",47,0)
N BMXHRN,BMXZ,BMXDLIM,BMXRET
"RTN","BMXRPC4",48,0)
S BMXDLIM="^"
"RTN","BMXRPC4",49,0)
S BMXRET="T00030NAME^T00030HRN^T00030SSN^D00030DOB^T00030IEN"_$C(30)
"RTN","BMXRPC4",50,0)
I '+$G(DUZ) S BMXY=BMXRET_$C(31) Q
"RTN","BMXRPC4",51,0)
I '$D(DUZ(2)) S BMXY=BMXRET_$C(31) Q
"RTN","BMXRPC4",52,0)
DOB ;DOB Lookup
"RTN","BMXRPC4",53,0)
I +DUZ(2),((BMXP?1.2N1"/"1.2N1"/"1.4N)!(BMXP?1.2N1" "1.2N1" "1.4N)!(BMXP?1.2N1"-"1.2N1"-"1.4N)) D S BMXY=BMXRET_$C(31) Q
"RTN","BMXRPC4",54,0)
. S X=BMXP S %DT="P" D ^%DT S BMXP=Y Q:'+Y
"RTN","BMXRPC4",55,0)
. Q:'$D(^DPT("ADOB",BMXP))
"RTN","BMXRPC4",56,0)
. S BMXIEN=0,BMXXX=1 F S BMXIEN=$O(^DPT("ADOB",BMXP,BMXIEN)) Q:'+BMXIEN D
"RTN","BMXRPC4",57,0)
. . Q:'$D(^DPT(BMXIEN,0))
"RTN","BMXRPC4",58,0)
. . S BMXDPT=$G(^DPT(BMXIEN,0))
"RTN","BMXRPC4",59,0)
. . S BMXZ=$P(BMXDPT,U) ;NAME
"RTN","BMXRPC4",60,0)
. . ;S $P(BMXZ,BMXDLIM,2)=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART
"RTN","BMXRPC4",61,0)
. . S BMXHRN=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART
"RTN","BMXRPC4",62,0)
. . I BMXHRN="" Q ;NO CHART AT THIS DUZ2
"RTN","BMXRPC4",63,0)
. . I $P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,3) S BMXHRN=BMXHRN_"(*)"
"RTN","BMXRPC4",64,0)
. . S $P(BMXZ,BMXDLIM,2)=BMXHRN
"RTN","BMXRPC4",65,0)
. . ;
"RTN","BMXRPC4",66,0)
. . S $P(BMXZ,BMXDLIM,3)=$P(BMXDPT,U,9) ;SSN
"RTN","BMXRPC4",67,0)
. . S Y=$P(BMXDPT,U,3) X ^DD("DD")
"RTN","BMXRPC4",68,0)
. . S $P(BMXZ,BMXDLIM,4)=Y ;DOB
"RTN","BMXRPC4",69,0)
. . S $P(BMXZ,BMXDLIM,5)=BMXIEN
"RTN","BMXRPC4",70,0)
. . S BMXXX=BMXXX+1
"RTN","BMXRPC4",71,0)
. . ;S $P(BMXRET,$C(30),BMXXX)=BMXZ
"RTN","BMXRPC4",72,0)
. . S BMXRET=BMXRET_BMXZ_$C(30)
"RTN","BMXRPC4",73,0)
. . Q
"RTN","BMXRPC4",74,0)
. Q
"RTN","BMXRPC4",75,0)
;
"RTN","BMXRPC4",76,0)
;Chart# Lookup
"RTN","BMXRPC4",77,0)
I +DUZ(2),BMXP]"",$D(^AUPNPAT("D",BMXP)) D S BMXY=BMXRET_$C(30)_$C(31) Q
"RTN","BMXRPC4",78,0)
. S BMXIEN=0 F S BMXIEN=$O(^AUPNPAT("D",BMXP,BMXIEN)) Q:'+BMXIEN I $D(^AUPNPAT("D",BMXP,BMXIEN,DUZ(2))) D Q
"RTN","BMXRPC4",79,0)
. . Q:'$D(^DPT(BMXIEN,0))
"RTN","BMXRPC4",80,0)
. . S BMXDPT=$G(^DPT(BMXIEN,0))
"RTN","BMXRPC4",81,0)
. . S BMXZ=$P(BMXDPT,U) ;NAME
"RTN","BMXRPC4",82,0)
. . ;S $P(BMXZ,BMXDLIM,2)=BMXP ;CHART
"RTN","BMXRPC4",83,0)
. . S BMXHRN=BMXP ;CHART
"RTN","BMXRPC4",84,0)
. . I $D(^AUPNPAT(BMXIEN,41,DUZ(2),0)),$P(^(0),U,3) S BMXHRN=BMXHRN_"(*)"
"RTN","BMXRPC4",85,0)
. . S $P(BMXZ,BMXDLIM,2)=BMXHRN
"RTN","BMXRPC4",86,0)
. . S $P(BMXZ,BMXDLIM,3)=$P(BMXDPT,U,9) ;SSN
"RTN","BMXRPC4",87,0)
. . S Y=$P(BMXDPT,U,3) X ^DD("DD")
"RTN","BMXRPC4",88,0)
. . S $P(BMXZ,BMXDLIM,4)=Y ;DOB
"RTN","BMXRPC4",89,0)
. . S $P(BMXZ,BMXDLIM,5)=BMXIEN
"RTN","BMXRPC4",90,0)
. . S $P(BMXRET,$C(30),2)=BMXZ
"RTN","BMXRPC4",91,0)
. . Q
"RTN","BMXRPC4",92,0)
. Q
"RTN","BMXRPC4",93,0)
;
"RTN","BMXRPC4",94,0)
;SSN Lookup
"RTN","BMXRPC4",95,0)
I (BMXP?9N)!(BMXP?3N1"-"2N1"-"4N),$D(^DPT("SSN",BMXP)) D S BMXY=BMXRET_$C(30)_$C(31) Q
"RTN","BMXRPC4",96,0)
. S BMXIEN=0 F S BMXIEN=$O(^DPT("SSN",BMXP,BMXIEN)) Q:'+BMXIEN D Q
"RTN","BMXRPC4",97,0)
. . Q:'$D(^DPT(BMXIEN,0))
"RTN","BMXRPC4",98,0)
. . S BMXDPT=$G(^DPT(BMXIEN,0))
"RTN","BMXRPC4",99,0)
. . S BMXZ=$P(BMXDPT,U) ;NAME
"RTN","BMXRPC4",100,0)
. . S BMXHRN=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART
"RTN","BMXRPC4",101,0)
. . I BMXHRN="" Q ;NO CHART AT THIS DUZ2
"RTN","BMXRPC4",102,0)
. . I $P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,3) S BMXHRN=BMXHRN_"(*)"
"RTN","BMXRPC4",103,0)
. . S $P(BMXZ,BMXDLIM,2)=BMXHRN
"RTN","BMXRPC4",104,0)
. . S $P(BMXZ,BMXDLIM,3)=$P(BMXDPT,U,9) ;SSN
"RTN","BMXRPC4",105,0)
. . S Y=$P(BMXDPT,U,3) X ^DD("DD")
"RTN","BMXRPC4",106,0)
. . S $P(BMXZ,BMXDLIM,4)=Y ;DOB
"RTN","BMXRPC4",107,0)
. . S $P(BMXZ,BMXDLIM,5)=BMXIEN
"RTN","BMXRPC4",108,0)
. . S $P(BMXRET,$C(30),2)=BMXZ
"RTN","BMXRPC4",109,0)
. . Q
"RTN","BMXRPC4",110,0)
. Q
"RTN","BMXRPC4",111,0)
;
"RTN","BMXRPC4",112,0)
S BMXFILE=9000001
"RTN","BMXRPC4",113,0)
S BMXIENS=""
"RTN","BMXRPC4",114,0)
S BMXFIELDS=".01"
"RTN","BMXRPC4",115,0)
S BMXFLAGS="M"
"RTN","BMXRPC4",116,0)
S BMXVALUE=BMXP
"RTN","BMXRPC4",117,0)
S BMXNUMBER=BMXC
"RTN","BMXRPC4",118,0)
S BMXINDEXES=""
"RTN","BMXRPC4",119,0)
S BMXSCREEN=$S(+DUZ(2):"I $D(^AUPNPAT(Y,41,DUZ(2),0))",1:"")
"RTN","BMXRPC4",120,0)
;I BMXSCREEN]"" S DIC("S")=BMXSCREEN
"RTN","BMXRPC4",121,0)
;S BMXSCREEN="I 0"
"RTN","BMXRPC4",122,0)
S BMXIDEN=""
"RTN","BMXRPC4",123,0)
S BMXTARG="BMXRSLT"
"RTN","BMXRPC4",124,0)
S BMXMSG=""
"RTN","BMXRPC4",125,0)
D FIND^DIC(BMXFILE,BMXIENS,BMXFIELDS,BMXFLAGS,BMXVALUE,BMXNUMBER,BMXINDEXES,BMXSCREEN,BMXIDEN,BMXTARG,BMXMSG)
"RTN","BMXRPC4",126,0)
;S BMXRET=""
"RTN","BMXRPC4",127,0)
;B
"RTN","BMXRPC4",128,0)
I '+$G(BMXRSLT("DILIST",0)) S BMXY=BMXRET_$C(31) Q
"RTN","BMXRPC4",129,0)
F BMXX=1:1:$P(BMXRSLT("DILIST",0),U) D
"RTN","BMXRPC4",130,0)
. ;B
"RTN","BMXRPC4",131,0)
. S BMXIEN=BMXRSLT("DILIST",2,BMXX)
"RTN","BMXRPC4",132,0)
. S BMXZ=BMXRSLT("DILIST","ID",BMXX,.01) ;NAME
"RTN","BMXRPC4",133,0)
. ;S $P(BMXZ,BMXDLIM,2)=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART
"RTN","BMXRPC4",134,0)
. S BMXHRN=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART
"RTN","BMXRPC4",135,0)
. I BMXHRN="" Q ;NO CHART AT THIS DUZ2
"RTN","BMXRPC4",136,0)
. I $P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,3) S BMXHRN=BMXHRN_"(*)"
"RTN","BMXRPC4",137,0)
. S $P(BMXZ,BMXDLIM,2)=BMXHRN
"RTN","BMXRPC4",138,0)
. S BMXDPT=$G(^DPT(BMXIEN,0))
"RTN","BMXRPC4",139,0)
. S $P(BMXZ,BMXDLIM,3)=$P(BMXDPT,U,9) ;SSN
"RTN","BMXRPC4",140,0)
. S Y=$P(BMXDPT,U,3) X ^DD("DD")
"RTN","BMXRPC4",141,0)
. S $P(BMXZ,BMXDLIM,4)=Y ;DOB
"RTN","BMXRPC4",142,0)
. S $P(BMXZ,BMXDLIM,5)=BMXIEN
"RTN","BMXRPC4",143,0)
. S $P(BMXRET,$C(30),BMXX+1)=BMXZ
"RTN","BMXRPC4",144,0)
. Q
"RTN","BMXRPC4",145,0)
;K BMXRSLT
"RTN","BMXRPC4",146,0)
S BMXY=BMXRET_$C(30)_$C(31)
"RTN","BMXRPC4",147,0)
Q
"RTN","BMXRPC4",148,0)
ZZZ ;
"RTN","BMXRPC5")
0^92^B15030574
"RTN","BMXRPC5",1,0)
BMXRPC5 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
"RTN","BMXRPC5",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXRPC5",3,0)
;
"RTN","BMXRPC5",4,0)
;Stolen from Mike Remillard. If it doesn't work, it's his fault.
"RTN","BMXRPC5",5,0)
HS(BMXGBL,BMXDFN,BMXTYPE,BMXRDL,BMXFDL) ;EP
"RTN","BMXRPC5",6,0)
;---> Return patient's Health Summary in global array, ^BMXTEMP($J,"HS"
"RTN","BMXRPC5",7,0)
;---> Lines delimited by BMXRDL
"RTN","BMXRPC5",8,0)
;---> File delimited by BMXFDL
"RTN","BMXRPC5",9,0)
;---> Called by RPC: BMX HEALTH SUMMARY
"RTN","BMXRPC5",10,0)
;---> Parameters:
"RTN","BMXRPC5",11,0)
; 1 - BMXGBL (ret) Name of result global containing patient's
"RTN","BMXRPC5",12,0)
; Health Summary, passed to Broker.
"RTN","BMXRPC5",13,0)
; 2 - BMXDFN (req) DFN of patient.
"RTN","BMXRPC5",14,0)
;
"RTN","BMXRPC5",15,0)
;---> Delimiter to pass error with result to GUI.
"RTN","BMXRPC5",16,0)
N BMX30,BMX31,BMXERR,X
"RTN","BMXRPC5",17,0)
;S BMX30=$C(30),BMX31=$C(31)_$C(31)
"RTN","BMXRPC5",18,0)
S BMX30=$G(BMXRDL)
"RTN","BMXRPC5",19,0)
I BMX30="" S BMX30=$C(13)_$C(10)
"RTN","BMXRPC5",20,0)
S BMX31=$G(BMXFDL)
"RTN","BMXRPC5",21,0)
S BMXGBL="^BMXTEMP("_$J_",""HS"")",BMXERR=""
"RTN","BMXRPC5",22,0)
K ^BMXTEMP($J,"HS")
"RTN","BMXRPC5",23,0)
;
"RTN","BMXRPC5",24,0)
N BMXPATH
"RTN","BMXRPC5",25,0)
;---> Should get path from a Site Parameter. For now, use MSM default.
"RTN","BMXRPC5",26,0)
S BMXPATH="/usr/spool/uucppublic/"
"RTN","BMXRPC5",27,0)
;S BMXPATH="C:\MSM\" ;TODO: Change to site parameter
"RTN","BMXRPC5",28,0)
;--->Flag to test whether running as broker job:
"RTN","BMXRPC5",29,0)
N BMXSOCK
"RTN","BMXRPC5",30,0)
S BMXSOCK=0
"RTN","BMXRPC5",31,0)
;I $I=56 S BMXSOCK=1
"RTN","BMXRPC5",32,0)
;
"RTN","BMXRPC5",33,0)
;---> If DFN not supplied, set Error Code and quit.
"RTN","BMXRPC5",34,0)
I '$G(BMXDFN) D Q
"RTN","BMXRPC5",35,0)
. S BMXERR="No Patient DFN" S ^BMXTEMP($J,"HS",I)=BMX31_BMXERR
"RTN","BMXRPC5",36,0)
;
"RTN","BMXRPC5",37,0)
;---> If patient does not exist, set Error Code and quit.
"RTN","BMXRPC5",38,0)
I '$D(^AUPNPAT(BMXDFN,0)) D Q
"RTN","BMXRPC5",39,0)
. S BMXERR="Patient DFN does not exist" S ^BMXTEMP($J,"HS",I)=BMX31_BMXERR
"RTN","BMXRPC5",40,0)
;
"RTN","BMXRPC5",41,0)
N APCHSPAT,APCHSTYP
"RTN","BMXRPC5",42,0)
S APCHSPAT=BMXDFN
"RTN","BMXRPC5",43,0)
S APCHSTYP=$G(BMXTYPE)
"RTN","BMXRPC5",44,0)
S:'+APCHSTYP APCHSTYP=7
"RTN","BMXRPC5",45,0)
;S APCHSTYP=9
"RTN","BMXRPC5",46,0)
;---> Doesn't work from Device 56.
"RTN","BMXRPC5",47,0)
;D GUIR^XBLM("EN^APCHS","^TMP(""BMXHS"",$J,")
"RTN","BMXRPC5",48,0)
;
"RTN","BMXRPC5",49,0)
;---> Generate a host file name.
"RTN","BMXRPC5",50,0)
N BMXFN S BMXFN="XB"_$J
"RTN","BMXRPC5",51,0)
;
"RTN","BMXRPC5",52,0)
D
"RTN","BMXRPC5",53,0)
.;---> Important to preserve IO variables for when $I returns to 56.
"RTN","BMXRPC5",54,0)
.N IO,IOBS,IOF,IOHG,IOM,ION,IOPAR,IOS,IOSL,IOST,IOT,IOUPAR,IOXY
"RTN","BMXRPC5",55,0)
.;
"RTN","BMXRPC5",56,0)
.;---> Open host file to receive legacy code display.
"RTN","BMXRPC5",57,0)
.S Y=$$OPEN^%ZISH(BMXPATH,BMXFN,"W")
"RTN","BMXRPC5",58,0)
.;O 51:(BMXPATH_BMXFN:"W")
"RTN","BMXRPC5",59,0)
.;S IO=51,IOST="P-OTHER80"
"RTN","BMXRPC5",60,0)
.;K ^HW("HS")
"RTN","BMXRPC5",61,0)
.;S ^HW("HS","IOST")=$G(IOST)
"RTN","BMXRPC5",62,0)
.;S ^HW("HS","IO")=$G(IO)
"RTN","BMXRPC5",63,0)
.;
"RTN","BMXRPC5",64,0)
.;---> Call to legacy code for Health Summary display.
"RTN","BMXRPC5",65,0)
.S IOSL=999,IOM=80
"RTN","BMXRPC5",66,0)
.D EN^APCHS
"RTN","BMXRPC5",67,0)
.;---> Write End of File (EOF) marker.
"RTN","BMXRPC5",68,0)
.W $C(9)
"RTN","BMXRPC5",69,0)
.;
"RTN","BMXRPC5",70,0)
.;---> %ZISC doesn't close Device 51 when called from TCPIP socket?
"RTN","BMXRPC5",71,0)
.;D ^%ZISC
"RTN","BMXRPC5",72,0)
.;---> Buffer won't write out to file until the device is closed
"RTN","BMXRPC5",73,0)
.;---> or the buffer is flushed by some other command.
"RTN","BMXRPC5",74,0)
.;---> At this point, host file exists but has 0 bytes.
"RTN","BMXRPC5",75,0)
.;C 51
"RTN","BMXRPC5",76,0)
.;---> Now host file contains legacy code display data.
"RTN","BMXRPC5",77,0)
.;
"RTN","BMXRPC5",78,0)
.;---> For some reason %ZISH cannot open the host file a second time.
"RTN","BMXRPC5",79,0)
.;S Y=$$OPEN^%ZISH(BMXPATH,BMXFN,"R")
"RTN","BMXRPC5",80,0)
.;O 51:(BMXPATH_BMXFN:"R")
"RTN","BMXRPC5",81,0)
.U 51
"RTN","BMXRPC5",82,0)
.;
"RTN","BMXRPC5",83,0)
.;---> Read in the host file.
"RTN","BMXRPC5",84,0)
.D
"RTN","BMXRPC5",85,0)
..;---> Stop reading Host File if line contains EOF $C(9).
"RTN","BMXRPC5",86,0)
..;N I,Y F I=1:1 R Y Q:Y[$C(9) S ^TMP("BMXHS",$J,I)=Y
"RTN","BMXRPC5",87,0)
.;
"RTN","BMXRPC5",88,0)
.;---> %ZISC doesn't close Device 51 when called from TCPIP socket?
"RTN","BMXRPC5",89,0)
.;D ^%ZISC
"RTN","BMXRPC5",90,0)
.;C 51
"RTN","BMXRPC5",91,0)
;
"RTN","BMXRPC5",92,0)
;---> At this point $I=1. The job has "forgotten" its $I, even
"RTN","BMXRPC5",93,0)
;---> though %SS shows 56 as the current device. $I=1 causes a
"RTN","BMXRPC5",94,0)
;---> <NOPEN> at CAPI+10^XWBBRK2. A simple USE 56 command
"RTN","BMXRPC5",95,0)
;---> appears to "remind" the job its $I is 56, and it works.
"RTN","BMXRPC5",96,0)
;---> Possibly this is something %ZISC ordinarily does.
"RTN","BMXRPC5",97,0)
I BMXSOCK U 56
"RTN","BMXRPC5",98,0)
;U 56
"RTN","BMXRPC5",99,0)
;
"RTN","BMXRPC5",100,0)
;---> Copy Health Summary to global array for passing back to GUI.
"RTN","BMXRPC5",101,0)
N I,N,U,X S U="^"
"RTN","BMXRPC5",102,0)
S N=0
"RTN","BMXRPC5",103,0)
F I=1:1 S N=$O(^TMP("BMXHS",$J,N)) Q:'N D
"RTN","BMXRPC5",104,0)
.;---> Set null lines (line breaks) equal to one space, so that
"RTN","BMXRPC5",105,0)
.;---> Windows reader will quit only at the final "null" line.
"RTN","BMXRPC5",106,0)
.S X=^TMP("BMXHS",$J,N) S:X="" X=" "
"RTN","BMXRPC5",107,0)
.S ^BMXTEMP($J,"HS",I)=X_BMX30
"RTN","BMXRPC5",108,0)
;
"RTN","BMXRPC5",109,0)
;---> If no Health Summary produced, report it as an error.
"RTN","BMXRPC5",110,0)
D:'$O(^BMXTEMP($J,"HS",0))
"RTN","BMXRPC5",111,0)
. S BMXERR="No Health Summary produced" S ^BMXTEMP($J,"HS",I)=BMX31_BMXERR
"RTN","BMXRPC5",112,0)
;
"RTN","BMXRPC5",113,0)
;---> Tack on Error Delimiter and any error.
"RTN","BMXRPC5",114,0)
S ^BMXTEMP($J,"HS",I)=BMX31_BMXERR
"RTN","BMXRPC5",115,0)
;
"RTN","BMXRPC5",116,0)
;---> Delete host file.
"RTN","BMXRPC5",117,0)
;---> This doesn't work.
"RTN","BMXRPC5",118,0)
S Y=$$DEL^%ZISH(BMXPATH,BMXFN)
"RTN","BMXRPC5",119,0)
;---> Call system command.
"RTN","BMXRPC5",120,0)
;S ^MIKE(1)=BMXPATH
"RTN","BMXRPC5",121,0)
;S ^MIKE(2)=BMXFN
"RTN","BMXRPC5",122,0)
;S Y=$ZOS(2,BMXPATH_BMXFN)
"RTN","BMXRPC5",123,0)
K ^TMP("BMXHS",$J)
"RTN","BMXRPC5",124,0)
Q
"RTN","BMXRPC6")
0^93^B14693179
"RTN","BMXRPC6",1,0)
BMXRPC6 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
"RTN","BMXRPC6",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXRPC6",3,0)
;
"RTN","BMXRPC6",4,0)
;
"RTN","BMXRPC6",5,0)
USRKEYRS(BMXY,BMXDUZ) ;EP - Returns recordset of user's keys
"RTN","BMXRPC6",6,0)
;
"RTN","BMXRPC6",7,0)
N BMXDPT,BMXZ,BMXDLIM,BMXXX,BMXRET,BMXAGE,BMXNEXT,BMXSEX,BMXERR
"RTN","BMXRPC6",8,0)
S BMXDLIM="^",BMXERR=""
"RTN","BMXRPC6",9,0)
S BMXRET="T00050KEY"_$C(30)
"RTN","BMXRPC6",10,0)
I '$D(DUZ(2)) S BMXY=BMXRET_$C(31)_"No DUZ2" Q
"RTN","BMXRPC6",11,0)
;Strip CRLFs from parameter
"RTN","BMXRPC6",12,0)
S BMXCRLF=$C(13)_$C(10)
"RTN","BMXRPC6",13,0)
S BMXDUZ=$TR(BMXDUZ,BMXCRLF,"")
"RTN","BMXRPC6",14,0)
I '$D(^VA(200,BMXDUZ)) S BMXY=BMXRET_$C(31)_"No such user" Q
"RTN","BMXRPC6",15,0)
S BMXK=0 F S BMXK=$O(^VA(200,BMXDUZ,51,BMXK)) Q:'+BMXK D
"RTN","BMXRPC6",16,0)
. S BMXKEY=$G(^VA(200,BMXDUZ,51,BMXK,0))
"RTN","BMXRPC6",17,0)
. Q:BMXKEY=""
"RTN","BMXRPC6",18,0)
. S BMXKEY=$P(BMXKEY,BMXDLIM)
"RTN","BMXRPC6",19,0)
. Q:'+BMXKEY
"RTN","BMXRPC6",20,0)
. Q:'$D(^DIC(19.1,BMXKEY,0))
"RTN","BMXRPC6",21,0)
. S BMXKEY=$P(^DIC(19.1,BMXKEY,0),BMXDLIM)
"RTN","BMXRPC6",22,0)
. Q:BMXKEY']""
"RTN","BMXRPC6",23,0)
. S BMXRET=BMXRET_BMXKEY_$C(30)
"RTN","BMXRPC6",24,0)
S BMXY=BMXRET_$C(30)_$C(31)_BMXERR
"RTN","BMXRPC6",25,0)
Q
"RTN","BMXRPC6",26,0)
;
"RTN","BMXRPC6",27,0)
PDATA(BMXY,BMXP) ;-EP Returns patient demographics for pt with
"RTN","BMXRPC6",28,0)
;health record number BMXP at the current DUZ(2)
"RTN","BMXRPC6",29,0)
N BMXIEN,BMXDUZ2,BMXSQL
"RTN","BMXRPC6",30,0)
;Strip CR, LF, TAB, SPACE
"RTN","BMXRPC6",31,0)
S BMXP=$TR(BMXP,$C(13),"")
"RTN","BMXRPC6",32,0)
S BMXP=$TR(BMXP,$C(10),"")
"RTN","BMXRPC6",33,0)
S BMXP=$TR(BMXP,$C(9),"")
"RTN","BMXRPC6",34,0)
S BMXP=$TR(BMXP,$C(32),"")
"RTN","BMXRPC6",35,0)
S BMXDUZ2=$G(DUZ(2)),BMXDUZ2=+BMXDUZ2
"RTN","BMXRPC6",36,0)
S BMXIEN=0
"RTN","BMXRPC6",37,0)
I +BMXDUZ2 F S BMXIEN=$O(^AUPNPAT("D",BMXP,BMXIEN)) Q:'+BMXIEN I $D(^AUPNPAT("D",BMXP,BMXIEN,BMXDUZ2)) Q
"RTN","BMXRPC6",38,0)
S BMXSQL="SELECT NAME 'Name', DOB 'DateOfBirth', TRIBE_OF_MEMBERSHIP 'Tribe', MAILING_ADDRESS-STREET 'Street',"
"RTN","BMXRPC6",39,0)
S BMXSQL=BMXSQL_" MAILING_ADDRESS-CITY 'City', MAILING_ADDRESS-STATE 'State', MAILING_ADDRESS-ZIP 'Zip', HOME_PHONE 'HomePhone', OFFICE_PHONE 'WorkPhone' FROM PATIENT WHERE BMXIEN='"_+BMXIEN_"'"
"RTN","BMXRPC6",40,0)
D SQL^BMXSQL(.BMXY,BMXSQL)
"RTN","BMXRPC6",41,0)
S @BMXY@(.5)="T00015Chart^"
"RTN","BMXRPC6",42,0)
I $D(@BMXY@(10)) S @BMXY@(10)=BMXP_"^"_@BMXY@(10)
"RTN","BMXRPC6",43,0)
;
"RTN","BMXRPC6",44,0)
Q
"RTN","BMXRPC6",45,0)
;
"RTN","BMXRPC6",46,0)
PDEMOD(BMXY,BMXPAT,BMXCOUNT) ;EP
"RTN","BMXRPC6",47,0)
;Entry point for Serenji debugging
"RTN","BMXRPC6",48,0)
;
"RTN","BMXRPC6",49,0)
D DEBUG^%Serenji("PDEMO^BMXRPC6(.BMXY,BMXPAT,BMXCOUNT)")
"RTN","BMXRPC6",50,0)
Q
"RTN","BMXRPC6",51,0)
;
"RTN","BMXRPC6",52,0)
PDEMO(BMXY,BMXPAT,BMXCOUNT) ;EP
"RTN","BMXRPC6",53,0)
;This simple RPC demonstrates how to format data
"RTN","BMXRPC6",54,0)
;for the BMXNet ADO.NET data provider
"RTN","BMXRPC6",55,0)
;
"RTN","BMXRPC6",56,0)
;Returns a maximum of BMXCOUNT records from the
"RTN","BMXRPC6",57,0)
;VA PATIENT file whose names begin with BMXPAT
"RTN","BMXRPC6",58,0)
;
"RTN","BMXRPC6",59,0)
N BMXI,BMXD,BMXC,BMXNODE,BMXDOB
"RTN","BMXRPC6",60,0)
;
"RTN","BMXRPC6",61,0)
;When the VA BROKER calls this routine, BMXY is passed by reference
"RTN","BMXRPC6",62,0)
;We set BMXY to the value of the variable in which we will return
"RTN","BMXRPC6",63,0)
;our data:
"RTN","BMXRPC6",64,0)
;S BMXY="^TMP(""BMX"","_$J_")"
"RTN","BMXRPC6",65,0)
N BMXUID
"RTN","BMXRPC6",66,0)
S BMXUID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
"RTN","BMXRPC6",67,0)
S BMXY=$NA(^BMXTMP("BMXTEST",BMXUID))
"RTN","BMXRPC6",68,0)
K ^BMXTMP("BMXTEST",BMXUID)
"RTN","BMXRPC6",69,0)
;
"RTN","BMXRPC6",70,0)
;The first subnode of the data global contains the column header information
"RTN","BMXRPC6",71,0)
;in the form "TxxxxxCOLUMN1NAME^txxxxxCOLUMN2NAME"_$C(30)
"RTN","BMXRPC6",72,0)
;where T is the column data type and can be either T for text, I for numeric or D for date/time.
"RTN","BMXRPC6",73,0)
;xxxxx is the length of the column in characters:
"RTN","BMXRPC6",74,0)
;
"RTN","BMXRPC6",75,0)
S BMXI=0,BMXC=0
"RTN","BMXRPC6",76,0)
S ^BMXTMP("BMXTEST",BMXUID,BMXI)="T00030NAME^T00010SEX^D00020DOB"_$C(30)
"RTN","BMXRPC6",77,0)
;
"RTN","BMXRPC6",78,0)
;You MUST set an error trap:
"RTN","BMXRPC6",79,0)
S X="PDERR^BMXRPC6",@^%ZOSF("TRAP")
"RTN","BMXRPC6",80,0)
;
"RTN","BMXRPC6",81,0)
;Strip CR, LF, TAB, SPACE from BMXCOUNT parameter
"RTN","BMXRPC6",82,0)
S BMXCOUNT=$TR(BMXCOUNT,$C(13),"")
"RTN","BMXRPC6",83,0)
S BMXCOUNT=$TR(BMXCOUNT,$C(10),"")
"RTN","BMXRPC6",84,0)
S BMXCOUNT=$TR(BMXCOUNT,$C(9),"")
"RTN","BMXRPC6",85,0)
S BMXCOUNT=$TR(BMXCOUNT,$C(32),"")
"RTN","BMXRPC6",86,0)
;
"RTN","BMXRPC6",87,0)
;Iterate through the global and set the data nodes:
"RTN","BMXRPC6",88,0)
S:BMXPAT="" BMXPAT="A"
"RTN","BMXRPC6",89,0)
S BMXPAT=$O(^DPT("B",BMXPAT),-1)
"RTN","BMXRPC6",90,0)
S BMXD=0
"RTN","BMXRPC6",91,0)
F S BMXPAT=$O(^DPT("B",BMXPAT)) Q:BMXPAT="" S BMXD=$O(^DPT("B",BMXPAT,0)) I +BMXD S BMXC=BMXC+1 Q:(BMXCOUNT)&(BMXC>BMXCOUNT) D
"RTN","BMXRPC6",92,0)
. Q:'$D(^DPT(BMXD,0))
"RTN","BMXRPC6",93,0)
. S BMXI=BMXI+1
"RTN","BMXRPC6",94,0)
. S BMXNODE=^DPT(BMXD,0)
"RTN","BMXRPC6",95,0)
. ;Convert the DOB from FM date
"RTN","BMXRPC6",96,0)
. S Y=$P(BMXNODE,U,3)
"RTN","BMXRPC6",97,0)
. I +Y X ^DD("DD")
"RTN","BMXRPC6",98,0)
. S BMXDOB=Y
"RTN","BMXRPC6",99,0)
. ;The data node fields are in the same order as the column header, i.e. NAME^SEX^DOB
"RTN","BMXRPC6",100,0)
. ;and terminated with a $C(30)
"RTN","BMXRPC6",101,0)
. S ^BMXTMP("BMXTEST",BMXUID,BMXI)=$P(BMXNODE,U)_U_$P(BMXNODE,U,2)_U_BMXDOB_$C(30)
"RTN","BMXRPC6",102,0)
;
"RTN","BMXRPC6",103,0)
;After all the data nodes have been set, set the final node to $C(31) to indicate
"RTN","BMXRPC6",104,0)
;the end of the recordset
"RTN","BMXRPC6",105,0)
S BMXI=BMXI+1
"RTN","BMXRPC6",106,0)
S ^BMXTMP("BMXTEST",BMXUID,BMXI)=$C(31)
"RTN","BMXRPC6",107,0)
Q
"RTN","BMXRPC6",108,0)
;
"RTN","BMXRPC6",109,0)
PDERR ;Error trap for PDEMO
"RTN","BMXRPC6",110,0)
;
"RTN","BMXRPC6",111,0)
S ^BMXTMP("BMXTEST",BMXUID,BMXI+1)=$C(31)
"RTN","BMXRPC6",112,0)
Q
"RTN","BMXRPC7")
0^94^B40496291
"RTN","BMXRPC7",1,0)
BMXRPC7 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
"RTN","BMXRPC7",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXRPC7",3,0)
;
"RTN","BMXRPC7",4,0)
;
"RTN","BMXRPC7",5,0)
WINVAL(BMXRET,BMXWINID) ;EP
"RTN","BMXRPC7",6,0)
;Validates user based on Windows Identity
"RTN","BMXRPC7",7,0)
;
"RTN","BMXRPC7",8,0)
;Return R(0)=DUZ, R(1)=(0=OK, 1,2...=Can't sign-on for some reason)
"RTN","BMXRPC7",9,0)
; R(2)=verify needs changing, R(3)=Message, R(4)=0, R(5)=msg cnt, R(5+n)
"RTN","BMXRPC7",10,0)
; R(R(5)+6)=# div user must select from, R(R(5)+6+n)=div
"RTN","BMXRPC7",11,0)
I $$NEWERR^%ZTER N $ETRAP S $ETRAP=""
"RTN","BMXRPC7",12,0)
N X,BMXUSER,BMXUNOW,BMXUM,BMXUMSG,BMXVCOK K DUZ
"RTN","BMXRPC7",13,0)
S BMXRET(0)=0,BMXRET(5)=0,BMXUM=0,BMXUMSG=0
"RTN","BMXRPC7",14,0)
S DUZ=0,DUZ(0)="",BMXVCOK=0 D NOW ;IHS/OIT/HMW SAC Exemption Applied For
"RTN","BMXRPC7",15,0)
S BMXUMSG=$$INHIBIT() I BMXUMSG S BMXUM=1 G VAX ;Logon inhibited
"RTN","BMXRPC7",16,0)
;
"RTN","BMXRPC7",17,0)
S DUZ=$$WINUGET^BMXRPC3(BMXWINID) ;IHS/OIT/HMW SAC Exemption Applied For
"RTN","BMXRPC7",18,0)
I DUZ>0 D USER(DUZ)
"RTN","BMXRPC7",19,0)
S BMXUMSG=$$UVALID() G:BMXUMSG VAX
"RTN","BMXRPC7",20,0)
I DUZ>0 S BMXUMSG=$$POST(1)
"RTN","BMXRPC7",21,0)
VAX S:BMXUMSG>0 DUZ=0 D:DUZ>0 POST2
"RTN","BMXRPC7",22,0)
S BMXRET(0)=DUZ,BMXRET(1)=BMXUM,BMXRET(2)=BMXVCOK,BMXRET(3)=$S(BMXUMSG:$$TXT(BMXUMSG),1:""),BMXRET(4)=0
"RTN","BMXRPC7",23,0)
Q
"RTN","BMXRPC7",24,0)
;
"RTN","BMXRPC7",25,0)
NOW S U="^",BMXUNOW=$$NOW^XLFDT(),DT=$P(BMXUNOW,".")
"RTN","BMXRPC7",26,0)
Q
"RTN","BMXRPC7",27,0)
;
"RTN","BMXRPC7",28,0)
USER(IX) ;Build USER
"RTN","BMXRPC7",29,0)
S BMXUSER(0)=$G(^VA(200,+IX,0)),BMXUSER(1)=$G(^(.1))
"RTN","BMXRPC7",30,0)
Q
"RTN","BMXRPC7",31,0)
;
"RTN","BMXRPC7",32,0)
POST(CVC) ;Finish setup partition, I CVC don't log get
"RTN","BMXRPC7",33,0)
N X,BMXUM
"RTN","BMXRPC7",34,0)
K ^UTILITY($J),^TMP($J)
"RTN","BMXRPC7",35,0)
I '$D(USER(0)),DUZ D USER(DUZ)
"RTN","BMXRPC7",36,0)
S BMXUM=$$USER1A Q:BMXUM>0 BMXUM ;User can't sign on for some reason.
"RTN","BMXRPC7",37,0)
S BMXRET(5)=0 ;The next line sends the post sign-on msg
"RTN","BMXRPC7",38,0)
F BMXPT=1:1 Q:'$D(BMXUTEXT(BMXPT)) S BMXRET(5+BMXPT)=$E(BMXUTEXT(BMXPT),2,256),BMXRET(5)=BMXPT
"RTN","BMXRPC7",39,0)
S BMXRET(5)=0 ;This line stops the display of the msg. Remove this line to allow.
"RTN","BMXRPC7",40,0)
D:'$G(CVC) POST2
"RTN","BMXRPC7",41,0)
Q 0
"RTN","BMXRPC7",42,0)
POST2 D:'$D(BMXUNOW) NOW
"RTN","BMXRPC7",43,0)
D DUZ ;^XUS1A ;,SAVE^XUS1,LOG^XUS1,ABT^XQ12
"RTN","BMXRPC7",44,0)
K BMXUTEXT,BMXOPT,BMXUER ;XUEON,XUEOFF,XUTT
"RTN","BMXRPC7",45,0)
Q
"RTN","BMXRPC7",46,0)
;
"RTN","BMXRPC7",47,0)
DUZ ;Setup DUZ. SAC exemption applied for.
"RTN","BMXRPC7",48,0)
S:'$D(BMXUSER(0)) BMXUSER(0)=^VA(200,DUZ,0) D:$D(BMXOPT)[0 BMXOPT
"RTN","BMXRPC7",49,0)
S DUZ(0)=$P(BMXUSER(0),U,4),DUZ(1)="",DUZ("AUTO")=$P(BMXOPT,"^",6) ;IHS/OIT/HMW SAC Exemption Applied For
"RTN","BMXRPC7",50,0)
S DUZ(2)=$S($G(DUZ(2))>0:DUZ(2),1:+$P(BMXOPT,U,17)) ;IHS/OIT/HMW SAC Exemption Applied For
"RTN","BMXRPC7",51,0)
S X=$P($G(^DIC(4,DUZ(2),99)),U,5),DUZ("AG")=$S(X]"":X,1:$P(^XTV(8989.3,1,0),U,8))
"RTN","BMXRPC7",52,0)
S DUZ("BUF")=($P(BMXOPT,U,9)="Y"),DUZ("LANG")=$P(BMXOPT,U,7) ;IHS/OIT/HMW SAC Exemption Applied For
"RTN","BMXRPC7",53,0)
Q
"RTN","BMXRPC7",54,0)
;
"RTN","BMXRPC7",55,0)
USER1A() ;
"RTN","BMXRPC7",56,0)
N BMXPTB,BMXPTE,BMXPTT
"RTN","BMXRPC7",57,0)
S BMXUTEXT=0,DUZ(2)=0
"RTN","BMXRPC7",58,0)
F I=0:0 S I=$O(^XTV(8989.3,1,"POST",I)) Q:I'>0 D SET("!"_$G(^(I,0)))
"RTN","BMXRPC7",59,0)
D SET("!"),BMXOPT
"RTN","BMXRPC7",60,0)
S BMXPTH=$P($H,",",2)
"RTN","BMXRPC7",61,0)
D SET("!Good "_$S(BMXPTH<43200:"morning ",BMXPTH<61200:"afternoon ",1:"evening ")_$S($P(BMXUSER(1),U,4)]"":$P(BMXUSER(1),U,4),1:$P(BMXUSER(0),U,1)))
"RTN","BMXRPC7",62,0)
S BMXI1=$G(^VA(200,DUZ,1.1)),X=(+BMXI1_"0000")
"RTN","BMXRPC7",63,0)
I X D SET("! You last signed on "_$S(X\1=DT:"today",X\1+1=DT:"yesterday",1:$$DD(X))_" at "_$E(X,9,10)_":"_$E(X,11,12))
"RTN","BMXRPC7",64,0)
I $P(BMXI1,"^",2) S I=$P(BMXI1,"^",2) D SET("!There "_$S(I>1:"were ",1:"was ")_I_" unsuccessful attempt"_$S(I>1:"s",1:"")_" since you last signed on.")
"RTN","BMXRPC7",65,0)
I $P(BMXUSER(0),U,12),$$PROHIBIT(BMXPTH,$P(BMXUSER(0),U,12)) Q 17 ;Time frame
"RTN","BMXRPC7",66,0)
I +$P(BMXOPT,U,15) S BMXPT=$P(BMXOPT,U,15)-($H-BMXUSER(1)) I BMXPT<6,BMXPT>0 D SET("! Your Verify code will expire in "_BMXPT_" days")
"RTN","BMXRPC7",67,0)
S:$P(BMXOPT,"^",5) XUTT=1 S:'$D(DTIME) DTIME=$P(BMXOPT,U,10)
"RTN","BMXRPC7",68,0)
I ('X)!$P(BMXOPT,U,4) Q 0
"RTN","BMXRPC7",69,0)
Q 9
"RTN","BMXRPC7",70,0)
;
"RTN","BMXRPC7",71,0)
BMXOPT ;Build the BMXOPT string
"RTN","BMXRPC7",72,0)
N X,I
"RTN","BMXRPC7",73,0)
S:'$D(BMXOPT) BMXOPT=$G(^XTV(8989.3,1,"XUS"))
"RTN","BMXRPC7",74,0)
S X=$G(^VA(200,DUZ,200))
"RTN","BMXRPC7",75,0)
F I=4:1:7,9,10 I $P(X,U,I)]"" S $P(BMXOPT,"^",I)=$P(X,U,I)
"RTN","BMXRPC7",76,0)
Q
"RTN","BMXRPC7",77,0)
;
"RTN","BMXRPC7",78,0)
SET(V) ;Set into BMXUTEXT(BMXUTEXT)
"RTN","BMXRPC7",79,0)
S BMXUTEXT=$G(BMXUTEXT)+1,BMXUTEXT(BMXUTEXT)=V
"RTN","BMXRPC7",80,0)
Q
"RTN","BMXRPC7",81,0)
;
"RTN","BMXRPC7",82,0)
PROHIBIT(BMXPTT,BMXPTR) ;See if a prohibited time, (Current time, restrict range)
"RTN","BMXRPC7",83,0)
N XMSG,BMXPTB,BMXPTE
"RTN","BMXRPC7",84,0)
S BMXPTT=BMXPTT\60#60+(BMXPTT\3600*100),BMXPTB=$P(BMXPTR,"-",1),BMXPTE=$P(BMXPTR,"-",2)
"RTN","BMXRPC7",85,0)
S XMSG=$P($$FMTE^XLFDT(DT_"."_BMXPTB,"2P")," ",2,3)_" thru "_$P($$FMTE^XLFDT(DT_"."_BMXPTE,"2P")," ",2,3)
"RTN","BMXRPC7",86,0)
I $S(BMXPTE'<BMXPTB:BMXPTT'>BMXPTE&(BMXPTT'<BMXPTB),1:BMXPTT>BMXPTB!(BMXPTT<BMXPTE)) S BMXUM(0)=XMSG Q 1 ;No
"RTN","BMXRPC7",87,0)
D SET("!")
"RTN","BMXRPC7",88,0)
D SET("! Your access is restricted during this time frame "_XMSG)
"RTN","BMXRPC7",89,0)
Q 0
"RTN","BMXRPC7",90,0)
;
"RTN","BMXRPC7",91,0)
INHIBIT() ;Is Logon to this system Inhibited?
"RTN","BMXRPC7",92,0)
N BMXENV,BMXCI,BMXQVOL,BMXVOL
"RTN","BMXRPC7",93,0)
D GETENV^%ZOSV S U="^",BMXENV=Y,BMXCI=$P(Y,U,1),BMXQVOL=$P(Y,U,2)
"RTN","BMXRPC7",94,0)
S X=$O(^XTV(8989.3,1,4,"B",BMXQVOL,0)),BMXVOL=$S(X>0:^XTV(8989.3,1,4,X,0),1:BMXQVOL_"^y^1") S:$P(BMXVOL,U,6)="y" XRTL=BMXCI_","_BMXQVOL
"RTN","BMXRPC7",95,0)
;I '$D(BMXQVOL) Q 0
"RTN","BMXRPC7",96,0)
;I '$D(BMXVOL) Q 0
"RTN","BMXRPC7",97,0)
I $G(^%ZIS(14.5,"LOGON",BMXQVOL)) Q 1
"RTN","BMXRPC7",98,0)
I $D(^%ZOSF("ACTJ")) X ^("ACTJ") I $P(BMXVOL,U,3),($P(BMXVOL,U,3)'>Y) Q 2
"RTN","BMXRPC7",99,0)
Q 0
"RTN","BMXRPC7",100,0)
;
"RTN","BMXRPC7",101,0)
;
"RTN","BMXRPC7",102,0)
UVALID() ;EF. Is it valid for this user to sign on?
"RTN","BMXRPC7",103,0)
I '+$G(BMXWIN) Q 18
"RTN","BMXRPC7",104,0)
I DUZ'>0 Q 4
"RTN","BMXRPC7",105,0)
I $P(BMXUSER(0),U,11),$P(BMXUSER(0),U,11)'>DT Q 11 ;Access Terminated
"RTN","BMXRPC7",106,0)
I $P(BMXUSER(0),U,7) Q 5 ;Disuser flag set
"RTN","BMXRPC7",107,0)
Q 0
"RTN","BMXRPC7",108,0)
;
"RTN","BMXRPC7",109,0)
DD(Y) Q $S($E(Y,4,5):$P("Jan^Feb^Mar^Apr^May^Jun^Jul^Aug^Sep^Oct^Nov^Dec","^",+$E(Y,4,5))_" ",1:"")_$S($E(Y,6,7):+$E(Y,6,7)_",",1:"")_($E(Y,1,3)+1700)
"RTN","BMXRPC7",110,0)
Q
"RTN","BMXRPC7",111,0)
;
"RTN","BMXRPC7",112,0)
TXT(BMXPT) ;
"RTN","BMXRPC7",113,0)
S BMXPT=$T(ZZ+BMXPT)
"RTN","BMXRPC7",114,0)
S BMXPT=$P(BMXPT,";",4,9) I BMXPT["|" S BMXPT=$P(BMXPT,"|",1)_$G(BMXUM(0))_$P(BMXPT,"|",2)
"RTN","BMXRPC7",115,0)
Q BMXPT
"RTN","BMXRPC7",116,0)
ZZ ;;Halt;Error Messages
"RTN","BMXRPC7",117,0)
1 ;;1;Signons not currently allowed on this processor.
"RTN","BMXRPC7",118,0)
2 ;;1;Maximum number of users already signed on to this processor.
"RTN","BMXRPC7",119,0)
3 ;;1;This device has not been defined to the system -- contact system manager.
"RTN","BMXRPC7",120,0)
4 ;;0;Not a valid Windows Identity map value.
"RTN","BMXRPC7",121,0)
5 ;;0;No Access Allowed for this User.
"RTN","BMXRPC7",122,0)
6 ;;0;Invalid device password.
"RTN","BMXRPC7",123,0)
7 ;;0;Device locked due to too many invalid sign-on attempts.
"RTN","BMXRPC7",124,0)
8 ;;1;This device is out of service.
"RTN","BMXRPC7",125,0)
9 ;;0;*** MULTIPLE SIGN-ONS NOT ALLOWED ***
"RTN","BMXRPC7",126,0)
10 ;;1;You don't have access to this device!
"RTN","BMXRPC7",127,0)
11 ;;0;Your access code has been terminated. Please see your site manager!
"RTN","BMXRPC7",128,0)
12 ;;0;VERIFY CODE MUST be changed before continued use.
"RTN","BMXRPC7",129,0)
13 ;;1;This device may only be used outside of this time frame |
"RTN","BMXRPC7",130,0)
14 ;;0;'|' is not a valid UCI!
"RTN","BMXRPC7",131,0)
15 ;;0;'|' is not a valid program name!
"RTN","BMXRPC7",132,0)
16 ;;0;No PRIMARY MENU assigned to user or User is missing KEY to menu!
"RTN","BMXRPC7",133,0)
17 ;;0;Your access to the system is prohibited from |.
"RTN","BMXRPC7",134,0)
18 ;;0;Windows Integrated Security Not Allowed on this port.
"RTN","BMXRPC8")
0^95^B5993639
"RTN","BMXRPC8",1,0)
BMXRPC8 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; 12/7/10 8:12am
"RTN","BMXRPC8",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXRPC8",3,0)
;
"RTN","BMXRPC8",4,0)
;
"RTN","BMXRPC8",5,0)
BMXLOCKD(BMXY,BMXVAR,BMXINC,BMXTIME) ;EP
"RTN","BMXRPC8",6,0)
;Entry point for debugging
"RTN","BMXRPC8",7,0)
;
"RTN","BMXRPC8",8,0)
D DEBUG^%Serenji("BMXLOCK^BMXRPC8(.BMXY,BMXVAR,BMXINC,BMXTIME)")
"RTN","BMXRPC8",9,0)
Q
"RTN","BMXRPC8",10,0)
;
"RTN","BMXRPC8",11,0)
BMXLOCK(BMXY,BMXVAR,BMXINC,BMXTIME) ;EP
"RTN","BMXRPC8",12,0)
;Called by BMX LOCK rpc to lock variable BMXVAR
"RTN","BMXRPC8",13,0)
;If BMXVAR = "", argumentless lock is performed to release all locks
"RTN","BMXRPC8",14,0)
;BMXINC = increment lock if "+", decrement if "-"
"RTN","BMXRPC8",15,0)
;BMXTIME = lock timeout
"RTN","BMXRPC8",16,0)
;Returns 1 if lock successful, otherwise 0;
"RTN","BMXRPC8",17,0)
;
"RTN","BMXRPC8",18,0)
S X="ERR^BMXRPC8",@^%ZOSF("TRAP")
"RTN","BMXRPC8",19,0)
;
"RTN","BMXRPC8",20,0)
N BMXC
"RTN","BMXRPC8",21,0)
S:$E(BMXVAR,1,1)="~" BMXVAR="^"_$E(BMXVAR,2,$L(BMXVAR))
"RTN","BMXRPC8",22,0)
S:BMXTIME="" BMXTIME=0
"RTN","BMXRPC8",23,0)
I BMXVAR="" X "L" S BMXY=1 Q
"RTN","BMXRPC8",24,0)
S BMXC="L "
"RTN","BMXRPC8",25,0)
S BMXC=BMXC_$S(BMXINC="+":"+",BMXINC="-":"-",1:"")
"RTN","BMXRPC8",26,0)
S BMXC=BMXC_BMXVAR_":"_+BMXTIME
"RTN","BMXRPC8",27,0)
X BMXC
"RTN","BMXRPC8",28,0)
S BMXY=$T
"RTN","BMXRPC8",29,0)
Q
"RTN","BMXRPC8",30,0)
;
"RTN","BMXRPC8",31,0)
ERR ;Error processing
"RTN","BMXRPC8",32,0)
S BMXY=0
"RTN","BMXRPC8",33,0)
Q
"RTN","BMXRPC8",34,0)
;
"RTN","BMXRPC8",35,0)
BMXVERD(BMXY,BMXNS,BMXLOC) ;EP
"RTN","BMXRPC8",36,0)
;Entry point for debugging
"RTN","BMXRPC8",37,0)
;
"RTN","BMXRPC8",38,0)
D DEBUG^%Serenji("BMXVER^BMXRPC8(.BMXY,BMXNS,BMXLOC)")
"RTN","BMXRPC8",39,0)
Q
"RTN","BMXRPC8",40,0)
;
"RTN","BMXRPC8",41,0)
BMXVER(BMXY,BMXNS,BMXLOC) ;EP
"RTN","BMXRPC8",42,0)
;
"RTN","BMXRPC8",43,0)
;Called by BMX VERSION INFO rpc
"RTN","BMXRPC8",44,0)
;Returns recordset of version info for server components in namespace BMXNS.
"RTN","BMXRPC8",45,0)
;If BMXLOC is "", then the version info is assumed to be stored in piece 1-3 of
"RTN","BMXRPC8",46,0)
;^<BMXNS>APPL(1,0)
"RTN","BMXRPC8",47,0)
;
"RTN","BMXRPC8",48,0)
;TODO:
"RTN","BMXRPC8",49,0)
;BMXLOC, if not null, is either a global reference such that $P(@BMXLOC,U,1,3) returns
"RTN","BMXRPC8",50,0)
;MAJOR^MINOR^BUILD
"RTN","BMXRPC8",51,0)
;Or BMXLOC can be an extrinsic function call that returns MAJOR^MINOR^BUILD.
"RTN","BMXRPC8",52,0)
;
"RTN","BMXRPC8",53,0)
;The returned error field is either "" or contains a text error message.
"RTN","BMXRPC8",54,0)
;
"RTN","BMXRPC8",55,0)
N X,BMXI,BMXNOD,BMXDAT
"RTN","BMXRPC8",56,0)
;
"RTN","BMXRPC8",57,0)
S X="VETRAP^BMXRPC8",@^%ZOSF("TRAP")
"RTN","BMXRPC8",58,0)
S BMXI=0
"RTN","BMXRPC8",59,0)
K ^BMXTMP($J)
"RTN","BMXRPC8",60,0)
S BMXY="^BMXTMP("_$J_")"
"RTN","BMXRPC8",61,0)
S ^BMXTMP($J,BMXI)="T00030ERROR^T00030MAJOR_VERSION^T00030MINOR_VERSION^T00030BUILD"_$C(30)
"RTN","BMXRPC8",62,0)
S BMXI=BMXI+1
"RTN","BMXRPC8",63,0)
I BMXNS="" D VERR(BMXI,"BMXRPC8: Invalid Null Application Namespace") Q
"RTN","BMXRPC8",64,0)
S BMXNOD="^"_BMXNS_"APPL(1,0)"
"RTN","BMXRPC8",65,0)
S BMXDAT=$G(@BMXNOD)
"RTN","BMXRPC8",66,0)
I BMXNS="" D VERR(BMXI,"BMXRPC8: No version info for Application Namespace") Q
"RTN","BMXRPC8",67,0)
S ^BMXTMP($J,BMXI)="^"_$P(BMXDAT,U,1,3)_$C(30)
"RTN","BMXRPC8",68,0)
Q
"RTN","BMXRPC8",69,0)
;
"RTN","BMXRPC8",70,0)
;
"RTN","BMXRPC8",71,0)
VERR(BMXI,BMXERR) ;Error processing
"RTN","BMXRPC8",72,0)
S BMXI=BMXI+1
"RTN","BMXRPC8",73,0)
S ^BMXTMP($J,BMXI)=BMXERR_"^^^"_$C(30)
"RTN","BMXRPC8",74,0)
S BMXI=BMXI+1
"RTN","BMXRPC8",75,0)
S ^BMXTMP($J,BMXI)=$C(31)
"RTN","BMXRPC8",76,0)
Q
"RTN","BMXRPC8",77,0)
;
"RTN","BMXRPC8",78,0)
VETRAP ;EP Error trap entry
"RTN","BMXRPC8",79,0)
D ^%ZTER
"RTN","BMXRPC8",80,0)
I '$D(BMXI) N BMXI S BMXI=999999
"RTN","BMXRPC8",81,0)
S BMXI=BMXI+1
"RTN","BMXRPC8",82,0)
D VERR(BMXI,"BMXRPC8 Error: "_$G(%ZTERROR))
"RTN","BMXRPC8",83,0)
Q
"RTN","BMXRPC8",84,0)
;
"RTN","BMXRPC8",85,0)
IMHERE(BMXRES) ;EP
"RTN","BMXRPC8",86,0)
;Entry point for BMX IM HERE remote procedure
"RTN","BMXRPC8",87,0)
S BMXRES=1
"RTN","BMXRPC8",88,0)
Q
"RTN","BMXRPC8",89,0)
;
"RTN","BMXRPC9")
0^96^B45877662
"RTN","BMXRPC9",1,0)
BMXRPC9 ; IHS/OIT/HMW - RPC CALL FOR EXTENDED BROKER FUNCTIONALITY ;
"RTN","BMXRPC9",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXRPC9",3,0)
; UPDATE FILEMAN WITH AN ADO RECORD SET FROM A WINDOWS APPLICATION
"RTN","BMXRPC9",4,0)
;
"RTN","BMXRPC9",5,0)
;
"RTN","BMXRPC9",6,0)
;
"RTN","BMXRPC9",7,0)
SONLY(BMXY,BMXVAL) ;EP Schema Only
"RTN","BMXRPC9",8,0)
;
"RTN","BMXRPC9",9,0)
I BMXVAL="TRUE" S BMX("SCHEMA ONLY")=1
"RTN","BMXRPC9",10,0)
E S BMX("SCHEMA ONLY")=0
"RTN","BMXRPC9",11,0)
S BMXY=BMX("SCHEMA ONLY")
"RTN","BMXRPC9",12,0)
;
"RTN","BMXRPC9",13,0)
Q
"RTN","BMXRPC9",14,0)
;
"RTN","BMXRPC9",15,0)
TESTRPC(BMXGBL,BMXSQL) ;
"RTN","BMXRPC9",16,0)
;Test retrieval/update statement
"RTN","BMXRPC9",17,0)
;
"RTN","BMXRPC9",18,0)
N BMXI,BMXERR,BMXN,BMXNOD,BMXNAM,BMXSEX,BMXDOB,BMXFAC,BMXTMP,BMXJ
"RTN","BMXRPC9",19,0)
S X="ETRAP^BMXRPC9",@^%ZOSF("TRAP")
"RTN","BMXRPC9",20,0)
S BMXGBL="^BMXTMP("_$J_")",BMXERR="",U="^"
"RTN","BMXRPC9",21,0)
K ^BMXTMP($J)
"RTN","BMXRPC9",22,0)
S BMXI=0
"RTN","BMXRPC9",23,0)
;
"RTN","BMXRPC9",24,0)
;Old column info format:
"RTN","BMXRPC9",25,0)
;S BMXI=BMXI+1,^BMXTMP($J,BMXI)="I00010BMXIEN"_U_"D00010DOB"_U_"T00030LOCAL_FACLILITY"_U_"T00030NAME"_U_"T00010SEX"_$C(30)
"RTN","BMXRPC9",26,0)
;
"RTN","BMXRPC9",27,0)
;New column info format is @@@meta@@@KEYFIELD|FILE#
"RTN","BMXRPC9",28,0)
; For each field: ^FILE#|FIELD#|DATATYPE|LENGTH|FIELDNAME|READONLY|KEYFIELD|NULL ALLOWED
"RTN","BMXRPC9",29,0)
;S BMXI=BMXI+1,^BMXTMP($J,BMXI)="@@@meta@@@"
"RTN","BMXRPC9",30,0)
;S BMXI=BMXI+1,^BMXTMP($J,BMXI)="BMXIEN|2160010^"
"RTN","BMXRPC9",31,0)
;S BMXI=BMXI+1,^BMXTMP($J,BMXI)="2160010|.001|I|10|BMXIEN|TRUE|TRUE^"
"RTN","BMXRPC9",32,0)
;S BMXI=BMXI+1,^BMXTMP($J,BMXI)="2160010|.03|D|10|DOB|FALSE|FALSE^"
"RTN","BMXRPC9",33,0)
;S BMXI=BMXI+1,^BMXTMP($J,BMXI)="2160010|.04|T|60|LOCAL_FACILITY|FALSE|FALSE^"
"RTN","BMXRPC9",34,0)
;S BMXI=BMXI+1,^BMXTMP($J,BMXI)="2160010|.01|T|30|NAME|FALSE|FALSE^"
"RTN","BMXRPC9",35,0)
;S BMXI=BMXI+1,^BMXTMP($J,BMXI)="2160010|.02|T|10|SEX|FALSE|FALSE"
"RTN","BMXRPC9",36,0)
;S BMXI=BMXI+1,^BMXTMP($J,BMXI)=$C(30)
"RTN","BMXRPC9",37,0)
;
"RTN","BMXRPC9",38,0)
D SS^BMXADO(.BMXTMP,"","TEST1")
"RTN","BMXRPC9",39,0)
I $G(BMXTMP)=$C(30) D ERR(99,"SCHEMA GENERATION FAILED") Q
"RTN","BMXRPC9",40,0)
S BMXJ=0 F S BMXJ=$O(BMXTMP(BMXJ)) Q:'+BMXJ D
"RTN","BMXRPC9",41,0)
. S BMXI=BMXI+1
"RTN","BMXRPC9",42,0)
. S ^BMXTMP($J,BMXI)=BMXTMP(BMXJ)
"RTN","BMXRPC9",43,0)
I +$G(BMX("SCHEMA ONLY")) D Q
"RTN","BMXRPC9",44,0)
. S BMXI=BMXI+1
"RTN","BMXRPC9",45,0)
. S ^BMXTMP($J,BMXI)=$C(31)
"RTN","BMXRPC9",46,0)
. Q
"RTN","BMXRPC9",47,0)
S BMXN=0
"RTN","BMXRPC9",48,0)
F S BMXN=$O(^DIZ(2160010,BMXN)) Q:'+BMXN D
"RTN","BMXRPC9",49,0)
. Q:'$D(^DIZ(2160010,BMXN,0))
"RTN","BMXRPC9",50,0)
. S BMXNOD=^DIZ(2160010,BMXN,0)
"RTN","BMXRPC9",51,0)
. S BMXNAM=$P(BMXNOD,U)
"RTN","BMXRPC9",52,0)
. S BMXSEX=$P(BMXNOD,U,2)
"RTN","BMXRPC9",53,0)
. S BMXDOB=$P(BMXNOD,U,3)
"RTN","BMXRPC9",54,0)
. S Y=BMXDOB X ^DD("DD") S BMXDOB=Y
"RTN","BMXRPC9",55,0)
. S BMXFAC=$P(BMXNOD,U,4)
"RTN","BMXRPC9",56,0)
. S:+BMXFAC BMXFAC=$P($G(^DIC(4,BMXFAC,0)),U)
"RTN","BMXRPC9",57,0)
. S BMXI=BMXI+1
"RTN","BMXRPC9",58,0)
. S ^BMXTMP($J,BMXI)=BMXN_U_BMXDOB_U_BMXFAC_U_BMXNAM_U_BMXSEX_$C(30)
"RTN","BMXRPC9",59,0)
. Q
"RTN","BMXRPC9",60,0)
S BMXI=BMXI+1
"RTN","BMXRPC9",61,0)
S ^BMXTMP($J,BMXI)=$C(31)
"RTN","BMXRPC9",62,0)
Q
"RTN","BMXRPC9",63,0)
;
"RTN","BMXRPC9",64,0)
ERR(BMXID,BMXERR) ;Error processing
"RTN","BMXRPC9",65,0)
K ^BMXTMP($J)
"RTN","BMXRPC9",66,0)
S ^BMXTMP($J,0)="I00030ERRORID^T00030ERRORMSG"_$C(30)
"RTN","BMXRPC9",67,0)
S ^BMXTMP($J,1)=BMXID_"^"_BMXERR_$C(30)
"RTN","BMXRPC9",68,0)
S ^BMXTMP($J,2)=$C(31)
"RTN","BMXRPC9",69,0)
Q
"RTN","BMXRPC9",70,0)
;
"RTN","BMXRPC9",71,0)
ETRAP ;EP Error trap entry
"RTN","BMXRPC9",72,0)
D ^%ZTER
"RTN","BMXRPC9",73,0)
D ERR(99,"BMXRPC9 Error: "_$G(%ZTERROR))
"RTN","BMXRPC9",74,0)
Q
"RTN","BMXRPC9",75,0)
;
"RTN","BMXRPC9",76,0)
TEST N OUT S OUT="" D ADO(.OUT,2160010,"1",(".01|A,A"_$C(30)_".02|M"_$C(30)_".03|1/5/1946"_$C(30)_".04|SAN XAVIER"_$C(31))) W !,OUT
"RTN","BMXRPC9",77,0)
Q
"RTN","BMXRPC9",78,0)
;
"RTN","BMXRPC9",79,0)
ADOX(OUT,FILE,IEN,DATA) ;
"RTN","BMXRPC9",80,0)
;
"RTN","BMXRPC9",81,0)
D DEBUG^%Serenji("ADOX^BMXRPC9(.OUT,FILE,IEN,DATA)")
"RTN","BMXRPC9",82,0)
;
"RTN","BMXRPC9",83,0)
Q
"RTN","BMXRPC9",84,0)
;
"RTN","BMXRPC9",85,0)
ADO(OUT,FILE,IEN,DATA) ; RPC CALL: OUT = OUTBOUND MESSAGE, FILE = FILEMAN FILE NUMBER, IEN = FILE INTERNAL ENTRY NUMBER, DATA = DATA STRING
"RTN","BMXRPC9",86,0)
N OREF,CREF,DIC,DIE,DA,DR,X,Y,%,FLD,CNT,FNO,VAL,TFLG,DFLG,TOT,UFLG,XTFLG,GTFLG,GDFLG
"RTN","BMXRPC9",87,0)
S OUT="",FLD="",GTFLG=0,GDFLG=0
"RTN","BMXRPC9",88,0)
S IEN=$G(IEN)
"RTN","BMXRPC9",89,0)
I $E(IEN)="-" S IEN=$E(IEN,2,99),GDFLG=1 ; GLOBAL DELETE FLAG
"RTN","BMXRPC9",90,0)
I $E(IEN)="+" S IEN=$E(IEN,2,99),GTFLG=1 ; GLOBAL TRANSACTION FLAG, ROLLBACK IF ANY FIELD FAILS TO UPDATE
"RTN","BMXRPC9",91,0)
I IEN="Add"!(IEN="ADD") S IEN=""
"RTN","BMXRPC9",92,0)
I '$D(^DIC(+$G(FILE),0,"GL")) S OUT="Update cancelled. Invalid FILE number" Q
"RTN","BMXRPC9",93,0)
S OREF=^DIC(FILE,0,"GL") I '$L(OREF) S OUT="Update cancelled. Invalid file definition" Q
"RTN","BMXRPC9",94,0)
S CREF=$E(OREF,1,$L(OREF)-1) I $E(OREF,$L(OREF))="," S CREF=CREF_")" ; CONVERT OREF TO CREF
"RTN","BMXRPC9",95,0)
I IEN,'$D(@CREF@(IEN)) S OUT="Update cancelled. Invalid IEN" Q
"RTN","BMXRPC9",96,0)
I 'GDFLG,IEN,(DATA["-.01|"!(DATA[".01|@")) S GDFLG=1
"RTN","BMXRPC9",97,0)
I GDFLG,'IEN S OUT="Deletion cancelled. Missing IEN" Q
"RTN","BMXRPC9",98,0)
I GDFLG D DIK(OREF,IEN) S OUT="Record deleted|"_IEN Q
"RTN","BMXRPC9",99,0)
S UFLG=$S($G(IEN):"E",1:"A") ; UPDATE FLAG: ADD OR EDIT
"RTN","BMXRPC9",100,0)
I '$L($G(DATA)) S OUT="Update cancelled. Missing/invalid data string" Q
"RTN","BMXRPC9",101,0)
S TOT=$L(DATA,$C(30)) I 'TOT S OUT="Update cancelled. Missing data string" Q
"RTN","BMXRPC9",102,0)
F CNT=1:1:TOT S DATA(CNT)=$P(DATA,$C(30),CNT) ; BUILD PRIMARY FIELD ARRAY
"RTN","BMXRPC9",103,0)
S %=DATA(1) I %=""!(%=$C(31)) S OUT="Update cancelled. Missing data string" Q
"RTN","BMXRPC9",104,0)
S %=DATA(CNT) I %[$C(31) S %=$P(%,$C(31),1),DATA(CNT)=% ; STRIP OFF END OF FILE MARKER
"RTN","BMXRPC9",105,0)
F CNT=1:1:TOT S X=DATA(CNT) I $L(X) D ; BUILD SECONDARY FIELD ARRAY
"RTN","BMXRPC9",106,0)
. S TFLG=0,DFLG=0
"RTN","BMXRPC9",107,0)
. I $E(X)="+" S TFLG=1,X=$E(X,2,999),$P(FLD,U)=1
"RTN","BMXRPC9",108,0)
. I $E(X)="-" S DFLG=1,X=$E(X,2,999)
"RTN","BMXRPC9",109,0)
. S FNO=$P(X,"|"),VAL=$P(X,"|",2)
"RTN","BMXRPC9",110,0)
. I '$D(^DD(FILE,+$G(FNO),0)) S:$L(OUT) OUT=OUT_"~" S OUT=OUT_FNO_"|Invalid field number" Q
"RTN","BMXRPC9",111,0)
. I DFLG,VAL'="" S:$L(OUT) OUT=OUT_"~" S OUT=OUT_FNO_"|Invalid deletion syntax" Q ; CANT DELETE IF A VALUE IS SENT
"RTN","BMXRPC9",112,0)
. I DFLG!(VAL="") S VAL="@" ; SYNC DFLG AND VAL
"RTN","BMXRPC9",113,0)
. I VAL="@" S DFLG=1 ; SYNC DFLG AND VAL
"RTN","BMXRPC9",114,0)
. S FLD(FNO)=VAL_U_TFLG_U_DFLG
"RTN","BMXRPC9",115,0)
. I FNO=.01,TFLG S $P(FLD,U,2)=1 ;
"RTN","BMXRPC9",116,0)
. Q
"RTN","BMXRPC9",117,0)
I $P($G(FLD(.01)),U,3),UFLG="A" S OUT="Record deletion cancelled. Missing IEN" Q ; CAN'T DELETE A RECORD WITHOUT A VALID IEN
"RTN","BMXRPC9",118,0)
DELREC I $P($G(FLD(.01)),U,3) D DIK(OREF,IEN) S OUT="OK" Q ; DELETE THE RECORD
"RTN","BMXRPC9",119,0)
I UFLG="A",'$L($P($G(FLD(.01)),U)) S OUT="Record addition cancelled. Missing .01 field" Q ; CAN'T ADD A RECORD WITHOUT A VALID .01 FIELD
"RTN","BMXRPC9",120,0)
ADDREC I UFLG="A" D ADD(OREF) Q ; ADD A NEW ENTRY TO A FILE
"RTN","BMXRPC9",121,0)
EDITREC I UFLG="E" D EDIT(OREF,IEN) Q ; EDIT AN EXISTING RECORD
"RTN","BMXRPC9",122,0)
Q
"RTN","BMXRPC9",123,0)
;
"RTN","BMXRPC9",124,0)
DIK(DIK,DA) ; DELETE A RECORD
"RTN","BMXRPC9",125,0)
D ^DIK
"RTN","BMXRPC9",126,0)
D ^XBFMK
"RTN","BMXRPC9",127,0)
Q
"RTN","BMXRPC9",128,0)
;
"RTN","BMXRPC9",129,0)
ADD(DIC) ; ADD A NEW ENTRY TO A FILE
"RTN","BMXRPC9",130,0)
N X,Y
"RTN","BMXRPC9",131,0)
S X=""""_$P($G(FLD(.01)),U)_""""
"RTN","BMXRPC9",132,0)
S DIC(0)="L"
"RTN","BMXRPC9",133,0)
D ^DIC
"RTN","BMXRPC9",134,0)
I Y=-1 S OUT="Unable to add a new record" G AX
"RTN","BMXRPC9",135,0)
I $O(FLD(.01)) D EDIT(DIC,+Y) Q
"RTN","BMXRPC9",136,0)
S OUT="OK"_"|"_+Y
"RTN","BMXRPC9",137,0)
AX D ^XBFMK
"RTN","BMXRPC9",138,0)
Q
"RTN","BMXRPC9",139,0)
;
"RTN","BMXRPC9",140,0)
EDIT(DIE,DA) ; EDIT AN EXISTING RECORD
"RTN","BMXRPC9",141,0)
N DR,RFLG,ERR,FNO,VAL,TFLG,RESULT,MSG,DIERR,DISYS
"RTN","BMXRPC9",142,0)
S FNO=$O(FLD(.01),-1),DR="" ;HMW Changed to include .01 in DR string
"RTN","BMXRPC9",143,0)
I UFLG="A" S OUT="New record added|"_DA
"RTN","BMXRPC9",144,0)
F S FNO=$O(FLD(FNO)) Q:'FNO S X=FLD(FNO) I $L(X) D I $G(RFLG) Q ; CHECK EA FIELD AND BUILD THE DR STRING AND ERROR STRING
"RTN","BMXRPC9",145,0)
. S VAL(FNO)=$P(X,U),TFLG=$P(X,U,2) I '$L(VAL(FNO)) Q
"RTN","BMXRPC9",146,0)
. K ERR,RESULT
"RTN","BMXRPC9",147,0)
. I VAL(FNO)="@"!(VAL(FNO)="") S RESULT="@"
"RTN","BMXRPC9",148,0)
. E D CHK^DIE(FILE,FNO,"",VAL(FNO),.RESULT,"ERR")
"RTN","BMXRPC9",149,0)
. I RESULT=U D Q
"RTN","BMXRPC9",150,0)
.. S MSG=$G(ERR("DIERR",1,"TEXT",1),"Failed FileMan data validation")
"RTN","BMXRPC9",151,0)
.. I $L(OUT) S OUT=OUT_"~"
"RTN","BMXRPC9",152,0)
.. I TFLG!GTFLG S RFLG=1,OUT=FNO_"|"_MSG Q
"RTN","BMXRPC9",153,0)
.. S OUT=OUT_FNO_"|"_MSG
"RTN","BMXRPC9",154,0)
.. Q
"RTN","BMXRPC9",155,0)
. S VAL(FNO)=RESULT
"RTN","BMXRPC9",156,0)
. I $L(DR) S DR=DR_";"
"RTN","BMXRPC9",157,0)
. S DR=DR_FNO_"////^S X=VAL("_FNO_")" ; BUILD DR STRING
"RTN","BMXRPC9",158,0)
. Q
"RTN","BMXRPC9",159,0)
I $G(RFLG) D:UFLG="A" DIK(DIE,DA) S OUT="Record update cancelled"_"|"_OUT G EX ; TRANSACTION ROLLBACK FLAG IS SET, ENTRY DELETED (ADD MODE) OR UPDATE CANCELLED (EDIT MODE)
"RTN","BMXRPC9",160,0)
L +@CREF@(DA):2 I $T D ^DIE L -@CREF@(DA) G:OUT["valid" EX S OUT="OK" S:UFLG="A" OUT=OUT_"|"_DA G EX ; SUCCESS!!!!
"RTN","BMXRPC9",161,0)
S OUT="Update cancelled. File locked" ; FILE LOCKED. UNABLE TO UPDATE
"RTN","BMXRPC9",162,0)
I $L(FLD),UFLG="A" D DIK(DIE,DA) ; ROLLBACK THE NEW RECORD
"RTN","BMXRPC9",163,0)
EX D ^XBFMK ; CLEANUP
"RTN","BMXRPC9",164,0)
Q
"RTN","BMXRPC9",165,0)
;
"RTN","BMXSQL")
0^97^B109951806
"RTN","BMXSQL",1,0)
BMXSQL ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
"RTN","BMXSQL",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXSQL",3,0)
;
"RTN","BMXSQL",4,0)
;
"RTN","BMXSQL",5,0)
Q
"RTN","BMXSQL",6,0)
;
"RTN","BMXSQL",7,0)
FLDNDX(BMXGBL,BMXFL,BMXFLD) ;
"RTN","BMXSQL",8,0)
;Returns index name and set code for all indexes on field
"RTN","BMXSQL",9,0)
;on field BMXFLD in file BMXFL
"RTN","BMXSQL",10,0)
S BMX31=$C(31)_$C(31)
"RTN","BMXSQL",11,0)
K ^BMXTMP($J),^BMXTEMP($J)
"RTN","BMXSQL",12,0)
S BMXGBL="^BMXTEMP("_$J_")"
"RTN","BMXSQL",13,0)
I +BMXFL'=BMXFL D
"RTN","BMXSQL",14,0)
. S BMXFL=$TR(BMXFL,"_"," ")
"RTN","BMXSQL",15,0)
. I '$D(^DIC("B",BMXFL)) S BMXFL="" Q
"RTN","BMXSQL",16,0)
. S BMXFL=$O(^DIC("B",BMXFL,0))
"RTN","BMXSQL",17,0)
I '$G(BMXFL) D ERROUT("File number not provided.",1) Q
"RTN","BMXSQL",18,0)
;
"RTN","BMXSQL",19,0)
;Check for field name
"RTN","BMXSQL",20,0)
I +BMXFLD'=BMXFLD D
"RTN","BMXSQL",21,0)
. S BMXFLD=$TR(BMXFLD,"_"," ")
"RTN","BMXSQL",22,0)
. I '$D(^DD(BMXFL,"B",BMXFLD)) S BMXFLD="" Q
"RTN","BMXSQL",23,0)
. S BMXFLD=$O(^DD(BMXFL,"B",BMXFLD,0))
"RTN","BMXSQL",24,0)
I '$G(BMXFLD) D ERROUT("Field not provided",1) Q
"RTN","BMXSQL",25,0)
;
"RTN","BMXSQL",26,0)
;Set up Column names
"RTN","BMXSQL",27,0)
S ^BMXTEMP($J,0)="T"_$$NUMCHAR(30)_"INDEX^T"_$$NUMCHAR(200)_"CODE"_$C(30)
"RTN","BMXSQL",28,0)
;
"RTN","BMXSQL",29,0)
;Write field data to BMXTEMP
"RTN","BMXSQL",30,0)
S BMXI=0,I=0
"RTN","BMXSQL",31,0)
N BMXNAM,BMXCOD,BMXNOD,BMXTYP
"RTN","BMXSQL",32,0)
F S BMXI=$O(^DD(BMXFL,BMXFLD,1,BMXI)) Q:'+BMXI Q:$D(BMXERR) D
"RTN","BMXSQL",33,0)
. S I=I+1
"RTN","BMXSQL",34,0)
. S BMXNOD=$G(^DD(BMXFL,BMXFLD,1,BMXI,0))
"RTN","BMXSQL",35,0)
. S BMXNAM=$P(BMXNOD,U,2)
"RTN","BMXSQL",36,0)
. S BMXTYP=$P(BMXNOD,U,3)
"RTN","BMXSQL",37,0)
. S:BMXTYP="" BMXTYP="REGULAR"
"RTN","BMXSQL",38,0)
. S BMXCOD=$G(^DD(BMXFL,BMXFLD,1,BMXI,1))
"RTN","BMXSQL",39,0)
. S BMXCOD=$TR(BMXCOD,"^","~")
"RTN","BMXSQL",40,0)
. S ^BMXTEMP($J,I)=BMXNAM_U_BMXTYP_U_BMXCOD_$C(30)
"RTN","BMXSQL",41,0)
Q
"RTN","BMXSQL",42,0)
;
"RTN","BMXSQL",43,0)
TLIST(BMXGBL,BMXFROM,BMXTO) ;
"RTN","BMXSQL",44,0)
;Returns list of Fileman files to which user has READ access
"RTN","BMXSQL",45,0)
;TODO: Pass in type of access (RD,DL,WR) in BMXPAR
"RTN","BMXSQL",46,0)
;
"RTN","BMXSQL",47,0)
N A,F,BMXF,BMXFLD,D0,BMXU,I,BMXCNT,BMXMFL,BMXRD,BMXMAX
"RTN","BMXSQL",48,0)
S U="^"
"RTN","BMXSQL",49,0)
S:$G(BMXFROM)="RD" BMXFROM=""
"RTN","BMXSQL",50,0)
K ^BMXTMP($J),^BMXTEMP($J)
"RTN","BMXSQL",51,0)
S BMXGBL="^BMXTEMP("_$J_")"
"RTN","BMXSQL",52,0)
S BMXF=1
"RTN","BMXSQL",53,0)
S BMXF("FILE")=1
"RTN","BMXSQL",54,0)
S BMXFLD("FILE")="1^.01"
"RTN","BMXSQL",55,0)
S BMXFLD("NUMBER")="1^.001" ;ADDED
"RTN","BMXSQL",56,0)
S BMXFLDN=$P(BMXFLD("FILE"),"^",2)
"RTN","BMXSQL",57,0)
S BMXFLDN(1,BMXFLDN)="FILE"
"RTN","BMXSQL",58,0)
S BMXFLDN=$P(BMXFLD("NUMBER"),"^",2) ;ADDED
"RTN","BMXSQL",59,0)
S BMXFLDN(1,BMXFLDN)="NUMBER" ;ADDED
"RTN","BMXSQL",60,0)
S BMXFLDO=2 ;CHANGED FROM 1 TO 2
"RTN","BMXSQL",61,0)
S BMXFLDO(0)="1^.01"
"RTN","BMXSQL",62,0)
S BMXFLDOX(1,.01,"E")=0
"RTN","BMXSQL",63,0)
S BMXFLDO(1)="1^.001" ;ADDED
"RTN","BMXSQL",64,0)
S BMXFLDOX(1,.001,"E")=1 ;ADDED
"RTN","BMXSQL",65,0)
S BMXFNX(1)="FILE"
"RTN","BMXSQL",66,0)
S BMXFO(1)="1"
"RTN","BMXSQL",67,0)
S BMXU=$G(DUZ(0))
"RTN","BMXSQL",68,0)
S BMXRD=$C(30)
"RTN","BMXSQL",69,0)
S ^BMXTEMP($J,0)="T00030FILE^N00010NUMBER"_BMXRD
"RTN","BMXSQL",70,0)
S BMXSET="S I=I+1,^BMXTEMP($J,I)=$P($G(^DIC(D0,0)),U)_U_D0_BMXRD,BMXCNT=BMXCNT+1"
"RTN","BMXSQL",71,0)
S D0=0,I=0,BMXCNT=0,BMXMAX=2000
"RTN","BMXSQL",72,0)
S BMXFROM=$G(BMXFROM),BMXTO=$G(BMXTO)
"RTN","BMXSQL",73,0)
I +BMXFROM=BMXFROM D ;BMXFROM is a filenumber
"RTN","BMXSQL",74,0)
. S F=(+BMXFROM-1),T=+BMXTO
"RTN","BMXSQL",75,0)
. S:BMXTO<BMXFROM BMXTO=BMXFROM+1
"RTN","BMXSQL",76,0)
. S D0=F F S D0=$O(^DIC(D0)) Q:'+D0 Q:D0>T Q:BMXCNT>BMXMAX I $D(^DD(D0)) D TLIST1
"RTN","BMXSQL",77,0)
I +BMXFROM'=BMXFROM D ;F is a filename or is null
"RTN","BMXSQL",78,0)
. S F="",T="zzzzzzz"
"RTN","BMXSQL",79,0)
. S:$G(BMXFROM)]"" F=$O(^DIC("B",BMXFROM),-1)
"RTN","BMXSQL",80,0)
. S:$G(BMXTO)]"" T=BMXTO
"RTN","BMXSQL",81,0)
. F S F=$O(^DIC("B",F)) Q:F="" Q:F]T Q:BMXCNT>BMXMAX D
"RTN","BMXSQL",82,0)
. . S D0=0 F S D0=$O(^DIC("B",F,D0)) Q:'+D0 D TLIST1
"RTN","BMXSQL",83,0)
;
"RTN","BMXSQL",84,0)
S I=I+1,^BMXTEMP($J,I)=$C(31)
"RTN","BMXSQL",85,0)
Q
"RTN","BMXSQL",86,0)
;
"RTN","BMXSQL",87,0)
TLIST1 ;
"RTN","BMXSQL",88,0)
I BMXU="@" X BMXSET Q
"RTN","BMXSQL",89,0)
Q:$D(^DIC(D0,0))'=11
"RTN","BMXSQL",90,0)
S A=$G(^DIC(D0,0,"RD"))
"RTN","BMXSQL",91,0)
I $D(^VA(200,DUZ,"FOF",D0,0)) D Q
"RTN","BMXSQL",92,0)
. ;I $P(^(0),U,5)="1" X BMXSET Q
"RTN","BMXSQL",93,0)
. I $P(^VA(200,DUZ,"FOF",D0,0),U,5)="1" X BMXSET Q
"RTN","BMXSQL",94,0)
F J=1:1:$L(A) I DUZ(0)[$E(A,J) X BMXSET
"RTN","BMXSQL",95,0)
Q
"RTN","BMXSQL",96,0)
;
"RTN","BMXSQL",97,0)
SQLCOL(BMXGBL,BMXSQL) ;EP
"RTN","BMXSQL",98,0)
D INTSQL(.BMXGBL,.BMXSQL,1)
"RTN","BMXSQL",99,0)
Q
"RTN","BMXSQL",100,0)
;
"RTN","BMXSQL",101,0)
SQLD(BMXGBL,BMXSQL) ;EP Serenji Debug Entrypoint
"RTN","BMXSQL",102,0)
D DEBUG^%Serenji("SQL^BMXSQL(.BMXGBL,.BMXSQL)","10.10.10.104")
"RTN","BMXSQL",103,0)
Q
"RTN","BMXSQL",104,0)
;
"RTN","BMXSQL",105,0)
SQL(BMXGBL,BMXSQL) ;EP
"RTN","BMXSQL",106,0)
D INTSQL(.BMXGBL,.BMXSQL,0)
"RTN","BMXSQL",107,0)
Q
"RTN","BMXSQL",108,0)
;
"RTN","BMXSQL",109,0)
INTSQL(BMXGBL,BMXSQL,BMXCOL) ;EP
"RTN","BMXSQL",110,0)
;
"RTN","BMXSQL",111,0)
;SQL Top Wait for debug break
"RTN","BMXSQL",112,0)
;D
"RTN","BMXSQL",113,0)
;. F J=1:1:10 S K=$H H 1
"RTN","BMXSQL",114,0)
;. Q
"RTN","BMXSQL",115,0)
;
"RTN","BMXSQL",116,0)
S X="ERRTRAP^BMXSQL",@^%ZOSF("TRAP")
"RTN","BMXSQL",117,0)
I $G(BMXSQL)="" S BMXSQL="" D
"RTN","BMXSQL",118,0)
. N C S C=0 F S C=$O(BMXSQL(C)) Q:'+C D
"RTN","BMXSQL",119,0)
. . S BMXSQL=BMXSQL_BMXSQL(C)
"RTN","BMXSQL",120,0)
;
"RTN","BMXSQL",121,0)
I BMXSQL["call SHAPE" S BMXSQL="SELECT JUNKNAME, MULTCOLOR FROM JUNKMULT"
"RTN","BMXSQL",122,0)
; Global-scope variables
"RTN","BMXSQL",123,0)
K BMXTK
"RTN","BMXSQL",124,0)
N BMXF,BMXTK,T,BMXFLD,BMXTMP,BMXM,BMXXMAX,BMXFLDN,BMXV
"RTN","BMXSQL",125,0)
N BMXX,BMXFG,BMXFF,BMXSCR,BMXPFP
"RTN","BMXSQL",126,0)
N BMXERR,BMXFLDO,BMXFLDOX,BMXFJ,BMXFO,BMXFNX
"RTN","BMXSQL",127,0)
N BMXMFL,BMXFLDA
"RTN","BMXSQL",128,0)
D ^XBKVAR
"RTN","BMXSQL",129,0)
S U="^"
"RTN","BMXSQL",130,0)
I $D(^%ZOSF("MAXSIZ")) S X=640 X ^%ZOSF("MAXSIZ")
"RTN","BMXSQL",131,0)
K ^BMXTMP($J),^BMXTEMP($J),^BMXTMPD($J)
"RTN","BMXSQL",132,0)
S BMXGBL="^BMXTEMP("_$J_")"
"RTN","BMXSQL",133,0)
;Remove CR and LF from BMXSQL
"RTN","BMXSQL",134,0)
S BMXSQL=$TR(BMXSQL,$C(13)," ")
"RTN","BMXSQL",135,0)
S BMXSQL=$TR(BMXSQL,$C(10)," ")
"RTN","BMXSQL",136,0)
S BMXSQL=$TR(BMXSQL,$C(9)," ")
"RTN","BMXSQL",137,0)
S BMXSQL=$TR(BMXSQL,$C(34),"")
"RTN","BMXSQL",138,0)
D PARSE^BMXPRS(BMXSQL)
"RTN","BMXSQL",139,0)
S BMXXMAX=1000000 ;Default Maximum records to return.
"RTN","BMXSQL",140,0)
D KW^BMXSQL1(.BMXTK)
"RTN","BMXSQL",141,0)
Q:$D(BMXERR)
"RTN","BMXSQL",142,0)
;
"RTN","BMXSQL",143,0)
;Get file names into BMXF("NAME")="NUMBER"
"RTN","BMXSQL",144,0)
;Get file numbers into BMXFNX(NUMBER)="NAME"
"RTN","BMXSQL",145,0)
; Files are ordered in BMXFO(order)="NUMBER"
"RTN","BMXSQL",146,0)
;
"RTN","BMXSQL",147,0)
FROM S T=$G(BMXTK("FROM"))
"RTN","BMXSQL",148,0)
I '+T S BMXERR="'FROM' CLAUSE NOT FOUND" D ERROR Q
"RTN","BMXSQL",149,0)
S BMXF=0
"RTN","BMXSQL",150,0)
F S T=$O(BMXTK(T)) Q:'+T Q:T=$G(BMXTK("WHERE")) Q:T=$G(BMXTK("ORDER BY")) Q:T=$G(BMXTK("GROUP BY")) D Q:$D(BMXERR)
"RTN","BMXSQL",151,0)
. Q:BMXTK(T)=","
"RTN","BMXSQL",152,0)
. N BMXFNT
"RTN","BMXSQL",153,0)
. I BMXTK(T)["'" S BMXTK(T)=$P(BMXTK(T),"'",2)
"RTN","BMXSQL",154,0)
. S BMXTK(T)=$TR(BMXTK(T),"_"," ")
"RTN","BMXSQL",155,0)
. I '(BMXTK(T)?.N),'$D(^DIC("B",BMXTK(T))) S BMXERR="FILE NOT FOUND" D ERROR Q
"RTN","BMXSQL",156,0)
. S BMXF=BMXF+1
"RTN","BMXSQL",157,0)
. I BMXTK(T)?.N S BMXFNT=BMXTK(T)
"RTN","BMXSQL",158,0)
. E S BMXFNT=$O(^DIC("B",BMXTK(T),0))
"RTN","BMXSQL",159,0)
. S BMXMFL(BMXFNT,"GLOC")=^DIC(BMXFNT,0,"GL")
"RTN","BMXSQL",160,0)
. D F1(BMXF,BMXTK(T),BMXFNT)
"RTN","BMXSQL",161,0)
. I '+BMXF(BMXTK(T)) S BMXERR="FILE NUMBER NOT FOUND" D ERROR Q
"RTN","BMXSQL",162,0)
. D ;Test alias
"RTN","BMXSQL",163,0)
. . Q:'+$O(BMXTK(T))
"RTN","BMXSQL",164,0)
. . N V
"RTN","BMXSQL",165,0)
. . S V=T+1
"RTN","BMXSQL",166,0)
. . Q:$G(BMXTK(V))=","
"RTN","BMXSQL",167,0)
. . Q:V=$G(BMXTK("WHERE"))
"RTN","BMXSQL",168,0)
. . Q:V=$G(BMXTK("ORDER BY"))
"RTN","BMXSQL",169,0)
. . Q:V=$G(BMXTK("GROUP BY"))
"RTN","BMXSQL",170,0)
. . S BMXTK(T,"ALIAS")=BMXTK(V)
"RTN","BMXSQL",171,0)
. . K BMXTK(V)
"RTN","BMXSQL",172,0)
. . Q
"RTN","BMXSQL",173,0)
. Q
"RTN","BMXSQL",174,0)
;
"RTN","BMXSQL",175,0)
D SELECT^BMXSQL5
"RTN","BMXSQL",176,0)
I $D(BMXERR) G END
"RTN","BMXSQL",177,0)
D POST2^BMXPRS ;Remove commas from BMXTK
"RTN","BMXSQL",178,0)
D KW^BMXSQL1(.BMXTK)
"RTN","BMXSQL",179,0)
;
"RTN","BMXSQL",180,0)
D WHERE^BMXSQL7
"RTN","BMXSQL",181,0)
;
"RTN","BMXSQL",182,0)
;Find the first WHERE field that has an index
"RTN","BMXSQL",183,0)
I $D(BMXERR) G END
"RTN","BMXSQL",184,0)
;
"RTN","BMXSQL",185,0)
D INDEX(.BMXFF,.BMXX,.BMXTMP)
"RTN","BMXSQL",186,0)
;
"RTN","BMXSQL",187,0)
S:BMXTMP BMXX=BMXTMP
"RTN","BMXSQL",188,0)
;
"RTN","BMXSQL",189,0)
;Set up screen logic for where fields
"RTN","BMXSQL",190,0)
D SCREEN^BMXSQL1
"RTN","BMXSQL",191,0)
D SETX^BMXSQL2(.BMXX,.BMXFG,.BMXSCR)
"RTN","BMXSQL",192,0)
;
"RTN","BMXSQL",193,0)
;
"RTN","BMXSQL",194,0)
EXEC ;Execute enumerator and screen code to call Output routine
"RTN","BMXSQL",195,0)
;
"RTN","BMXSQL",196,0)
N BMXOUT,J,BMXC
"RTN","BMXSQL",197,0)
S BMXOUT=0
"RTN","BMXSQL",198,0)
;Debug lines (retain):
"RTN","BMXSQL",199,0)
;K ^HW("BMXX") S J=0 F S J=$O(BMXX(J)) Q:'+J S ^HW("BMXX",J)=BMXX(J)
"RTN","BMXSQL",200,0)
;K ^HW("BMXSCR") S ^HW("BMXSCR")=$G(BMXSCR) S J=0 F S J=$O(BMXSCR(J)) Q:'+J S ^HW("BMXSCR",J)=BMXSCR(J)
"RTN","BMXSQL",201,0)
;Test for SHOWPLAN
"RTN","BMXSQL",202,0)
I $G(BMXTK("SHOWPLAN"))="TRUE" D WPLAN Q
"RTN","BMXSQL",203,0)
S BMXM=0
"RTN","BMXSQL",204,0)
I 'BMXCOL S J=0 F S J=$O(BMXX(J)) Q:'+J D Q:BMXM>BMXXMAX
"RTN","BMXSQL",205,0)
. X BMXX(J)
"RTN","BMXSQL",206,0)
;
"RTN","BMXSQL",207,0)
D WRITE^BMXSQL6
"RTN","BMXSQL",208,0)
;
"RTN","BMXSQL",209,0)
END Q
"RTN","BMXSQL",210,0)
;
"RTN","BMXSQL",211,0)
;
"RTN","BMXSQL",212,0)
F1(BMXC,BMXNAM,BMXNUM) ;EP
"RTN","BMXSQL",213,0)
S BMXF(BMXNAM)=BMXNUM
"RTN","BMXSQL",214,0)
S BMXFNX(BMXNUM)=BMXNAM
"RTN","BMXSQL",215,0)
S BMXFO(BMXC)=BMXF(BMXNAM)
"RTN","BMXSQL",216,0)
Q
"RTN","BMXSQL",217,0)
;
"RTN","BMXSQL",218,0)
OUT ;Set result in ^BMXTMP
"RTN","BMXSQL",219,0)
S BMXOUT=BMXOUT+1
"RTN","BMXSQL",220,0)
S ^BMXTMP($J,"O",D0)=""
"RTN","BMXSQL",221,0)
S ^BMXTMP($J,BMXOUT)=D0
"RTN","BMXSQL",222,0)
S BMXM=BMXM+1
"RTN","BMXSQL",223,0)
Q
"RTN","BMXSQL",224,0)
;
"RTN","BMXSQL",225,0)
WPLAN ;Write execution plan
"RTN","BMXSQL",226,0)
;Set up Column Names
"RTN","BMXSQL",227,0)
N BMXLEN,BMXTYP,BMXT,J,BMXSCRT,BMXXT
"RTN","BMXSQL",228,0)
S I=1
"RTN","BMXSQL",229,0)
F BMXT="VARIABLE^","VALUE"_$C(30) D
"RTN","BMXSQL",230,0)
. S ^BMXTEMP($J,I)=BMXT,BMXLEN(I)=15,BMXTYP(I)="T"
"RTN","BMXSQL",231,0)
. S I=I+1
"RTN","BMXSQL",232,0)
S J=0
"RTN","BMXSQL",233,0)
I $D(BMXX) F S J=$O(BMXX(J)) Q:'+J D
"RTN","BMXSQL",234,0)
. S ^BMXTEMP($J,I)="INDEX("_J_")^"
"RTN","BMXSQL",235,0)
. S I=I+1
"RTN","BMXSQL",236,0)
. S BMXXT(J)=BMXX(J)
"RTN","BMXSQL",237,0)
. S BMXXT(J)=$P(BMXXT(J)," X BMXSCR")
"RTN","BMXSQL",238,0)
. S ^BMXTEMP($J,I)=$TR(BMXXT(J),"^","~")_$C(30)
"RTN","BMXSQL",239,0)
. S:$L(^BMXTEMP($J,I))>BMXLEN(2) BMXLEN(2)=$L(^BMXTEMP($J,I))
"RTN","BMXSQL",240,0)
. S I=I+1
"RTN","BMXSQL",241,0)
S ^BMXTEMP($J,I)="SCREEN^"
"RTN","BMXSQL",242,0)
S I=I+1
"RTN","BMXSQL",243,0)
S BMXSCRT=$G(BMXSCR)
"RTN","BMXSQL",244,0)
S BMXSCRT=$P(BMXSCRT,"D:'$D(^BMXTMP")
"RTN","BMXSQL",245,0)
S ^BMXTEMP($J,I)=$TR(BMXSCRT,"^","~")_$C(30)
"RTN","BMXSQL",246,0)
S:$L(^BMXTEMP($J,I))>BMXLEN(2) BMXLEN(2)=$L(^BMXTEMP($J,I))
"RTN","BMXSQL",247,0)
S I=I+1
"RTN","BMXSQL",248,0)
S J=0
"RTN","BMXSQL",249,0)
I $D(BMXSCR("C")) F S J=$O(BMXSCR("C",J)) Q:'+J D
"RTN","BMXSQL",250,0)
. S ^BMXTEMP($J,I)="SCREEN("_J_")^"
"RTN","BMXSQL",251,0)
. S I=I+1
"RTN","BMXSQL",252,0)
. S ^BMXTEMP($J,I)=$TR(BMXSCR("C",J),"^","~")_$C(30)
"RTN","BMXSQL",253,0)
. S:$L(^BMXTEMP($J,I))>BMXLEN(2) BMXLEN(2)=$L(^BMXTEMP($J,I))
"RTN","BMXSQL",254,0)
. S I=I+1
"RTN","BMXSQL",255,0)
D COLTYPE
"RTN","BMXSQL",256,0)
S I=I+1
"RTN","BMXSQL",257,0)
D ERRTACK(I)
"RTN","BMXSQL",258,0)
Q
"RTN","BMXSQL",259,0)
;
"RTN","BMXSQL",260,0)
;
"RTN","BMXSQL",261,0)
COLTYPE ;EP - Append column types and widths to output global
"RTN","BMXSQL",262,0)
;REQUIRES - BMXLEN(),BMXTYP(),^BMXTEMP
"RTN","BMXSQL",263,0)
;IHS/SET/HMW 4-22-2004 Modified to use new schema string
"RTN","BMXSQL",264,0)
;
"RTN","BMXSQL",265,0)
;"@@@meta@@@BMXIEN|FILE #|DA STRING"
"RTN","BMXSQL",266,0)
;
"RTN","BMXSQL",267,0)
N C
"RTN","BMXSQL",268,0)
S C=0
"RTN","BMXSQL",269,0)
F S C=$O(BMXLEN(C)) Q:'C D
"RTN","BMXSQL",270,0)
. I BMXLEN(C)>99999 S BMXLEN(C)=99999
"RTN","BMXSQL",271,0)
. I BMXLEN(C)=0 S BMXLEN(C)=50 ;Default column length
"RTN","BMXSQL",272,0)
. S ^BMXTEMP($J,C)=BMXTYP(C)_$$NUMCHAR(BMXLEN(C))_^BMXTEMP($J,C)
"RTN","BMXSQL",273,0)
Q
"RTN","BMXSQL",274,0)
;
"RTN","BMXSQL",275,0)
;S ^BXTEMP($J,0)="@@@meta@@@BMXIEN|"_BMXF_"|" ;Last |-piece will be DA string
"RTN","BMXSQL",276,0)
;N C
"RTN","BMXSQL",277,0)
;S C=0
"RTN","BMXSQL",278,0)
;F S C=$O(BMXLEN(C)) Q:'C D
"RTN","BMXSQL",279,0)
;. I BMXLEN(C)>99999 S BMXLEN(C)=99999
"RTN","BMXSQL",280,0)
;. I BMXLEN(C)=0 S BMXLEN(C)=50 ;Default column length
"RTN","BMXSQL",281,0)
;. S ^BMXTEMP($J,C)=BMXTYP(C)_$$NUMCHAR(BMXLEN(C))_^BMXTEMP($J,C)
"RTN","BMXSQL",282,0)
;Q
"RTN","BMXSQL",283,0)
;
"RTN","BMXSQL",284,0)
ERRTACK(I) ;EP
"RTN","BMXSQL",285,0)
;
"RTN","BMXSQL",286,0)
S ^BMXTEMP($J,I)=$C(31)
"RTN","BMXSQL",287,0)
S:$D(BMXERR) ^BMXTEMP($J,I)=^BMXTEMP($J,I)_BMXERR
"RTN","BMXSQL",288,0)
Q
"RTN","BMXSQL",289,0)
;
"RTN","BMXSQL",290,0)
NUMCHAR(BMXN) ;EP
"RTN","BMXSQL",291,0)
;---> Returns Field Length left-padded with 0
"RTN","BMXSQL",292,0)
;
"RTN","BMXSQL",293,0)
N BMXC
"RTN","BMXSQL",294,0)
S BMXC="00000"_BMXN
"RTN","BMXSQL",295,0)
Q $E(BMXC,$L(BMXC)-4,$L(BMXC))
"RTN","BMXSQL",296,0)
;
"RTN","BMXSQL",297,0)
;
"RTN","BMXSQL",298,0)
INDEX(BMXFF,BMXRET,BMXXCNT) ;
"RTN","BMXSQL",299,0)
;Returns executable enumerator on first where field with an index
"RTN","BMXSQL",300,0)
;or "" if no indexed where field
"RTN","BMXSQL",301,0)
;IN: BMXFF()
"RTN","BMXSQL",302,0)
;OUT: BMXRET()
"RTN","BMXSQL",303,0)
; BMXXCNT - size of BMXRET array
"RTN","BMXSQL",304,0)
;
"RTN","BMXSQL",305,0)
N F,BMXNOD,BMXFNUM,BMXFLDNUM,BMXHIT,BMXREF,BMXRNAM,BMXOP,Q,BMXGL
"RTN","BMXSQL",306,0)
N BMXTMP,BMXTMPV,BMXTMPI,BMXTMPL,BMXTMPN,BMXV,BMXRNOD,BMXTMPP
"RTN","BMXSQL",307,0)
S BMXXCNT=0
"RTN","BMXSQL",308,0)
S Q=$C(34)
"RTN","BMXSQL",309,0)
I 'BMXFF Q
"RTN","BMXSQL",310,0)
S F=0,BMXHIT=0
"RTN","BMXSQL",311,0)
;
"RTN","BMXSQL",312,0)
;--->Search BMXFF for special case WHERE clause 1 = "0"
"RTN","BMXSQL",313,0)
; reset BMXX(1) to return no records
"RTN","BMXSQL",314,0)
F F=1:1:BMXFF S BMXNOD=BMXFF(F) D Q:$D(BMXERR) Q:BMXHIT
"RTN","BMXSQL",315,0)
. I ($P(BMXFF(F),"^",2,4)="1^=^0")!($P(BMXFF(F),"^",2,4)="0^=^1") S BMXRET(1)="Q ",BMXHIT=1,BMXXCNT=1
"RTN","BMXSQL",316,0)
. Q
"RTN","BMXSQL",317,0)
Q:BMXHIT
"RTN","BMXSQL",318,0)
;
"RTN","BMXSQL",319,0)
;Organize the first level into AND- and OR-parts
"RTN","BMXSQL",320,0)
N BMXR1,BMXR2,BMXE,BMXR3,BMXRNAM
"RTN","BMXSQL",321,0)
N BMXSTOP,BMXOR
"RTN","BMXSQL",322,0)
D PLEVEL^BMXSQL3(.BMXFF,.BMXR1,.BMXR2)
"RTN","BMXSQL",323,0)
;
"RTN","BMXSQL",324,0)
N BMXPFF S BMXPFF=0
"RTN","BMXSQL",325,0)
S BMXR3=0
"RTN","BMXSQL",326,0)
;Look for an AND-part with only one element.
"RTN","BMXSQL",327,0)
; If found, build an iterator on it and quit
"RTN","BMXSQL",328,0)
F J=1:1:$L(BMXR2,"&") D Q:BMXHIT
"RTN","BMXSQL",329,0)
. S BMXE=$P(BMXR2,"&",J)
"RTN","BMXSQL",330,0)
. I +BMXE=BMXE,BMXR1(BMXE,"ELEMENTS")=1 D
"RTN","BMXSQL",331,0)
. . ;Test index for element
"RTN","BMXSQL",332,0)
. . F K=BMXR1(BMXE,"BEGIN"):1:BMXR1(BMXE,"END") I "(^)"'[BMXFF(K) D Q ;I'm not sure why this quit was here
"RTN","BMXSQL",333,0)
. . . Q:$D(BMXFF(K,"JOIN"))
"RTN","BMXSQL",334,0)
. . . S BMXPFP=K,BMXPFF=0
"RTN","BMXSQL",335,0)
. . . D XRTST^BMXSQL3(.BMXFF,K,.BMXR3,.BMXRNAM,.BMXPFP)
"RTN","BMXSQL",336,0)
. . . I BMXR3 S BMXHIT=1,BMXFF(K,"INDEXED")=1
"RTN","BMXSQL",337,0)
. Q:'BMXHIT
"RTN","BMXSQL",338,0)
. ;Build iterator and quit
"RTN","BMXSQL",339,0)
. D BLDIT^BMXSQL3(.BMXFF,K,.BMXRNAM,.BMXOR,.BMXPFP)
"RTN","BMXSQL",340,0)
. S BMXXCNT=1
"RTN","BMXSQL",341,0)
. S BMXRET(BMXXCNT)=BMXOR
"RTN","BMXSQL",342,0)
. Q
"RTN","BMXSQL",343,0)
Q:BMXHIT
"RTN","BMXSQL",344,0)
;
"RTN","BMXSQL",345,0)
;None of the single-element AND parts has a good index or
"RTN","BMXSQL",346,0)
; there are no single-element AND parts
"RTN","BMXSQL",347,0)
;If there are no OR-parts, then there are no good indexes so quit
"RTN","BMXSQL",348,0)
I $L(BMXR2,"!")=1 Q
"RTN","BMXSQL",349,0)
;
"RTN","BMXSQL",350,0)
;Test each OR-part for a good index.
"RTN","BMXSQL",351,0)
;If an OR-part is multi-element or
"RTN","BMXSQL",352,0)
;if one OR-part doesn't have an index
"RTN","BMXSQL",353,0)
;then set up to do a table scan and quit
"RTN","BMXSQL",354,0)
S BMXSTOP=0
"RTN","BMXSQL",355,0)
F J=1:1:$L(BMXR2,"!") D Q:BMXSTOP
"RTN","BMXSQL",356,0)
. S BMXE=$P(BMXR2,"!",J)
"RTN","BMXSQL",357,0)
. I +BMXE=BMXE D
"RTN","BMXSQL",358,0)
. . I BMXR1(BMXE,"ELEMENTS")'=1 S BMXSTOP=1 Q ;Multiple elements
"RTN","BMXSQL",359,0)
. . ;Test index elements
"RTN","BMXSQL",360,0)
. . F K=BMXR1(BMXE,"BEGIN"):1:BMXR1(BMXE,"END") I "(^)"'[BMXFF(K) D Q
"RTN","BMXSQL",361,0)
. . . S BMXPFP=K,BMXPFF=0
"RTN","BMXSQL",362,0)
. . . D XRTST^BMXSQL3(.BMXFF,K,.BMXR3,.BMXRNAM,.BMXPFP)
"RTN","BMXSQL",363,0)
. . . I 'BMXR3 S BMXSTOP=1 Q
"RTN","BMXSQL",364,0)
. . . S BMXFF(K,"INDEXED")=1
"RTN","BMXSQL",365,0)
. . . S BMXR1(BMXE,"XREF")=BMXRNAM
"RTN","BMXSQL",366,0)
;
"RTN","BMXSQL",367,0)
;Build iterator and quit
"RTN","BMXSQL",368,0)
I BMXSTOP D Q ;One of the elements had no index
"RTN","BMXSQL",369,0)
. S J=0 F S J=$O(BMXFF(J)) Q:'+J K BMXFF(J,"INDEXED")
"RTN","BMXSQL",370,0)
S BMXXCNT=0
"RTN","BMXSQL",371,0)
F J=1:1:$L(BMXR2,"!") D
"RTN","BMXSQL",372,0)
. S BMXE=$P(BMXR2,"!",J)
"RTN","BMXSQL",373,0)
. I +BMXE=BMXE,BMXR1(BMXE,"ELEMENTS")=1 D
"RTN","BMXSQL",374,0)
. . F K=BMXR1(BMXE,"BEGIN"):1:BMXR1(BMXE,"END") I "(^)"'[BMXFF(K) D Q
"RTN","BMXSQL",375,0)
. . . D BLDIT^BMXSQL3(.BMXFF,K,BMXR1(BMXE,"XREF"),.BMXOR,.BMXPFP)
"RTN","BMXSQL",376,0)
. . . S BMXXCNT=BMXXCNT+1
"RTN","BMXSQL",377,0)
. . . S BMXRET(BMXXCNT)=BMXOR
"RTN","BMXSQL",378,0)
. Q
"RTN","BMXSQL",379,0)
Q
"RTN","BMXSQL",380,0)
;
"RTN","BMXSQL",381,0)
;
"RTN","BMXSQL",382,0)
;
"RTN","BMXSQL",383,0)
ERROR ;EP - Error processing
"RTN","BMXSQL",384,0)
;W !,BMXERR
"RTN","BMXSQL",385,0)
;N A
"RTN","BMXSQL",386,0)
;S A=0
"RTN","BMXSQL",387,0)
;I $D(I) S A=I
"RTN","BMXSQL",388,0)
;D ERROUT(BMXERR,A)
"RTN","BMXSQL",389,0)
;B ;ERROR in BMXSQL
"RTN","BMXSQL",390,0)
Q
"RTN","BMXSQL",391,0)
;
"RTN","BMXSQL",392,0)
ERROUT(BMXERR,I) ;EP
"RTN","BMXSQL",393,0)
;---> Save next line for Error Code File if ever used.
"RTN","BMXSQL",394,0)
;---> If necessary, use I>1 to avoid overwriting valid data.
"RTN","BMXSQL",395,0)
D ERRTACK(I)
"RTN","BMXSQL",396,0)
Q
"RTN","BMXSQL",397,0)
;
"RTN","BMXSQL",398,0)
ERRTRAP ;
"RTN","BMXSQL",399,0)
;
"RTN","BMXSQL",400,0)
K ^BMXTEMP($J)
"RTN","BMXSQL",401,0)
S ^BMXTEMP($J,0)="T00030M_ERROR"_$C(30)
"RTN","BMXSQL",402,0)
S BMXZE=$$EC^%ZOSV
"RTN","BMXSQL",403,0)
S BMXZE=$TR(BMXZE,"^","~")
"RTN","BMXSQL",404,0)
S ^BMXTEMP($J,1)=BMXZE_$C(30)
"RTN","BMXSQL",405,0)
S ^BMXTEMP($J,2)=$C(31)
"RTN","BMXSQL",406,0)
Q
"RTN","BMXSQL1")
0^98^B112955506
"RTN","BMXSQL1",1,0)
BMXSQL1 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
"RTN","BMXSQL1",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXSQL1",3,0)
;
"RTN","BMXSQL1",4,0)
;
"RTN","BMXSQL1",5,0)
KW(BMXTK) ;EP
"RTN","BMXSQL1",6,0)
;Identify and mark keywords in BMXTK
"RTN","BMXSQL1",7,0)
;MODIFIES BMXTK
"RTN","BMXSQL1",8,0)
;
"RTN","BMXSQL1",9,0)
N J,BMXSTOP,BMXTMP
"RTN","BMXSQL1",10,0)
;Combine ORDER BY and GROUP BY into a single token
"RTN","BMXSQL1",11,0)
;
"RTN","BMXSQL1",12,0)
S J=0
"RTN","BMXSQL1",13,0)
F S J=$O(BMXTK(J)) Q:'+J D
"RTN","BMXSQL1",14,0)
. S BMXTMP=$$UCASE(BMXTK(J))
"RTN","BMXSQL1",15,0)
. I BMXTMP="ORDER"!(BMXTMP="GROUP") D
"RTN","BMXSQL1",16,0)
. . I $D(BMXTK(J+1)),$$UCASE(BMXTK(J+1))="BY" D
"RTN","BMXSQL1",17,0)
. . . S BMXTK(J)=BMXTK(J)_" "_BMXTK(J+1)
"RTN","BMXSQL1",18,0)
. . . S BMXTK(J)=$$UCASE(BMXTK(J))
"RTN","BMXSQL1",19,0)
. . . S BMXTK(BMXTK(J))=J
"RTN","BMXSQL1",20,0)
. . . K BMXTK(J+1)
"RTN","BMXSQL1",21,0)
. . . Q
"RTN","BMXSQL1",22,0)
. . Q
"RTN","BMXSQL1",23,0)
. Q
"RTN","BMXSQL1",24,0)
;
"RTN","BMXSQL1",25,0)
;Find SELECT
"RTN","BMXSQL1",26,0)
S J=0,BMXSTOP=0
"RTN","BMXSQL1",27,0)
F S J=$O(BMXTK(J)) Q:'+J D Q:BMXSTOP
"RTN","BMXSQL1",28,0)
. I $$UCASE(BMXTK(J))="SELECT" D
"RTN","BMXSQL1",29,0)
. . S BMXTK(J)=$$UCASE(BMXTK(J))
"RTN","BMXSQL1",30,0)
. . S BMXTK("SELECT")=J
"RTN","BMXSQL1",31,0)
. . S BMXSTOP=1
"RTN","BMXSQL1",32,0)
. . Q
"RTN","BMXSQL1",33,0)
. Q
"RTN","BMXSQL1",34,0)
I '+J S BMXERR="SELECT KEYWORD NOT FOUND" Q
"RTN","BMXSQL1",35,0)
;
"RTN","BMXSQL1",36,0)
;DISTINCT
"RTN","BMXSQL1",37,0)
S BMXSTOP=0
"RTN","BMXSQL1",38,0)
F S J=$O(BMXTK(J)) Q:'+J Q:$$UCASE(BMXTK(J))="FROM" D Q:BMXSTOP
"RTN","BMXSQL1",39,0)
. I $$UCASE(BMXTK(J))="DISTINCT" D
"RTN","BMXSQL1",40,0)
. . S BMXTK("DISTINCT")="TRUE"
"RTN","BMXSQL1",41,0)
. . K BMXTK(J)
"RTN","BMXSQL1",42,0)
. . S J=J-1
"RTN","BMXSQL1",43,0)
. . S BMXSTOP=1
"RTN","BMXSQL1",44,0)
. Q
"RTN","BMXSQL1",45,0)
;
"RTN","BMXSQL1",46,0)
;FROM
"RTN","BMXSQL1",47,0)
S BMXSTOP=0
"RTN","BMXSQL1",48,0)
S J=J-1
"RTN","BMXSQL1",49,0)
F S J=$O(BMXTK(J)) Q:'+J Q:$$UCASE(BMXTK(J))="WHERE" D Q:BMXSTOP
"RTN","BMXSQL1",50,0)
. I $$UCASE(BMXTK(J))="FROM" D
"RTN","BMXSQL1",51,0)
. . S BMXTK(J)=$$UCASE(BMXTK(J))
"RTN","BMXSQL1",52,0)
. . S BMXTK("FROM")=J
"RTN","BMXSQL1",53,0)
. . S BMXSTOP=1
"RTN","BMXSQL1",54,0)
. . Q
"RTN","BMXSQL1",55,0)
. Q
"RTN","BMXSQL1",56,0)
;
"RTN","BMXSQL1",57,0)
I '$D(BMXTK("FROM")) S BMXERR="'FROM' KEYWORD NOT FOUND" Q
"RTN","BMXSQL1",58,0)
;
"RTN","BMXSQL1",59,0)
;WHERE
"RTN","BMXSQL1",60,0)
S BMXSTOP=0
"RTN","BMXSQL1",61,0)
F S J=$O(BMXTK(J)) Q:'+J Q:BMXTK(J)="ORDER BY" Q:BMXTK(J)="GROUP BY" D Q:BMXSTOP
"RTN","BMXSQL1",62,0)
. I $$UCASE(BMXTK(J))="WHERE" D
"RTN","BMXSQL1",63,0)
. . S BMXTK(J)=$$UCASE(BMXTK(J))
"RTN","BMXSQL1",64,0)
. . S BMXTK("WHERE")=J
"RTN","BMXSQL1",65,0)
. . S BMXSTOP=1
"RTN","BMXSQL1",66,0)
. Q
"RTN","BMXSQL1",67,0)
;
"RTN","BMXSQL1",68,0)
;SHOWPLAN
"RTN","BMXSQL1",69,0)
S J=BMXTK("FROM")
"RTN","BMXSQL1",70,0)
S BMXSTOP=0
"RTN","BMXSQL1",71,0)
F S J=$O(BMXTK(J)) Q:'+J D Q:BMXSTOP
"RTN","BMXSQL1",72,0)
. I $$UCASE(BMXTK(J))="SHOWPLAN" D
"RTN","BMXSQL1",73,0)
. . S BMXTK("SHOWPLAN")="TRUE"
"RTN","BMXSQL1",74,0)
. . K BMXTK(J)
"RTN","BMXSQL1",75,0)
. . S J=J-1
"RTN","BMXSQL1",76,0)
. . S BMXSTOP=1
"RTN","BMXSQL1",77,0)
. Q
"RTN","BMXSQL1",78,0)
;
"RTN","BMXSQL1",79,0)
;MAXRECORDS
"RTN","BMXSQL1",80,0)
S J=BMXTK("FROM")
"RTN","BMXSQL1",81,0)
S BMXSTOP=0
"RTN","BMXSQL1",82,0)
F S J=$O(BMXTK(J)) Q:'+J D Q:BMXSTOP
"RTN","BMXSQL1",83,0)
. I $$UCASE(BMXTK(J))["MAXRECORDS" D
"RTN","BMXSQL1",84,0)
. . S BMXXMAX=+$P(BMXTK(J),":",2)-1
"RTN","BMXSQL1",85,0)
. . S:+BMXXMAX<0 BMXXMAX=0
"RTN","BMXSQL1",86,0)
. . K BMXTK(J)
"RTN","BMXSQL1",87,0)
. . S J=J-1
"RTN","BMXSQL1",88,0)
. . S BMXSTOP=1
"RTN","BMXSQL1",89,0)
. Q
"RTN","BMXSQL1",90,0)
Q
"RTN","BMXSQL1",91,0)
;
"RTN","BMXSQL1",92,0)
SCREEN ;EP
"RTN","BMXSQL1",93,0)
;Set up BMXFG() array of executable screen code
"RTN","BMXSQL1",94,0)
N F,BMXNOD,BMXFNUM,BMXFLDNUM,BMXHIT,BMXREF
"RTN","BMXSQL1",95,0)
N BMXRNAM,BMXRET,BMXOP,Q,BMXPC,BMXV,BMXFLDLO,BMXFLDNO
"RTN","BMXSQL1",96,0)
N BMXGL
"RTN","BMXSQL1",97,0)
S BMXRET=""
"RTN","BMXSQL1",98,0)
S Q=$C(34)
"RTN","BMXSQL1",99,0)
S BMXFG=BMXFF
"RTN","BMXSQL1",100,0)
S BMXFG("C")=0
"RTN","BMXSQL1",101,0)
I 'BMXFF Q
"RTN","BMXSQL1",102,0)
S F=0,BMXHIT=0
"RTN","BMXSQL1",103,0)
F F=1:1:BMXFF S BMXNOD=BMXFF(F) D Q:$D(BMXERR) Q:BMXHIT
"RTN","BMXSQL1",104,0)
. I $G(BMXFF(F,"INDEXED"))=1 D Q
"RTN","BMXSQL1",105,0)
. . S BMXFG(F)="1"
"RTN","BMXSQL1",106,0)
. . Q
"RTN","BMXSQL1",107,0)
. I $D(BMXFF(F,"JOIN")) D Q
"RTN","BMXSQL1",108,0)
. . S BMXFG(F)="1"
"RTN","BMXSQL1",109,0)
. . Q
"RTN","BMXSQL1",110,0)
. I "(^)"[BMXFF(F) D Q
"RTN","BMXSQL1",111,0)
. . S BMXFG(F)=BMXFF(F)
"RTN","BMXSQL1",112,0)
. . Q
"RTN","BMXSQL1",113,0)
. I "AND^OR"[BMXFF(F) D Q
"RTN","BMXSQL1",114,0)
. . I BMXFF(F)="AND" S BMXFG(F)="&" Q
"RTN","BMXSQL1",115,0)
. . S BMXFG(F)="!"
"RTN","BMXSQL1",116,0)
. . Q
"RTN","BMXSQL1",117,0)
. S BMXFNUM=$S(+$P(BMXNOD,U):$P(BMXNOD,U),1:$O(^DIC("B",$P(BMXNOD,U),0)))
"RTN","BMXSQL1",118,0)
. I '+BMXFNUM D ;Not a fileman field
"RTN","BMXSQL1",119,0)
. . S BMXFLDNUM=0,BMXFLDNO=""
"RTN","BMXSQL1",120,0)
. . S BMXFLDLO=$P(BMXFF(F),U,2)
"RTN","BMXSQL1",121,0)
. . ;
"RTN","BMXSQL1",122,0)
. E D ;Get fileman field data
"RTN","BMXSQL1",123,0)
. . S BMXGL=^DIC(BMXFNUM,0,"GL")
"RTN","BMXSQL1",124,0)
. . I $D(BMXFF(F,"IEN")) D
"RTN","BMXSQL1",125,0)
. . . S BMXFLDNUM=".001"
"RTN","BMXSQL1",126,0)
. . . S BMXFLDNO="IEN"
"RTN","BMXSQL1",127,0)
. . E D
"RTN","BMXSQL1",128,0)
. . . S BMXFLDNUM=$O(^DD(BMXFNUM,"B",$P(BMXNOD,U,2),0))
"RTN","BMXSQL1",129,0)
. . . S BMXFLDNO=^DD(BMXFNUM,BMXFLDNUM,0)
"RTN","BMXSQL1",130,0)
. I BMXFLDNO="IEN" D ;BMXIEN field
"RTN","BMXSQL1",131,0)
. . N BMXEXT,C S BMXEXT=0
"RTN","BMXSQL1",132,0)
. . ;S BMXPC=$P(BMXFLDNO,U,4)
"RTN","BMXSQL1",133,0)
. . I $P(BMXFF(F),U,5)'=BMXFO(1) S BMXEXT=1 D EXP ;Extended pointer
"RTN","BMXSQL1",134,0)
. . S BMXFLDLO="D0"
"RTN","BMXSQL1",135,0)
. . I BMXEXT S BMXFG("C",C)=BMXFG("C",C)_BMXFLDLO,BMXFLDLO="BMXSCR(""X"","_C_")"
"RTN","BMXSQL1",136,0)
. I $P(BMXFLDNO,U,2)["D" D ;Date field
"RTN","BMXSQL1",137,0)
. . N BMXEXT,C S BMXEXT=0
"RTN","BMXSQL1",138,0)
. . S BMXPC=$P(BMXFLDNO,U,4)
"RTN","BMXSQL1",139,0)
. . I $P(BMXFF(F),U,5)'=BMXFO(1) S BMXEXT=1 D EXP ;Extended pointer
"RTN","BMXSQL1",140,0)
. . S BMXFLDLO="$P($G("_BMXGL_"D0,"_Q_$P(BMXPC,";")_Q_")),U,"_$P(BMXPC,";",2)_")"
"RTN","BMXSQL1",141,0)
. . I BMXEXT S BMXFG("C",C)=BMXFG("C",C)_BMXFLDLO,BMXFLDLO="BMXSCR(""X"","_C_")"
"RTN","BMXSQL1",142,0)
. I $P(BMXFLDNO,U,2)["S" D ;Set field
"RTN","BMXSQL1",143,0)
. . N BMXEXT,C S BMXEXT=0
"RTN","BMXSQL1",144,0)
. . S BMXPC=$P(BMXFLDNO,U,4)
"RTN","BMXSQL1",145,0)
. . I $P(BMXFF(F),U,5)'=BMXFO(1) S BMXEXT=1 D EXP ;Extended pointer
"RTN","BMXSQL1",146,0)
. . S BMXFLDLO="$P("_BMXGL_"D0,"_$P(BMXPC,";")_"),U,"_$P(BMXPC,";",2)_")"
"RTN","BMXSQL1",147,0)
. . I BMXEXT S BMXFG("C",C)=BMXFG("C",C)_BMXFLDLO,BMXFLDLO="BMXSCR(""X"","_C_")"
"RTN","BMXSQL1",148,0)
. ;
"RTN","BMXSQL1",149,0)
. I $P(BMXFLDNO,U,2)["P" D ;Pointer field
"RTN","BMXSQL1",150,0)
. . N C,BMXEXT
"RTN","BMXSQL1",151,0)
. . S BMXEXT=0
"RTN","BMXSQL1",152,0)
. . I $P(BMXFF(F),U,5)'=BMXFO(1) D
"RTN","BMXSQL1",153,0)
. . . N R,G,BMXJN,BMXMSCR
"RTN","BMXSQL1",154,0)
. . . S BMXMXCR=1 ;Remove after testing. Find out if the field is from a subfile.
"RTN","BMXSQL1",155,0)
. . . I BMXMXCR D Q
"RTN","BMXSQL1",156,0)
. . . . ;Set up a screen in BMXSCR and in BMXMFL(
"RTN","BMXSQL1",157,0)
. . . . Q
"RTN","BMXSQL1",158,0)
. . . ;
"RTN","BMXSQL1",159,0)
. . . ;Find the node of BMXFF that has the join info
"RTN","BMXSQL1",160,0)
. . . S BMXEXT=1
"RTN","BMXSQL1",161,0)
. . . S BMXFG("C")=BMXFG("C")+1
"RTN","BMXSQL1",162,0)
. . . S C=BMXFG("C")
"RTN","BMXSQL1",163,0)
. . . S R=0 F S R=$O(BMXFJ("JOIN",R)) Q:'+R I R=$P(BMXFF(F),U,5) S G=BMXFJ("JOIN",R) Q
"RTN","BMXSQL1",164,0)
. . . S BMXJN=BMXFF(G,"JOIN")
"RTN","BMXSQL1",165,0)
. . . S BMXJN=$P(BMXJN,"IEN0",1)_"D0"_$P(BMXJN,"IEN0",2)
"RTN","BMXSQL1",166,0)
. . . S BMXJN="S X="""","_BMXFF(G,"JOIN","IEN")_"=D0 N D0 "_BMXJN_"I +D0 S X="
"RTN","BMXSQL1",167,0)
. . . S BMXFG("C",C)=BMXJN
"RTN","BMXSQL1",168,0)
. . S BMXFLDLO=$$SCRNP(F,BMXGL,BMXFLDNUM,BMXFLDNO)
"RTN","BMXSQL1",169,0)
. . I BMXEXT S BMXFG("C",C)=BMXFG("C",C)_BMXFLDLO,BMXFLDLO="BMXSCR(""X"","_C_")"
"RTN","BMXSQL1",170,0)
. I $P(BMXFLDNO,U,2)["C" D ;Computed field
"RTN","BMXSQL1",171,0)
. . N C
"RTN","BMXSQL1",172,0)
. . S BMXPC=$P(BMXFLDNO,U,5,99)
"RTN","BMXSQL1",173,0)
. . S BMXFG("C")=BMXFG("C")+1
"RTN","BMXSQL1",174,0)
. . S C=BMXFG("C")
"RTN","BMXSQL1",175,0)
. . ;If computed field not in primary file, connect navigation code
"RTN","BMXSQL1",176,0)
. . I $P(BMXFF(F),U,5)'=BMXFO(1) D
"RTN","BMXSQL1",177,0)
. . . ;Find the node of BMXFF that has the join info
"RTN","BMXSQL1",178,0)
. . . N R,G,BMXJN
"RTN","BMXSQL1",179,0)
. . . S R=0 F S R=$O(BMXFJ("JOIN",R)) Q:'+R I R=$P(BMXFF(F),U,5) S G=BMXFJ("JOIN",R) Q
"RTN","BMXSQL1",180,0)
. . . S BMXJN=BMXFF(G,"JOIN")
"RTN","BMXSQL1",181,0)
. . . S BMXJN=$P(BMXJN,"IEN0",1)_"D0"_$P(BMXJN,"IEN0",2)
"RTN","BMXSQL1",182,0)
. . . S BMXJN="S X="""","_BMXFF(G,"JOIN","IEN")_"=D0 N D0 "_BMXJN_"I +D0 "
"RTN","BMXSQL1",183,0)
. . . S BMXJN=BMXJN_BMXPC
"RTN","BMXSQL1",184,0)
. . . S BMXFF(F,0)=$P(BMXFF(F,0),U,1,4)
"RTN","BMXSQL1",185,0)
. . . S $P(BMXFF(F,0),U,5)=BMXJN
"RTN","BMXSQL1",186,0)
. . . S BMXPC=BMXJN
"RTN","BMXSQL1",187,0)
. . S BMXFG("C",C)=BMXPC
"RTN","BMXSQL1",188,0)
. . S BMXFLDLO="BMXSCR(""X"","_C_")"
"RTN","BMXSQL1",189,0)
. I $P(BMXFLDNO,U,2)["N" D ;Numeric field
"RTN","BMXSQL1",190,0)
. . N BMXEXT,C S BMXEXT=0
"RTN","BMXSQL1",191,0)
. . S BMXPC=$P(BMXFLDNO,U,4)
"RTN","BMXSQL1",192,0)
. . I $P(BMXFF(F),U,5)'=BMXFO(1) S BMXEXT=1 D EXP ;Extended pointer
"RTN","BMXSQL1",193,0)
. . S BMXFLDLO="$P("_BMXGL_"D0,"_$P(BMXPC,";")_"),U,"_$P(BMXPC,";",2)_")"
"RTN","BMXSQL1",194,0)
. . I BMXEXT S BMXFG("C",C)=BMXFG("C",C)_BMXFLDLO,BMXFLDLO="BMXSCR(""X"","_C_")"
"RTN","BMXSQL1",195,0)
. ;
"RTN","BMXSQL1",196,0)
. I $P(BMXFLDNO,U,2)["F" D ;Free Text field
"RTN","BMXSQL1",197,0)
. . N BMXEXT,C S BMXEXT=0,C=0
"RTN","BMXSQL1",198,0)
. . S BMXPC=$P(BMXFLDNO,U,4)
"RTN","BMXSQL1",199,0)
. . I $P(BMXFF(F),U,5)'=BMXFO(1) S BMXEXT=1 D
"RTN","BMXSQL1",200,0)
. . . N R,G,BMXJN
"RTN","BMXSQL1",201,0)
. . . S BMXFG("C")=BMXFG("C")+1
"RTN","BMXSQL1",202,0)
. . . S C=BMXFG("C")
"RTN","BMXSQL1",203,0)
. . . S R=0 F S R=$O(BMXFJ("JOIN",R)) Q:'+R I R=$P(BMXFF(F),U,5) S G=BMXFJ("JOIN",R) Q
"RTN","BMXSQL1",204,0)
. . . S BMXJN=BMXFF(G,"JOIN")
"RTN","BMXSQL1",205,0)
. . . S BMXJN=$P(BMXJN,"IEN0",1)_"D0"_$P(BMXJN,"IEN0",2)
"RTN","BMXSQL1",206,0)
. . . S BMXJN="S X="""","_BMXFF(G,"JOIN","IEN")_"=D0 N D0 "_BMXJN
"RTN","BMXSQL1",207,0)
. . . S BMXJN=BMXJN_"I +D0 S X="
"RTN","BMXSQL1",208,0)
. . . S BMXFG("C",C)=BMXJN
"RTN","BMXSQL1",209,0)
. . . S BMXFLDLO="BMXSCR(""X"","_C_")"
"RTN","BMXSQL1",210,0)
. . I $P(BMXFLDNO,U,4)["E" D
"RTN","BMXSQL1",211,0)
. . . N BMXPC2,BMXTMP
"RTN","BMXSQL1",212,0)
. . . S BMXPC2=$P(BMXPC,"E",2)
"RTN","BMXSQL1",213,0)
. . . S BMXTMP="$E("_BMXGL_"D0,"_$P(BMXPC,";")_"),"_$P(BMXPC2,",")_","_$P(BMXPC2,",",2)_")"
"RTN","BMXSQL1",214,0)
. . . I BMXEXT S BMXFG("C",C)=BMXFG("C",C)_BMXTMP
"RTN","BMXSQL1",215,0)
. . . E S BMXFLDLO=BMXTMP
"RTN","BMXSQL1",216,0)
. . E D
"RTN","BMXSQL1",217,0)
. . . N BMXTMP
"RTN","BMXSQL1",218,0)
. . . S BMXTMP="$P("_BMXGL_"D0,"_$P(BMXPC,";")_"),U,"_$P(BMXPC,";",2)_")"
"RTN","BMXSQL1",219,0)
. . . S BMXTMP="$S($D("_BMXGL_"D0,"_$P(BMXPC,";")_")):"_BMXTMP_",1:"""")"
"RTN","BMXSQL1",220,0)
. . . I BMXEXT S BMXFG("C",C)=BMXFG("C",C)_BMXTMP
"RTN","BMXSQL1",221,0)
. . . E S BMXFLDLO=BMXTMP
"RTN","BMXSQL1",222,0)
. ;
"RTN","BMXSQL1",223,0)
. S BMXOP=$P(BMXNOD,U,3)
"RTN","BMXSQL1",224,0)
. S BMXV=$P(BMXFF(F),U,4)
"RTN","BMXSQL1",225,0)
. I "<^>^=^["[BMXOP D
"RTN","BMXSQL1",226,0)
. . I BMXOP=">",BMXV?.A S BMXOP="]"
"RTN","BMXSQL1",227,0)
. . I BMXOP="<",BMXV?.A S BMXOP="']"
"RTN","BMXSQL1",228,0)
. . S BMXRET="("_BMXFLDLO_BMXOP_Q_BMXV_Q_")"
"RTN","BMXSQL1",229,0)
. . Q
"RTN","BMXSQL1",230,0)
. I "<>"=BMXOP D
"RTN","BMXSQL1",231,0)
. . S BMXOP="'="
"RTN","BMXSQL1",232,0)
. . S BMXRET="("_BMXFLDLO_BMXOP_Q_BMXV_Q_")"
"RTN","BMXSQL1",233,0)
. I ">="=BMXOP D
"RTN","BMXSQL1",234,0)
. . I BMXV="" S BMXRET="(I 1)" Q
"RTN","BMXSQL1",235,0)
. . I +BMXV=BMXV D Q
"RTN","BMXSQL1",236,0)
. . . S BMXOP="'<"
"RTN","BMXSQL1",237,0)
. . . S BMXRET="("_BMXFLDLO_BMXOP_Q_BMXV_Q_")"
"RTN","BMXSQL1",238,0)
. . S BMXV=$$DECSTR^BMXSQL2(BMXV)
"RTN","BMXSQL1",239,0)
. . S BMXOP="]"
"RTN","BMXSQL1",240,0)
. . S BMXRET="("_BMXFLDLO_BMXOP_Q_BMXV_Q_")"
"RTN","BMXSQL1",241,0)
. I "<="=BMXOP D
"RTN","BMXSQL1",242,0)
. . I BMXV="" S BMXRET="(I 0)" Q
"RTN","BMXSQL1",243,0)
. . I +BMXV=BMXV D Q
"RTN","BMXSQL1",244,0)
. . . S BMXOP="'>"
"RTN","BMXSQL1",245,0)
. . . S BMXRET="("_BMXFLDLO_BMXOP_Q_BMXV_Q_")"
"RTN","BMXSQL1",246,0)
. . S BMXV=$$INCSTR^BMXSQL2(BMXV)
"RTN","BMXSQL1",247,0)
. . S BMXOP="']"
"RTN","BMXSQL1",248,0)
. . S BMXRET="("_BMXFLDLO_BMXOP_Q_BMXV_Q_")"
"RTN","BMXSQL1",249,0)
. I BMXOP="BETWEEN" D
"RTN","BMXSQL1",250,0)
. . I +$P(BMXV,"~")'=$P(BMXV,"~") D ;BMXV a string
"RTN","BMXSQL1",251,0)
. . . N W,X,Y,Z
"RTN","BMXSQL1",252,0)
. . . S X=$P(BMXV,"~")
"RTN","BMXSQL1",253,0)
. . . S Y=$E(X,1,$L(X)-1)
"RTN","BMXSQL1",254,0)
. . . S Z=$E(X,$L(X))
"RTN","BMXSQL1",255,0)
. . . S Z=$A(Z)
"RTN","BMXSQL1",256,0)
. . . S Z=Z-1
"RTN","BMXSQL1",257,0)
. . . S Z=$C(Z)
"RTN","BMXSQL1",258,0)
. . . S W=Y_Z
"RTN","BMXSQL1",259,0)
. . . S $P(BMXV,"~")=W
"RTN","BMXSQL1",260,0)
. . . S BMXRET="(("_BMXFLDLO_"]"_Q_$P(BMXV,"~")_Q_")&("_BMXFLDLO_"']"_Q_$P(BMXV,"~",2)_Q_"))"
"RTN","BMXSQL1",261,0)
. . E D ;BMXV a number
"RTN","BMXSQL1",262,0)
. . . S BMXRET="(("_BMXFLDLO_"'<"_$P(BMXV,"~")_")&("_BMXFLDLO_"'>"_$P(BMXV,"~",2)_"))"
"RTN","BMXSQL1",263,0)
. . Q
"RTN","BMXSQL1",264,0)
. I BMXOP="LIKE" D
"RTN","BMXSQL1",265,0)
. . S BMXRET="("_BMXFLDLO_"?1"_Q_BMXV_Q_".E)"
"RTN","BMXSQL1",266,0)
. I BMXRET]"" D
"RTN","BMXSQL1",267,0)
. . S BMXFG(F)=BMXRET
"RTN","BMXSQL1",268,0)
. . Q
"RTN","BMXSQL1",269,0)
. ;TODO: Pointer fields
"RTN","BMXSQL1",270,0)
. ;TODO: Computed fields
"RTN","BMXSQL1",271,0)
. ;TODO: Sets of codes
"RTN","BMXSQL1",272,0)
. ;TODO: Dates
"RTN","BMXSQL1",273,0)
. Q
"RTN","BMXSQL1",274,0)
Q
"RTN","BMXSQL1",275,0)
;
"RTN","BMXSQL1",276,0)
SCRNP(F,BMXGL,BMXFLDNU,BMXFLDNO) ;
"RTN","BMXSQL1",277,0)
;Requires BMXFF()
"RTN","BMXSQL1",278,0)
;Sets up expression for pointer field
"RTN","BMXSQL1",279,0)
N BMX,BMXCOR,BMXRET,BMXPC
"RTN","BMXSQL1",280,0)
S BMXPC=$P(BMXFLDNO,U,4)
"RTN","BMXSQL1",281,0)
S BMXCOR="$P($G("_BMXGL_"D0,"_Q_$P(BMXPC,";")_Q_")),U,"_$P(BMXPC,";",2)_")"
"RTN","BMXSQL1",282,0)
S BMXRET=BMXCOR
"RTN","BMXSQL1",283,0)
Q:$D(BMXFF(F,"INTERNAL")) BMXRET
"RTN","BMXSQL1",284,0)
S BMXFNUM=$P(BMXFLDNO,U,2)
"RTN","BMXSQL1",285,0)
S BMXFNUM=+$P(BMXFNUM,"P",2)
"RTN","BMXSQL1",286,0)
S BMXGL=^DIC(BMXFNUM,0,"GL")
"RTN","BMXSQL1",287,0)
S BMXFLDNUM=".01"
"RTN","BMXSQL1",288,0)
S BMXFLDNO=^DD(BMXFNUM,BMXFLDNUM,0)
"RTN","BMXSQL1",289,0)
F D:$P(BMXFLDNO,U,2)["P" Q:$P(BMXFLDNO,U,2)'["P"
"RTN","BMXSQL1",290,0)
. S BMXPC=$P(BMXFLDNO,U,4)
"RTN","BMXSQL1",291,0)
. S BMXRET="$P($G("_BMXGL_BMXRET_","_Q_$P(BMXPC,";")_Q_")),U,"_$P(BMXPC,";",2)_")"
"RTN","BMXSQL1",292,0)
. S BMXFNUM=$P(BMXFLDNO,U,2)
"RTN","BMXSQL1",293,0)
. S BMXFNUM=+$P(BMXFNUM,"P",2)
"RTN","BMXSQL1",294,0)
. S BMXGL=^DIC(BMXFNUM,0,"GL")
"RTN","BMXSQL1",295,0)
. S BMXFLDNUM=".01"
"RTN","BMXSQL1",296,0)
. S BMXFLDNO=^DD(BMXFNUM,BMXFLDNUM,0)
"RTN","BMXSQL1",297,0)
;B ;SCRN2 After chain
"RTN","BMXSQL1",298,0)
;I 0 D ;$P(BMXFLDNO,U,2)["D" D ;Pointer to a date
"RTN","BMXSQL1",299,0)
;. Q:+$G(BMXFF(F,"INDEXED")) ;Dates converted when iterator built
"RTN","BMXSQL1",300,0)
;. N BMXD,J
"RTN","BMXSQL1",301,0)
;. S BMXD=$P(BMXFF(F),U,4)
"RTN","BMXSQL1",302,0)
;. S %DT="T"
"RTN","BMXSQL1",303,0)
;. F J=1:1:$L(BMXD,"~") D
"RTN","BMXSQL1",304,0)
;. . S X=$P(BMXD,"~",J)
"RTN","BMXSQL1",305,0)
;. . D ^%DT
"RTN","BMXSQL1",306,0)
;. . S $P(BMXD,"~",J)=Y
"RTN","BMXSQL1",307,0)
;. S $P(BMXFF(F),U,4)=BMXD
"RTN","BMXSQL1",308,0)
S BMXRET="$P($G("_BMXGL_BMXRET_",0)),U,1)"
"RTN","BMXSQL1",309,0)
S BMXRET="$S(+"_BMXCOR_":"_BMXRET_",1:"""")"
"RTN","BMXSQL1",310,0)
Q BMXRET
"RTN","BMXSQL1",311,0)
;
"RTN","BMXSQL1",312,0)
CASE(BMXTK) ;EP
"RTN","BMXSQL1",313,0)
;Convert keywords to uppercase
"RTN","BMXSQL1",314,0)
N J
"RTN","BMXSQL1",315,0)
S J=0
"RTN","BMXSQL1",316,0)
F S J=$O(BMXTK(J)) Q:'+J D
"RTN","BMXSQL1",317,0)
. F K="DISTINCT","SELECT","WHERE","FROM","SHOWPLAN" D
"RTN","BMXSQL1",318,0)
. . I $$UCASE(BMXTK(J))=K S BMXTK(J)=$$UCASE(BMXTK(J))
"RTN","BMXSQL1",319,0)
. Q
"RTN","BMXSQL1",320,0)
Q
"RTN","BMXSQL1",321,0)
;
"RTN","BMXSQL1",322,0)
UCASE(X) ;EP Convert X to uppercase
"RTN","BMXSQL1",323,0)
F %=1:1:$L(X) S:$E(X,%)?1L X=$E(X,0,%-1)_$C($A(X,%)-32)_$E(X,%+1,999)
"RTN","BMXSQL1",324,0)
Q X
"RTN","BMXSQL1",325,0)
;
"RTN","BMXSQL1",326,0)
EXP ;Extended pointer
"RTN","BMXSQL1",327,0)
N R,G,BMXJN
"RTN","BMXSQL1",328,0)
S BMXEXT=1
"RTN","BMXSQL1",329,0)
S BMXFG("C")=BMXFG("C")+1
"RTN","BMXSQL1",330,0)
S C=BMXFG("C")
"RTN","BMXSQL1",331,0)
S R=0 F S R=$O(BMXFJ("JOIN",R)) Q:'+R I R=$P(BMXFF(F),U,5) S G=BMXFJ("JOIN",R) Q
"RTN","BMXSQL1",332,0)
S BMXJN=BMXFF(G,"JOIN")
"RTN","BMXSQL1",333,0)
S BMXJN=$P(BMXJN,"IEN0",1)_"D0"_$P(BMXJN,"IEN0",2)
"RTN","BMXSQL1",334,0)
S BMXJN="S X="""","_BMXFF(G,"JOIN","IEN")_"=D0 N D0 "_BMXJN_"I +D0 S X="
"RTN","BMXSQL1",335,0)
S BMXFG("C",C)=BMXJN
"RTN","BMXSQL1",336,0)
Q
"RTN","BMXSQL2")
0^99^B9590811
"RTN","BMXSQL2",1,0)
BMXSQL2 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
"RTN","BMXSQL2",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXSQL2",3,0)
;
"RTN","BMXSQL2",4,0)
;
"RTN","BMXSQL2",5,0)
FLDFILE(BMXIN) ;EP - Returns name of file containing field BMXIN
"RTN","BMXSQL2",6,0)
;in the form FILE^FIELD^FILENUMBER^FIELDNUMBER
"RTN","BMXSQL2",7,0)
;Based on data contained in the BMXF() array
"RTN","BMXSQL2",8,0)
;BMXIN can be either an unambiguous field name or FILE.FIELDNAME
"RTN","BMXSQL2",9,0)
;
"RTN","BMXSQL2",10,0)
N C,BMXA,BMXB,BMXRET,BMXFILN,BMXFLDN,BMXFILNA
"RTN","BMXSQL2",11,0)
S BMXRET=""
"RTN","BMXSQL2",12,0)
I BMXTMPLT D Q BMXRET
"RTN","BMXSQL2",13,0)
. S BMXFILNA=BMXIN
"RTN","BMXSQL2",14,0)
. I '$D(BMXF(BMXFILNA)) S BMXERR="FILE NOT FOUND" S BMXRET="" D ERROR^BMXSQL Q
"RTN","BMXSQL2",15,0)
. I BMXF(BMXFILNA)'=BMXFO(1) S BMXERR="TEMPLATES ONLY SUPPORTED ON PRIMARY FILE" D ERROR^BMXSQL Q
"RTN","BMXSQL2",16,0)
. S BMXRET=BMXFILNA_U_"BMXIEN"_U_BMXF(BMXFILNA)_U_".001"
"RTN","BMXSQL2",17,0)
;
"RTN","BMXSQL2",18,0)
I BMXIN["." D Q BMXRET
"RTN","BMXSQL2",19,0)
. S BMXFILNA=$P(BMXIN,".") ;File Name
"RTN","BMXSQL2",20,0)
. I '$D(BMXF(BMXFILNA)) S BMXERR="FILE NOT FOUND" S BMXRET="" D ERROR^BMXSQL Q
"RTN","BMXSQL2",21,0)
. S BMXRET=BMXFILNA_U_$P(BMXIN,".",2)
"RTN","BMXSQL2",22,0)
. S $P(BMXRET,U,3)=BMXF(BMXFILNA)
"RTN","BMXSQL2",23,0)
. S BMXFLDN=0
"RTN","BMXSQL2",24,0)
. I $P(BMXIN,".",2)'="",$D(^DD(BMXF(BMXFILNA),"B",$P(BMXIN,".",2))) D
"RTN","BMXSQL2",25,0)
. . S BMXFLDN=$O(^DD(BMXF(BMXFILNA),"B",$P(BMXIN,".",2),0))
"RTN","BMXSQL2",26,0)
. I BMXIN["BMXIEN" S BMXFLDN=".001"
"RTN","BMXSQL2",27,0)
. I '+BMXFLDN S BMXERR="FIELD NOT FOUND",BMXRET="" D ERROR^BMXSQL Q
"RTN","BMXSQL2",28,0)
. S $P(BMXRET,U,4)=BMXFLDN
"RTN","BMXSQL2",29,0)
. Q
"RTN","BMXSQL2",30,0)
;Loop through files in BMXF to locate field name
"RTN","BMXSQL2",31,0)
S C=0,BMXA=""
"RTN","BMXSQL2",32,0)
I 'BMXIEN F S BMXA=$O(BMXF(BMXA)) Q:BMXA="" D Q:$D(BMXERR)
"RTN","BMXSQL2",33,0)
. I $D(^DD(BMXF(BMXA),"B",BMXIN)) S BMXRET=BMXA_U_BMXIN D Q:$D(BMXERR)
"RTN","BMXSQL2",34,0)
. . S C=C+1
"RTN","BMXSQL2",35,0)
. . I C>1 S BMXERR="AMBIGUOUS FIELD NAME" D ERROR^BMXSQL Q
"RTN","BMXSQL2",36,0)
. . Q
"RTN","BMXSQL2",37,0)
. Q
"RTN","BMXSQL2",38,0)
I BMXIEN D
"RTN","BMXSQL2",39,0)
. S BMXA=BMXFO(1)
"RTN","BMXSQL2",40,0)
. S BMXA=BMXFNX(BMXA)
"RTN","BMXSQL2",41,0)
. S BMXRET=BMXA_U_BMXIN
"RTN","BMXSQL2",42,0)
. S C=1
"RTN","BMXSQL2",43,0)
I C=0 D Q BMXRET
"RTN","BMXSQL2",44,0)
. S BMXRET="0^"_BMXIN ;String or numeric literal
"RTN","BMXSQL2",45,0)
S BMXFILNA=$P(BMXRET,U)
"RTN","BMXSQL2",46,0)
S BMXFILN=BMXF(BMXFILNA)
"RTN","BMXSQL2",47,0)
S $P(BMXRET,U,3)=BMXFILN
"RTN","BMXSQL2",48,0)
I $D(^DD(BMXFILN,"B",BMXIN)) D
"RTN","BMXSQL2",49,0)
. S BMXFLDN=$O(^DD(BMXFILN,"B",BMXIN,0))
"RTN","BMXSQL2",50,0)
I BMXIEN S BMXFLDN=".001"
"RTN","BMXSQL2",51,0)
I '+BMXFLDN S BMXERR="FIELD NOT FOUND",BMXRET="" D ERROR^BMXSQL Q
"RTN","BMXSQL2",52,0)
S $P(BMXRET,U,4)=BMXFLDN
"RTN","BMXSQL2",53,0)
Q BMXRET
"RTN","BMXSQL2",54,0)
;
"RTN","BMXSQL2",55,0)
DECSTR(BMXSTR) ;EP
"RTN","BMXSQL2",56,0)
;Decrements string collation value by 1
"RTN","BMXSQL2",57,0)
;
"RTN","BMXSQL2",58,0)
N A,E,S,L,BMXRET
"RTN","BMXSQL2",59,0)
I BMXSTR="" Q BMXSTR
"RTN","BMXSQL2",60,0)
S L=$L(BMXSTR)
"RTN","BMXSQL2",61,0)
S E=$E(BMXSTR,L)
"RTN","BMXSQL2",62,0)
S B=$E(BMXSTR,1,L-1)
"RTN","BMXSQL2",63,0)
S A=$A(E)
"RTN","BMXSQL2",64,0)
S A=A-1
"RTN","BMXSQL2",65,0)
S E=$C(A)
"RTN","BMXSQL2",66,0)
S BMXRET=B_E
"RTN","BMXSQL2",67,0)
Q BMXRET
"RTN","BMXSQL2",68,0)
;
"RTN","BMXSQL2",69,0)
INCSTR(BMXSTR) ;EP
"RTN","BMXSQL2",70,0)
;Increments string collation value by 1
"RTN","BMXSQL2",71,0)
Q BMXSTR_$C(1)
"RTN","BMXSQL2",72,0)
;
"RTN","BMXSQL2",73,0)
SETX(BMXX,BMXFG,BMXSCR) ;EP
"RTN","BMXSQL2",74,0)
;Set up executable screen code
"RTN","BMXSQL2",75,0)
;by assembling pieces in BMXFG
"RTN","BMXSQL2",76,0)
;and attach to executable iterator(s)
"RTN","BMXSQL2",77,0)
;
"RTN","BMXSQL2",78,0)
;IN: BMXFG()
"RTN","BMXSQL2",79,0)
; BMXX() -- modified
"RTN","BMXSQL2",80,0)
;OUT: BMXSCR
"RTN","BMXSQL2",81,0)
;
"RTN","BMXSQL2",82,0)
N J
"RTN","BMXSQL2",83,0)
Q:'$D(BMXFG)
"RTN","BMXSQL2",84,0)
S BMXSCR=""
"RTN","BMXSQL2",85,0)
S J=0 F S J=$O(BMXX(J)) Q:'+J D
"RTN","BMXSQL2",86,0)
. S BMXX(J)=BMXX(J)_"X BMXSCR"
"RTN","BMXSQL2",87,0)
F J=1:1:BMXFG S BMXSCR=BMXSCR_BMXFG(J)
"RTN","BMXSQL2",88,0)
S BMXSCR=$S(BMXSCR]"":"I "_BMXSCR_" ",1:"")
"RTN","BMXSQL2",89,0)
S BMXSCR=BMXSCR_"D:'$D(^BMXTMP($J,""O"",D0)) OUT^BMXSQL"
"RTN","BMXSQL2",90,0)
I BMXFG("C") D
"RTN","BMXSQL2",91,0)
. N C
"RTN","BMXSQL2",92,0)
. S C=BMXFG("C")
"RTN","BMXSQL2",93,0)
. S BMXSCR("C")="F BMXC=1:1:"_C_" X BMXSCR(""C"",BMXC) S BMXSCR(""X"",BMXC)=X"
"RTN","BMXSQL2",94,0)
. F C=1:1:BMXFG("C") S BMXSCR("C",C)=BMXFG("C",C)
"RTN","BMXSQL2",95,0)
. S BMXSCR="X BMXSCR(""C"") "_BMXSCR
"RTN","BMXSQL2",96,0)
;
"RTN","BMXSQL2",97,0)
Q
"RTN","BMXSQL3")
0^100^B190410807
"RTN","BMXSQL3",1,0)
BMXSQL3 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
"RTN","BMXSQL3",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXSQL3",3,0)
;
"RTN","BMXSQL3",4,0)
;
"RTN","BMXSQL3",5,0)
PLEVEL(BMXFF,BMXLVL,BMXRET) ;EP
"RTN","BMXSQL3",6,0)
;Analyze WHERE statement according to paren level
"RTN","BMXSQL3",7,0)
;Return a string to guide building of iterator(s)
"RTN","BMXSQL3",8,0)
;
"RTN","BMXSQL3",9,0)
;Basically, count the number of OR clauses on the
"RTN","BMXSQL3",10,0)
;same paren level
"RTN","BMXSQL3",11,0)
;IN: BMXFF()
"RTN","BMXSQL3",12,0)
;OUT: BMXLVL(), BMXRET
"RTN","BMXSQL3",13,0)
;
"RTN","BMXSQL3",14,0)
;BMXRET = 1&/!2&/!...&/!n clauses
"RTN","BMXSQL3",15,0)
;BMXLVL(E,"BEGIN")=Index where element E begins
"RTN","BMXSQL3",16,0)
;BMXLVL(E,"END") =Index where element E ends
"RTN","BMXSQL3",17,0)
;BMXLVL(E,"ELEMENTS")=Number of subelements in element E
"RTN","BMXSQL3",18,0)
;
"RTN","BMXSQL3",19,0)
N BMXNOR,BMXNAND,J,C,BMXTMP
"RTN","BMXSQL3",20,0)
N E,L,BMXCNT
"RTN","BMXSQL3",21,0)
;Test for no ORs or no ANDs
"RTN","BMXSQL3",22,0)
S BMXNOR=1,BMXNAND=1
"RTN","BMXSQL3",23,0)
S J=0 F S J=$O(BMXFF(J)) Q:'+J D ;Q:'BMXNOR Q:'BMXNAND
"RTN","BMXSQL3",24,0)
. I BMXFF(J)="OR" S BMXNOR=0
"RTN","BMXSQL3",25,0)
. I BMXFF(J)="AND" S BMXNAND=0
"RTN","BMXSQL3",26,0)
. Q
"RTN","BMXSQL3",27,0)
;If no ORs or no ANDs then take all parens out of BMXFF
"RTN","BMXSQL3",28,0)
I ((BMXNOR)!(BMXNAND)) D
"RTN","BMXSQL3",29,0)
. S:$D(BMXFF("INDEX")) BMXTMP("INDEX")=BMXFF("INDEX")
"RTN","BMXSQL3",30,0)
. S J=0,C=0 F S J=$O(BMXFF(J)) Q:'+J D:"(^)"'[BMXFF(J)
"RTN","BMXSQL3",31,0)
. . S C=C+1
"RTN","BMXSQL3",32,0)
. . S BMXTMP(C)=BMXFF(J)
"RTN","BMXSQL3",33,0)
. . S:$D(BMXFF(J,0)) BMXTMP(C,0)=BMXFF(J,0)
"RTN","BMXSQL3",34,0)
. . S:$D(BMXFF(J,"INTERNAL")) BMXTMP(J,"INTERNAL")=BMXFF(J,"INTERNAL")
"RTN","BMXSQL3",35,0)
. . S:$D(BMXFF(J,"TYPE")) BMXTMP(C,"TYPE")=BMXFF(J,"TYPE")
"RTN","BMXSQL3",36,0)
. . S:$D(BMXFF(J,"IEN")) BMXTMP(C,"IEN")=BMXFF(J,"IEN")
"RTN","BMXSQL3",37,0)
. . S:$D(BMXFF(J,"JOIN")) BMXTMP(C,"JOIN")=BMXFF(J,"JOIN")
"RTN","BMXSQL3",38,0)
. . S:$D(BMXFF(J,"JOIN","IEN")) BMXTMP(C,"JOIN","IEN")=BMXFF(J,"JOIN","IEN")
"RTN","BMXSQL3",39,0)
. . ;I $D(BMXFF(J,"JOIN")) D
"RTN","BMXSQL3",40,0)
. . ;. N K S K=0 F S K=$O(BMXFF(J,"JOIN",K)) Q:'+K D
"RTN","BMXSQL3",41,0)
. . ;. . N L S L=0 F S L=$O(BMXFF(J,"JOIN",K,L)) Q:'+L D
"RTN","BMXSQL3",42,0)
. . ;. . . S BMXTMP(C,"JOIN",K,L)=BMXFF(J,"JOIN",K,L)
"RTN","BMXSQL3",43,0)
. . I $D(BMXFF(J,"SET")) D
"RTN","BMXSQL3",44,0)
. . . N BMXSS
"RTN","BMXSQL3",45,0)
. . . S BMXSS="" F S BMXSS=$O(BMXFF(J,"SET",BMXSS)) Q:BMXSS="" D
"RTN","BMXSQL3",46,0)
. . . . S BMXTMP(C,"SET",BMXSS)=BMXFF(J,"SET",BMXSS)
"RTN","BMXSQL3",47,0)
. K BMXFF
"RTN","BMXSQL3",48,0)
. I $D(BMXTMP("INDEX")) S BMXFF("INDEX")=BMXTMP("INDEX")
"RTN","BMXSQL3",49,0)
. S J=0 F S J=$O(BMXTMP(J)) Q:'+J D
"RTN","BMXSQL3",50,0)
. . S BMXFF(J)=BMXTMP(J)
"RTN","BMXSQL3",51,0)
. . S:$D(BMXTMP(J,0)) BMXFF(J,0)=BMXTMP(J,0)
"RTN","BMXSQL3",52,0)
. . S:$D(BMXTMP(J,"TYPE")) BMXFF(J,"TYPE")=BMXTMP(J,"TYPE")
"RTN","BMXSQL3",53,0)
. . I $D(BMXTMP(J,"JOIN")) S BMXFF(J,"JOIN")=BMXTMP(J,"JOIN") S:$D(BMXTMP(J,"JOIN","IEN")) BMXFF(J,"JOIN","IEN")=BMXTMP(J,"JOIN","IEN") S BMXFJ("JOIN",+$P($P(BMXFF(J,0),U,2),"P",2))=J
"RTN","BMXSQL3",54,0)
. . ;I $D(BMXTMP(J,"JOIN")) D
"RTN","BMXSQL3",55,0)
. . ;. N K S K=0 F S K=$O(BMXTMP(J,"JOIN",K)) Q:'+K D
"RTN","BMXSQL3",56,0)
. . ;. . N L S L=0 F S L=$O(BMXTMP(J,"JOIN",K,L)) Q:'+L D
"RTN","BMXSQL3",57,0)
. . ;. . . S BMXFF(J,"JOIN",K,L)=BMXTMP(J,"JOIN",K,L)
"RTN","BMXSQL3",58,0)
. . I $D(BMXTMP(J,"SET")) D
"RTN","BMXSQL3",59,0)
. . . N BMXSS
"RTN","BMXSQL3",60,0)
. . . S BMXSS="" F S BMXSS=$O(BMXTMP(J,"SET",BMXSS)) Q:BMXSS="" D
"RTN","BMXSQL3",61,0)
. . . . S BMXFF(J,"SET",BMXSS)=BMXTMP(J,"SET",BMXSS)
"RTN","BMXSQL3",62,0)
. . I $D(BMXTMP(J,"INTERNAL")) S BMXFF(J,"INTERNAL")=BMXTMP(J,"INTERNAL")
"RTN","BMXSQL3",63,0)
. . I $D(BMXTMP(J,"IEN")) S BMXFF(J,"IEN")=BMXTMP(J,"IEN")
"RTN","BMXSQL3",64,0)
. S BMXFF=C
"RTN","BMXSQL3",65,0)
. Q
"RTN","BMXSQL3",66,0)
;
"RTN","BMXSQL3",67,0)
;Remove excess leading and trailing parens
"RTN","BMXSQL3",68,0)
;Find close paren corresponding to BMXFF(1)
"RTN","BMXSQL3",69,0)
;If its the last paren, then remove the first and last parens
"RTN","BMXSQL3",70,0)
;Else, quit
"RTN","BMXSQL3",71,0)
N BMXEND
"RTN","BMXSQL3",72,0)
S BMXEND=0
"RTN","BMXSQL3",73,0)
F Q:'((BMXFF(1)="(")&(BMXFF(BMXFF)=")")) Q:BMXEND D
"RTN","BMXSQL3",74,0)
. S L=1,J=1
"RTN","BMXSQL3",75,0)
. F S J=$O(BMXFF(J)) Q:'+J D:"(^)"[BMXFF(J) Q:BMXEND
"RTN","BMXSQL3",76,0)
. . I BMXFF(J)="(" S L=L+1 Q
"RTN","BMXSQL3",77,0)
. . I BMXFF(J)=")" S L=L-1
"RTN","BMXSQL3",78,0)
. . I L=0,J<BMXFF S BMXEND=1 Q
"RTN","BMXSQL3",79,0)
. . I L=0,J=BMXFF D Q
"RTN","BMXSQL3",80,0)
. . . K BMXFF(1),BMXFF(BMXFF)
"RTN","BMXSQL3",81,0)
. . . F J=2:1:BMXFF-1 D
"RTN","BMXSQL3",82,0)
. . . . S BMXFF(J-1)=BMXFF(J)
"RTN","BMXSQL3",83,0)
. . . . S:$D(BMXFF(J,0)) BMXFF(J-1,0)=BMXFF(J,0)
"RTN","BMXSQL3",84,0)
. . . . K BMXFF(J)
"RTN","BMXSQL3",85,0)
. . . S BMXFF=BMXFF-2
"RTN","BMXSQL3",86,0)
;
"RTN","BMXSQL3",87,0)
S BMXRET="",E=1,L=0,BMXCNT=0
"RTN","BMXSQL3",88,0)
K BMXLVL
"RTN","BMXSQL3",89,0)
S J=0 F S J=$O(BMXFF(J)) Q:'+J D
"RTN","BMXSQL3",90,0)
. I BMXFF(J)="(" D Q ;If BMXFF(J) is an open paren
"RTN","BMXSQL3",91,0)
. . S L=1
"RTN","BMXSQL3",92,0)
. . S BMXLVL(E,"BEGIN")=J ;Start position of this expression
"RTN","BMXSQL3",93,0)
. . S BMXCNT=0
"RTN","BMXSQL3",94,0)
. . ;Find corresponding close paren
"RTN","BMXSQL3",95,0)
. . F S J=$O(BMXFF(J)) Q:'+J D Q:L=0
"RTN","BMXSQL3",96,0)
. . . I BMXFF(J)=")" S L=L-1,BMXLVL(E,"END")=J,BMXLVL(E,"ELEMENTS")=BMXCNT Q
"RTN","BMXSQL3",97,0)
. . . I BMXFF(J)="(" S L=L+1 Q
"RTN","BMXSQL3",98,0)
. . . I "AND^OR"'[BMXFF(J) S BMXCNT=BMXCNT+1
"RTN","BMXSQL3",99,0)
. . S BMXRET=BMXRET_E
"RTN","BMXSQL3",100,0)
. . S E=E+1
"RTN","BMXSQL3",101,0)
. . Q
"RTN","BMXSQL3",102,0)
. I "AND^OR"[BMXFF(J) D Q ;If BMXFF(J) is an operator
"RTN","BMXSQL3",103,0)
. . S BMXRET=BMXRET_$S(BMXFF(J)="OR":"!",1:"&")
"RTN","BMXSQL3",104,0)
. D Q ; BMXFF(J) is an element unenclosed by parens
"RTN","BMXSQL3",105,0)
. . S BMXLVL(E,"BEGIN")=J
"RTN","BMXSQL3",106,0)
. . S BMXLVL(E,"END")=J
"RTN","BMXSQL3",107,0)
. . S BMXLVL(E,"ELEMENTS")=1
"RTN","BMXSQL3",108,0)
. . S BMXRET=BMXRET_E
"RTN","BMXSQL3",109,0)
. . S E=E+1
"RTN","BMXSQL3",110,0)
. Q
"RTN","BMXSQL3",111,0)
Q
"RTN","BMXSQL3",112,0)
;
"RTN","BMXSQL3",113,0)
XRTST(BMXFF,F,BMXHIT,BMXRNAM,BMXPFP) ;EP
"RTN","BMXSQL3",114,0)
;Returns TRUE (1) in BMXRET if 'normal' index exists
"RTN","BMXSQL3",115,0)
;for field in BMXFF(BMXNDX)
"RTN","BMXSQL3",116,0)
;ELSE returns 0
"RTN","BMXSQL3",117,0)
;
"RTN","BMXSQL3",118,0)
;IN: BMXFF
"RTN","BMXSQL3",119,0)
; F
"RTN","BMXSQL3",120,0)
;OUT:BMXRET - 1 or 0
"RTN","BMXSQL3",121,0)
; BMXRNAM - If BMXRET=1, Index name
"RTN","BMXSQL3",122,0)
;
"RTN","BMXSQL3",123,0)
N BMXNOD0,BMXFNUM,BMXGL,BMXFLDNUM,BMXREF,Q
"RTN","BMXSQL3",124,0)
S BMXRET=0,Q=$C(34)
"RTN","BMXSQL3",125,0)
;
"RTN","BMXSQL3",126,0)
Q:"AND^OR^(^)"[BMXFF(F)
"RTN","BMXSQL3",127,0)
S BMXNOD=BMXFF(F)
"RTN","BMXSQL3",128,0)
S BMXNOD0=BMXFF(F,0)
"RTN","BMXSQL3",129,0)
S BMXFNUM=$P(BMXNOD,U,5)
"RTN","BMXSQL3",130,0)
Q:'+BMXFNUM
"RTN","BMXSQL3",131,0)
S BMXGL=$P(BMXNOD,U,7,8)
"RTN","BMXSQL3",132,0)
S BMXFLDNUM=$P(BMXNOD,U,6)
"RTN","BMXSQL3",133,0)
S BMXHIT=0
"RTN","BMXSQL3",134,0)
Q:$D(BMXFF("JOIN"))
"RTN","BMXSQL3",135,0)
Q:$D(BMXFF(F,"INTERNAL"))
"RTN","BMXSQL3",136,0)
I BMXPFF=0,$P(BMXFF(F),U,4)="" Q ;Cannot create iterator on null
"RTN","BMXSQL3",137,0)
I $D(BMXFF(F,"IEN")) S BMXHIT=1 Q
"RTN","BMXSQL3",138,0)
I '$D(^DD(BMXFNUM,BMXFLDNUM,1)) Q
"RTN","BMXSQL3",139,0)
I $P(BMXNOD0,U,2)'["P",$D(BMXFF("INDEX")) D Q ;Explicit index
"RTN","BMXSQL3",140,0)
. S BMXRNAM=BMXFF("INDEX")
"RTN","BMXSQL3",141,0)
. S BMXHIT=1
"RTN","BMXSQL3",142,0)
S BMXREF=0
"RTN","BMXSQL3",143,0)
F S BMXREF=$O(^DD(BMXFNUM,BMXFLDNUM,1,BMXREF)) Q:'+BMXREF Q:BMXHIT D
"RTN","BMXSQL3",144,0)
. Q:'$D(^DD(BMXFNUM,BMXFLDNUM,1,BMXREF,0))
"RTN","BMXSQL3",145,0)
. S BMXRNOD=^DD(BMXFNUM,BMXFLDNUM,1,BMXREF,0)
"RTN","BMXSQL3",146,0)
. Q:$P(BMXRNOD,U,3)]""
"RTN","BMXSQL3",147,0)
. S BMXRNAM=$P(BMXRNOD,U,2)
"RTN","BMXSQL3",148,0)
. S BMXTMP=BMXGL_Q_BMXRNAM_Q_")"
"RTN","BMXSQL3",149,0)
. Q:'$D(@BMXTMP)
"RTN","BMXSQL3",150,0)
. S BMXTMPV=0,BMXTMPV=$O(@BMXTMP@(BMXTMPV))
"RTN","BMXSQL3",151,0)
. Q:BMXTMPV=""
"RTN","BMXSQL3",152,0)
. S BMXTMP=BMXGL_Q_BMXRNAM_Q_","_Q_BMXTMPV_Q_")"
"RTN","BMXSQL3",153,0)
. S BMXTMPI=0,BMXTMPI=$O(@BMXTMP@(BMXTMPI))
"RTN","BMXSQL3",154,0)
. S BMXTMP=$S(BMXGL[",":$P(BMXGL,",")_")",1:$P(BMXGL,"("))
"RTN","BMXSQL3",155,0)
. Q:'$D(@BMXTMP@(BMXTMPI))
"RTN","BMXSQL3",156,0)
. S BMXTMPL=$P(BMXFF(F,0),U,4)
"RTN","BMXSQL3",157,0)
. S BMXTMPP=$P(BMXTMPL,";",2)
"RTN","BMXSQL3",158,0)
. S BMXTMPL=$P(BMXTMPL,";")
"RTN","BMXSQL3",159,0)
. Q:BMXTMPL=""
"RTN","BMXSQL3",160,0)
. S BMXTMP=BMXGL_BMXTMPI_")"
"RTN","BMXSQL3",161,0)
. Q:'$D(@BMXTMP@(BMXTMPL))
"RTN","BMXSQL3",162,0)
. S BMXTMPN=@BMXTMP@(BMXTMPL)
"RTN","BMXSQL3",163,0)
. I BMXTMPP["E" D
"RTN","BMXSQL3",164,0)
. . S BMXTMPP=$P(BMXTMPP,"E",2)
"RTN","BMXSQL3",165,0)
. . S BMXTMPP=$E(BMXTMPN,$P(BMXTMPP,","),$P(BMXTMPP,",",2))
"RTN","BMXSQL3",166,0)
. E D
"RTN","BMXSQL3",167,0)
. . S BMXTMPP=$P(BMXTMPN,"^",BMXTMPP)
"RTN","BMXSQL3",168,0)
. I $P(BMXNOD0,U,2)["P" D Q
"RTN","BMXSQL3",169,0)
. . N BMXPFFN
"RTN","BMXSQL3",170,0)
. . S BMXPFF(BMXPFF)=BMXFF(F)
"RTN","BMXSQL3",171,0)
. . S BMXPFF(BMXPFF,0)=BMXFF(F,0)
"RTN","BMXSQL3",172,0)
. . S BMXPFF(BMXPFF,1)=BMXREF
"RTN","BMXSQL3",173,0)
. . S $P(BMXPFF(BMXPFF,1),U,2)=BMXRNAM
"RTN","BMXSQL3",174,0)
. . S BMXPFP(BMXPFP,BMXPFF)=BMXFF(F)
"RTN","BMXSQL3",175,0)
. . S BMXPFP(BMXPFP,BMXPFF,0)=BMXFF(F,0)
"RTN","BMXSQL3",176,0)
. . S BMXPFP(BMXPFP,BMXPFF,1)=BMXREF
"RTN","BMXSQL3",177,0)
. . S $P(BMXPFP(BMXPFP,BMXPFF,1),U,2)=BMXRNAM
"RTN","BMXSQL3",178,0)
. . S BMXPFF=BMXPFF+1
"RTN","BMXSQL3",179,0)
. . S BMXPFFN=$P(BMXNOD0,U,2)
"RTN","BMXSQL3",180,0)
. . S BMXPFFN=+$P(BMXPFFN,"P",2)
"RTN","BMXSQL3",181,0)
. . S $P(BMXPFF(BMXPFF),U,5)=BMXPFFN
"RTN","BMXSQL3",182,0)
. . S $P(BMXPFF(BMXPFF),U,6)=".01"
"RTN","BMXSQL3",183,0)
. . S $P(BMXPFF(BMXPFF),U,7)=^DIC(BMXPFFN,0,"GL")
"RTN","BMXSQL3",184,0)
. . S BMXPFF(BMXPFF,0)=^DD(BMXPFFN,".01",0)
"RTN","BMXSQL3",185,0)
. . S $P(BMXPFP(BMXPFP,BMXPFF),U,5)=BMXPFFN
"RTN","BMXSQL3",186,0)
. . S $P(BMXPFP(BMXPFP,BMXPFF),U,6)=".01"
"RTN","BMXSQL3",187,0)
. . S $P(BMXPFP(BMXPFP,BMXPFF),U,7)=^DIC(BMXPFFN,0,"GL")
"RTN","BMXSQL3",188,0)
. . S BMXPFP(BMXPFP,BMXPFF,0)=^DD(BMXPFFN,".01",0)
"RTN","BMXSQL3",189,0)
. . D XRTST(.BMXPFF,BMXPFF,.BMXHIT,BMXRNAM,.BMXPFP)
"RTN","BMXSQL3",190,0)
. . Q
"RTN","BMXSQL3",191,0)
. I BMXTMPP=BMXTMPV D Q
"RTN","BMXSQL3",192,0)
. . S BMXHIT=1,BMXRET=1
"RTN","BMXSQL3",193,0)
. . I BMXPFF>0 D Q
"RTN","BMXSQL3",194,0)
. . . S BMXPFF(BMXPFF,1)=BMXREF
"RTN","BMXSQL3",195,0)
. . . S $P(BMXPFF(BMXPFF,1),U,2)=BMXRNAM
"RTN","BMXSQL3",196,0)
. . . S BMXPFP(BMXPFP,BMXPFF,1)=BMXREF
"RTN","BMXSQL3",197,0)
. . . S $P(BMXPFP(BMXPFP,BMXPFF,1),U,2)=BMXRNAM
"RTN","BMXSQL3",198,0)
. . Q
"RTN","BMXSQL3",199,0)
. Q
"RTN","BMXSQL3",200,0)
Q
"RTN","BMXSQL3",201,0)
;
"RTN","BMXSQL3",202,0)
;
"RTN","BMXSQL3",203,0)
BLDIT(BMXFF,F,BMXRNAM,BMXRET,BMXPFP) ;EP - Build iterator
"RTN","BMXSQL3",204,0)
;
"RTN","BMXSQL3",205,0)
K BMXRET
"RTN","BMXSQL3",206,0)
N BMXNOD,BMXOP,BMXV,BMXGL,Q
"RTN","BMXSQL3",207,0)
S BMXNOD=BMXFF(F)
"RTN","BMXSQL3",208,0)
S BMXOP=$P(BMXNOD,U,3)
"RTN","BMXSQL3",209,0)
S BMXV=$P(BMXNOD,U,4)
"RTN","BMXSQL3",210,0)
S BMXGL=$P(BMXNOD,U,7,8)
"RTN","BMXSQL3",211,0)
S Q=$C(34)
"RTN","BMXSQL3",212,0)
I $D(BMXPFP(F)) D BLDIT2 Q ;Pointer
"RTN","BMXSQL3",213,0)
;TODO Set BMXV to the pointer or set or FM date that corresponds
"RTN","BMXSQL3",214,0)
; to the user-entered value
"RTN","BMXSQL3",215,0)
I $D(BMXFF(F,"IEN")),BMXFF(F,"IEN")="TEMPLATE" D Q
"RTN","BMXSQL3",216,0)
. N BMXTNUM
"RTN","BMXSQL3",217,0)
. S BMXTNUM=$O(^DIBT("B",$P(BMXFF(F),U,4),0))
"RTN","BMXSQL3",218,0)
. S BMXRET="S D0=0 F S D0=$O(^DIBT("_BMXTNUM_",1,D0)) Q:'+D0 Q:BMXM>BMXXMAX "
"RTN","BMXSQL3",219,0)
. Q
"RTN","BMXSQL3",220,0)
I BMXOP="=" D Q
"RTN","BMXSQL3",221,0)
. I $D(BMXFF(F,"IEN")) S BMXRET="S D0="_BMXV_" Q:'+D0 Q:BMXM>BMXXMAX " Q
"RTN","BMXSQL3",222,0)
. S BMXRET="S D0="""" F S D0=$O("_BMXGL_Q_BMXRNAM_Q_","_Q_BMXV_Q_",D0)) Q:D0="""" Q:BMXM>BMXXMAX "
"RTN","BMXSQL3",223,0)
. Q
"RTN","BMXSQL3",224,0)
;
"RTN","BMXSQL3",225,0)
I BMXOP=">=" D Q
"RTN","BMXSQL3",226,0)
. I $D(BMXFF(F,"IEN")) S BMXV=BMXV-1,BMXRET="S D0="_BMXV_" F S D0=$O("_BMXGL_"D0)) Q:'+D0 Q:BMXM>BMXXMAX " Q
"RTN","BMXSQL3",227,0)
. N BMXTMP
"RTN","BMXSQL3",228,0)
. S BMXTMP="BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1)"
"RTN","BMXSQL3",229,0)
. S @BMXTMP
"RTN","BMXSQL3",230,0)
. S BMXRET="S BMXV="_Q_BMXV_Q_" F S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV)) Q:BMXV="""" Q:BMXM>BMXXMAX S D0="""" F S D0=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D0)) Q:D0="""" Q:BMXM>BMXXMAX "
"RTN","BMXSQL3",231,0)
;
"RTN","BMXSQL3",232,0)
I BMXOP=">" D Q
"RTN","BMXSQL3",233,0)
. I $D(BMXFF(F,"IEN")) S BMXRET="S D0="_BMXV_" F S D0=$O("_BMXGL_"D0)) Q:'+D0 Q:BMXM>BMXXMAX " Q
"RTN","BMXSQL3",234,0)
. S BMXRET="S BMXV="_Q_BMXV_Q_" F S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV)) Q:BMXV="""" Q:BMXM>BMXXMAX S D0="""" F S D0=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D0)) Q:D0="""" Q:BMXM>BMXXMAX "
"RTN","BMXSQL3",235,0)
;
"RTN","BMXSQL3",236,0)
I BMXOP="<>" D Q
"RTN","BMXSQL3",237,0)
. I $D(BMXFF(F,"IEN")) S BMXRET="S D0=0 F S D0=$O("_BMXGL_"D0)) Q:'+D0 I D0'="_BMXV_" Q:BMXM>BMXXMAX " Q
"RTN","BMXSQL3",238,0)
. S BMXRET="S BMXV=0 F S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV)) Q:BMXV="""" Q:BMXM>BMXXMAX I BMXV'="_Q_BMXV_Q_" S D0="""" F S D0=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D0)) Q:D0="""" Q:BMXM>BMXXMAX "
"RTN","BMXSQL3",239,0)
;
"RTN","BMXSQL3",240,0)
I BMXOP="<=" D Q
"RTN","BMXSQL3",241,0)
. I $D(BMXFF(F,"IEN")) S BMXRET="S D0=0 F S D0=$O("_BMXGL_"D0)) Q:'+D0 Q:D0>"_BMXV_" Q:BMXM>BMXXMAX " Q
"RTN","BMXSQL3",242,0)
. N BMXTMP
"RTN","BMXSQL3",243,0)
. S BMXTMP="BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV))"
"RTN","BMXSQL3",244,0)
. S @BMXTMP
"RTN","BMXSQL3",245,0)
. S BMXRET="S BMXV="_Q_BMXV_Q_" F S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1) Q:BMXV="""" Q:BMXM>BMXXMAX S D0="""" F S D0=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D0)) Q:D0="""" Q:BMXM>BMXXMAX "
"RTN","BMXSQL3",246,0)
;
"RTN","BMXSQL3",247,0)
I BMXOP="<" D Q
"RTN","BMXSQL3",248,0)
. I $D(BMXFF(F,"IEN")) S BMXRET="S D0=0 F S D0=$O("_BMXGL_"D0)) Q:'+D0 Q:D0'<"_BMXV_" Q:BMXM>BMXXMAX " Q
"RTN","BMXSQL3",249,0)
. S BMXRET="S BMXV="_Q_BMXV_Q_" F S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1) Q:BMXV="""" Q:BMXM>BMXXMAX S D0="""" F S D0=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D0)) Q:D0="""" Q:BMXM>BMXXMAX "
"RTN","BMXSQL3",250,0)
;
"RTN","BMXSQL3",251,0)
I BMXOP="BETWEEN" D Q ;changed '< to > (inclusive BETWEEN)
"RTN","BMXSQL3",252,0)
. I $D(BMXFF(F,"IEN")) D Q
"RTN","BMXSQL3",253,0)
. . S BMXRET="S D0="_(+$P(BMXV,"~")-1)_" F S D0=$O("_BMXGL_"D0)) Q:'+D0 Q:D0>"_$P(BMXV,"~",2)_" Q:BMXM>BMXXMAX "
"RTN","BMXSQL3",254,0)
. I +$P(BMXV,"~")=$P(BMXV,"~") D ;BMXV is a number
"RTN","BMXSQL3",255,0)
. . S BMXRET="S BMXV="_$P(BMXV,"~")_",BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1) F S BMXV=$O("_BMXGL_Q_BMXRNAM_Q
"RTN","BMXSQL3",256,0)
. . S BMXRET=BMXRET_",BMXV)) Q:BMXV="""" Q:BMXV>"_$P(BMXV,"~",2)_" Q:BMXM>BMXXMAX S D0="""" F S D0=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D0)) Q:D0="""" Q:BMXM>BMXXMAX "
"RTN","BMXSQL3",257,0)
. E D ;BMXV is a string
"RTN","BMXSQL3",258,0)
. . S BMXRET="S BMXV="_Q_$P(BMXV,"~")_Q_",BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1) F S BMXV=$O("_BMXGL_Q_BMXRNAM_Q
"RTN","BMXSQL3",259,0)
. . S BMXRET=BMXRET_",BMXV)) Q:BMXV="""" Q:BMXV]"_Q_$P(BMXV,"~",2)_Q_" Q:BMXM>BMXXMAX S D0="""" F S D0=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D0)) Q:D0="""" Q:BMXM>BMXXMAX "
"RTN","BMXSQL3",260,0)
;
"RTN","BMXSQL3",261,0)
I BMXOP="LIKE" D Q
"RTN","BMXSQL3",262,0)
. N BMXTMP,BMXV1
"RTN","BMXSQL3",263,0)
. S BMXV1=BMXV
"RTN","BMXSQL3",264,0)
. S BMXTMP="BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1)"
"RTN","BMXSQL3",265,0)
. S @BMXTMP
"RTN","BMXSQL3",266,0)
. S BMXRET="S BMXV="_Q_BMXV_Q_" F S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV)) Q:BMXV="""" Q:BMXV'?1"_Q_BMXV1_Q_".E Q:BMXM>BMXXMAX S D0="""" F S D0=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D0)) Q:D0="""" Q:BMXM>BMXXMAX "
"RTN","BMXSQL3",267,0)
Q
"RTN","BMXSQL3",268,0)
;
"RTN","BMXSQL3",269,0)
BLDIT2 ;Pointer
"RTN","BMXSQL3",270,0)
N BMXPS,J
"RTN","BMXSQL3",271,0)
S BMXPS=$O(BMXPFP(F,999),-1)
"RTN","BMXSQL3",272,0)
S BMXNOD=BMXPFP(F,BMXPS)
"RTN","BMXSQL3",273,0)
S BMXGL=$P(BMXNOD,U,7,8)
"RTN","BMXSQL3",274,0)
I BMXOP="=" D
"RTN","BMXSQL3",275,0)
. S BMXRNAM=$P(BMXPFP(F,BMXPS,1),U,2)
"RTN","BMXSQL3",276,0)
. S BMXRET="S D"_BMXPS_"="""" F S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_","_Q_BMXV_Q_",D"_BMXPS_")) Q:'+D"_BMXPS_" Q:BMXM>BMXXMAX "
"RTN","BMXSQL3",277,0)
;
"RTN","BMXSQL3",278,0)
I BMXOP=">" D
"RTN","BMXSQL3",279,0)
. S BMXRNAM=$P(BMXPFP(F,BMXPS,1),U,2)
"RTN","BMXSQL3",280,0)
. S BMXRET="S BMXV="_Q_BMXV_Q_" F S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV)) Q:BMXV="""" Q:BMXM>BMXXMAX S D"_BMXPS_"="""" F S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D"_BMXPS_")) Q:'+D"_BMXPS_" Q:BMXM>BMXXMAX "
"RTN","BMXSQL3",281,0)
;
"RTN","BMXSQL3",282,0)
I BMXOP=">=" D
"RTN","BMXSQL3",283,0)
. N BMXTMP
"RTN","BMXSQL3",284,0)
. S BMXRNAM=$P(BMXPFP(F,BMXPS,1),U,2)
"RTN","BMXSQL3",285,0)
. S BMXTMP="BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1)"
"RTN","BMXSQL3",286,0)
. S @BMXTMP
"RTN","BMXSQL3",287,0)
. S BMXRET="S BMXV="_Q_BMXV_Q_" F S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV)) Q:BMXV="""" Q:BMXM>BMXXMAX S D"_BMXPS_"="""" F S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D"_BMXPS_")) Q:'+D"_BMXPS_" Q:BMXM>BMXXMAX "
"RTN","BMXSQL3",288,0)
;
"RTN","BMXSQL3",289,0)
I BMXOP="<=" D
"RTN","BMXSQL3",290,0)
. N BMXTMP
"RTN","BMXSQL3",291,0)
. S BMXRNAM=$P(BMXPFP(F,BMXPS,1),U,2)
"RTN","BMXSQL3",292,0)
. S BMXTMP="BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV))"
"RTN","BMXSQL3",293,0)
. S @BMXTMP
"RTN","BMXSQL3",294,0)
. S BMXRET="S BMXV="_Q_BMXV_Q_" F S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1) Q:BMXV="""" Q:BMXM>BMXXMAX S D"_BMXPS_"="""" F S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D"_BMXPS_")) Q:'+D"_BMXPS_" Q:BMXM>BMXXMAX "
"RTN","BMXSQL3",295,0)
;
"RTN","BMXSQL3",296,0)
I BMXOP="<>" D
"RTN","BMXSQL3",297,0)
. S BMXRNAM=$P(BMXPFP(F,BMXPS,1),U,2)
"RTN","BMXSQL3",298,0)
. S BMXRET="S BMXV=0 F S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV)) Q:BMXV="""" Q:BMXM>BMXXMAX I BMXV'="_Q_BMXV_Q_" S D"_BMXPS_"="""" F S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D"_BMXPS_")) Q:'+D"_BMXPS_" Q:BMXM>BMXXMAX "
"RTN","BMXSQL3",299,0)
;
"RTN","BMXSQL3",300,0)
I BMXOP="<" D
"RTN","BMXSQL3",301,0)
. S BMXRNAM=$P(BMXPFP(F,BMXPS,1),U,2)
"RTN","BMXSQL3",302,0)
. S BMXRET="S BMXV="_Q_BMXV_Q_" F S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1) Q:BMXV="""" Q:BMXM>BMXXMAX S D"_BMXPS_"="""" F S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D"_BMXPS_")) Q:'+D"_BMXPS_" Q:BMXM>BMXXMAX "
"RTN","BMXSQL3",303,0)
;
"RTN","BMXSQL3",304,0)
I BMXOP="BETWEEN" D
"RTN","BMXSQL3",305,0)
. S BMXRNAM=$P(BMXPFP(F,BMXPS,1),U,2)
"RTN","BMXSQL3",306,0)
. I +$P(BMXV,"~")=$P(BMXV,"~") D ;BMXV is a number
"RTN","BMXSQL3",307,0)
. . S BMXRET="S BMXV="_$P(BMXV,"~")_",BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1) F S BMXV=$O("_BMXGL_Q_BMXRNAM_Q
"RTN","BMXSQL3",308,0)
. . S BMXRET=BMXRET_",BMXV)) Q:BMXV="""" Q:BMXV>"_$P(BMXV,"~",2)_" Q:BMXM>BMXXMAX S D"_BMXPS_"=0 F S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D"_BMXPS_")) Q:'+D"_BMXPS_" Q:BMXM>BMXXMAX "
"RTN","BMXSQL3",309,0)
. E D ;BMXV is a string
"RTN","BMXSQL3",310,0)
. . S BMXRET="S BMXV="_Q_$P(BMXV,"~")_Q_",BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1) F S BMXV=$O("_BMXGL_Q_BMXRNAM_Q
"RTN","BMXSQL3",311,0)
. . S BMXRET=BMXRET_",BMXV)) Q:BMXV="""" Q:BMXV]"_Q_$P(BMXV,"~",2)_Q_" Q:BMXM>BMXXMAX S D"_BMXPS_"=0 F S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D"_BMXPS_")) Q:'+D"_BMXPS_" Q:BMXM>BMXXMAX "
"RTN","BMXSQL3",312,0)
;
"RTN","BMXSQL3",313,0)
I BMXOP="LIKE" D
"RTN","BMXSQL3",314,0)
. N BMXTMP,BMXV1
"RTN","BMXSQL3",315,0)
. S BMXRNAM=$P(BMXPFP(F,BMXPS,1),U,2)
"RTN","BMXSQL3",316,0)
. S BMXV1=BMXV
"RTN","BMXSQL3",317,0)
. S BMXTMP="BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1)"
"RTN","BMXSQL3",318,0)
. S @BMXTMP
"RTN","BMXSQL3",319,0)
. S BMXRET="S BMXV="_Q_BMXV_Q_" F S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV)) Q:BMXV="""" Q:BMXV'?1"_Q_BMXV1_Q_".E Q:BMXM>BMXXMAX S D"_BMXPS_"="""" F S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D"_BMXPS_")) Q:'+D"_BMXPS_" Q:BMXM>BMXXMAX "
"RTN","BMXSQL3",320,0)
;
"RTN","BMXSQL3",321,0)
F J=BMXPS-1:-1:0 D
"RTN","BMXSQL3",322,0)
. S BMXNOD=BMXPFP(F,J)
"RTN","BMXSQL3",323,0)
. S BMXGL=$P(BMXNOD,U,7,8)
"RTN","BMXSQL3",324,0)
. S BMXRNAM=$P(BMXPFP(F,J,1),U,2)
"RTN","BMXSQL3",325,0)
. S BMXRET=BMXRET_"S D"_J_"=0 F S D"_J_"=$O("_BMXGL_Q_BMXRNAM_Q_",D"_(J+1)_",D"_J_")) Q:'+D"_J_" Q:BMXM>BMXXMAX "
"RTN","BMXSQL3",326,0)
Q
"RTN","BMXSQL3",327,0)
;TODO: Computed fields
"RTN","BMXSQL3",328,0)
;TODO: Sets of codes
"RTN","BMXSQL3",329,0)
;TODO: User-specified index
"RTN","BMXSQL3",330,0)
Q
"RTN","BMXSQL4")
0^101^B3594616
"RTN","BMXSQL4",1,0)
BMXSQL4 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
"RTN","BMXSQL4",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXSQL4",3,0)
;
"RTN","BMXSQL4",4,0)
;
"RTN","BMXSQL4",5,0)
JOIN ;EP - Join processing
"RTN","BMXSQL4",6,0)
;Create a pointer chain back to the primary file
"RTN","BMXSQL4",7,0)
;or to a reverse pointer file, E.G.:
"RTN","BMXSQL4",8,0)
;Either executable code or an expression that returns the
"RTN","BMXSQL4",9,0)
;IEN of the terminal pointed-to file
"RTN","BMXSQL4",10,0)
;
"RTN","BMXSQL4",11,0)
; S IEN1=$P(^DIZ(1000,IEN2,0),U,4)
"RTN","BMXSQL4",12,0)
; I +IEN1 S IEN=$P(^AUTTLOC(IEN1,0),U,23)
"RTN","BMXSQL4",13,0)
;
"RTN","BMXSQL4",14,0)
Q:'$D(BMXFJ("JOIN"))
"RTN","BMXSQL4",15,0)
N C,D,E,BMXSTOP,BMXPTF,BMXPTG,BMXPTL,BMXPTN,BMXPTP,BMXPTC
"RTN","BMXSQL4",16,0)
S C=0 F S C=$O(BMXFF(C)) Q:'+C D
"RTN","BMXSQL4",17,0)
. Q:'$D(BMXFF(C,"JOIN"))
"RTN","BMXSQL4",18,0)
. S BMXPTL=1,BMXPTC="",D=C ;Pointer level
"RTN","BMXSQL4",19,0)
. F S BMXPTF=$P(BMXFF(D),U,5) D Q:BMXPTF=BMXFO(1)
"RTN","BMXSQL4",20,0)
. . S BMXPTG=$P(BMXFF(D),U,7,99) ;Pf Global
"RTN","BMXSQL4",21,0)
. . S BMXPTN=$P(BMXFF(D,0),U,4) ;Pf Node
"RTN","BMXSQL4",22,0)
. . S BMXPTP=$P(BMXPTN,";",2) ;Pf Piece
"RTN","BMXSQL4",23,0)
. . S BMXPTN=$P(BMXPTN,";")
"RTN","BMXSQL4",24,0)
. . S BMXPTC="I +IEN"_BMXPTL_" S IEN"_(BMXPTL-1)_"=$P($G("_BMXPTG_"IEN"_BMXPTL_","_BMXPTN_")),U,"_BMXPTP_") "_BMXPTC
"RTN","BMXSQL4",25,0)
. . S BMXPTL=BMXPTL+1
"RTN","BMXSQL4",26,0)
. . ;S D To the index of the pointed to file's entry in BMXFF
"RTN","BMXSQL4",27,0)
. . Q:BMXPTF=BMXFO(1)
"RTN","BMXSQL4",28,0)
. . S E=0,BMXSTOP=0 F S E=$O(BMXFF(E)) Q:'+E Q:BMXSTOP D
"RTN","BMXSQL4",29,0)
. . . I $D(BMXFF(E,0)),+$P($P(BMXFF(E,0),U,2),"P",2)=BMXPTF S D=E,BMXSTOP=1 Q
"RTN","BMXSQL4",30,0)
. . . I $D(BMXFF(E,0)),BMXPTF=9000001,+$P($P(BMXFF(E,0),U,2),"P",2)=2 S D=E,BMXSTOP=1 Q ;IHS auto join PATIENT to VA PATIENT
"RTN","BMXSQL4",31,0)
. S BMXFF(C,"JOIN")=BMXPTC
"RTN","BMXSQL4",32,0)
. S BMXFF(C,"JOIN","IEN")="IEN"_(BMXPTL-1)
"RTN","BMXSQL4",33,0)
Q
"RTN","BMXSQL5")
0^102^B51902207
"RTN","BMXSQL5",1,0)
BMXSQL5 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
"RTN","BMXSQL5",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXSQL5",3,0)
;
"RTN","BMXSQL5",4,0)
;
"RTN","BMXSQL5",5,0)
SELECT ;EP - Get field names into BMXFLD("NAME")="FILE#^FIELD#"
"RTN","BMXSQL5",6,0)
N BMXA,BMXB,BMXS,BMXSINGL
"RTN","BMXSQL5",7,0)
N BMXINTNL
"RTN","BMXSQL5",8,0)
S T=$G(BMXTK("SELECT"))
"RTN","BMXSQL5",9,0)
I '+T S BMXERR="'SELECT' CLAUSE NOT FOUND" D ERRTACK^BMXSQL(1) Q
"RTN","BMXSQL5",10,0)
S BMXFLD=0
"RTN","BMXSQL5",11,0)
N BMXOFF,BMXGS1,BMXLVL
"RTN","BMXSQL5",12,0)
F S T=$O(BMXTK(T)) Q:'+T Q:T=$G(BMXTK("FROM")) I BMXTK(T)'="," S BMXOFF=1,BMXLVL=0 D S1 Q:$D(BMXERR)
"RTN","BMXSQL5",13,0)
Q
"RTN","BMXSQL5",14,0)
;
"RTN","BMXSQL5",15,0)
SALIAS ;
"RTN","BMXSQL5",16,0)
Q:'+$O(BMXTK(T))
"RTN","BMXSQL5",17,0)
N V
"RTN","BMXSQL5",18,0)
S V=T+1
"RTN","BMXSQL5",19,0)
Q:$G(BMXTK(V))=","
"RTN","BMXSQL5",20,0)
Q:V=$G(BMXTK("FROM"))
"RTN","BMXSQL5",21,0)
S:BMXTK(V)["'" BMXTK(V)=$P(BMXTK(V),"'",2)
"RTN","BMXSQL5",22,0)
S BMXFLDA(BMXFILE,BMXFLDN)=BMXTK(V)
"RTN","BMXSQL5",23,0)
S $P(BMXFLDO(BMXFLDO-1),U,6)=BMXTK(V)
"RTN","BMXSQL5",24,0)
S T=T+1
"RTN","BMXSQL5",25,0)
Q
"RTN","BMXSQL5",26,0)
;
"RTN","BMXSQL5",27,0)
S1 ;
"RTN","BMXSQL5",28,0)
S BMXTK(T)=$TR(BMXTK(T),"_"," ")
"RTN","BMXSQL5",29,0)
;Check for INTERNAL[ modifier
"RTN","BMXSQL5",30,0)
S BMXGS1=0
"RTN","BMXSQL5",31,0)
S BMXINTNL="E"
"RTN","BMXSQL5",32,0)
I BMXTK(T)["[" S BMXINTNL="I",BMXTK(T)=$P(BMXTK(T),"[",2),BMXTK(T)=$P(BMXTK(T),"]",1)
"RTN","BMXSQL5",33,0)
;If explicit file name
"RTN","BMXSQL5",34,0)
S BMXSINGL=0
"RTN","BMXSQL5",35,0)
I BMXTK(T)["." D G:BMXGS1 S1 G:BMXSINGL NOTEXP Q
"RTN","BMXSQL5",36,0)
. ;Before FILE.FIELD Parsing
"RTN","BMXSQL5",37,0)
. S BMXA=$P(BMXTK(T),".",1,BMXOFF) ;File Name
"RTN","BMXSQL5",38,0)
. I '$D(BMXF(BMXA)) D Q:$D(BMXERR) Q:BMXSINGL
"RTN","BMXSQL5",39,0)
. . I $D(^DD(BMXFO(1),"B",BMXTK(T))),BMXOFF=1 S BMXSINGL=1 Q
"RTN","BMXSQL5",40,0)
. . S BMXERR="FILE NOT FOUND" D ERRTACK^BMXSQL(1) Q
"RTN","BMXSQL5",41,0)
. S BMXB=$P(BMXTK(T),".",1+BMXOFF,99) ;Field Name TODO: Test here for multiple in extended pointer -- FILE.MULTIPLE.FIELD
"RTN","BMXSQL5",42,0)
. N BMXLAST S BMXLAST=0
"RTN","BMXSQL5",43,0)
. I $L(BMXB,".")>1 D Q:'BMXLAST ;Multiple
"RTN","BMXSQL5",44,0)
. . N BMXFNUM,BMXFNAM,BMXFNOD,BMXSUBFN,BMXUPFN,BMXGL,W,BMXFOUND
"RTN","BMXSQL5",45,0)
. . ;Multiple or Field-name with period?
"RTN","BMXSQL5",46,0)
. . S BMXFOUND=0
"RTN","BMXSQL5",47,0)
. . F W=1:1:$L(BMXTK(T),".") D Q:BMXFOUND
"RTN","BMXSQL5",48,0)
. . . S BMXOFF=BMXOFF+1
"RTN","BMXSQL5",49,0)
. . . I $D(^DD(BMXF(BMXA),"B",$P(BMXB,".",1,W))) D
"RTN","BMXSQL5",50,0)
. . . . S BMXFNAM=$P(BMXB,".",1,W)
"RTN","BMXSQL5",51,0)
. . . . S BMXFOUND=1
"RTN","BMXSQL5",52,0)
. . . . S:W=$L(BMXB,".") BMXLAST=1
"RTN","BMXSQL5",53,0)
. . . . S BMXLVL=BMXLVL+1
"RTN","BMXSQL5",54,0)
. . ;
"RTN","BMXSQL5",55,0)
. . Q:BMXLAST
"RTN","BMXSQL5",56,0)
. . S BMXF=BMXF+1
"RTN","BMXSQL5",57,0)
. . S BMXFNUM=$O(^DD(BMXF(BMXA),"B",BMXFNAM,0)) ;FieldNumber
"RTN","BMXSQL5",58,0)
. . S BMXFNOD=^DD(BMXF(BMXA),BMXFNUM,0)
"RTN","BMXSQL5",59,0)
. . S BMXGL=$P(BMXFNOD,U,4),BMXGL=$P(BMXGL,";")
"RTN","BMXSQL5",60,0)
. . S BMXSUBFN=+$P(BMXFNOD,U,2) ;Subfile Number
"RTN","BMXSQL5",61,0)
. . S BMXUPFN=^DD(BMXSUBFN,0,"UP") ;Parent File Number
"RTN","BMXSQL5",62,0)
. . D SETMFL(BMXUPFN,BMXSUBFN,BMXGL,BMXLVL,0)
"RTN","BMXSQL5",63,0)
. . S BMXGS1=1
"RTN","BMXSQL5",64,0)
. S:BMXB["'" BMXB=$P(BMXB,"'",2)
"RTN","BMXSQL5",65,0)
. I BMXB="BMXIEN" D Q
"RTN","BMXSQL5",66,0)
. . S BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA)
"RTN","BMXSQL5",67,0)
. . S $P(BMXFLD(BMXA_"."_BMXB),"^",2)=".001"
"RTN","BMXSQL5",68,0)
. . D SELECT1
"RTN","BMXSQL5",69,0)
. I BMXB="*" D Q ;All fields in file BMXA
"RTN","BMXSQL5",70,0)
. . ;BMXIEN Has to be first because ADO doesn't handle it well if a DATE type column is returned first
"RTN","BMXSQL5",71,0)
. . S BMXB="BMXIEN"
"RTN","BMXSQL5",72,0)
. . S BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA)
"RTN","BMXSQL5",73,0)
. . S $P(BMXFLD(BMXA_"."_BMXB),"^",2)=".001"
"RTN","BMXSQL5",74,0)
. . D SELECT1
"RTN","BMXSQL5",75,0)
. . S BMXB=0 F S BMXB=$O(^DD(BMXF(BMXA),"B",BMXB)) Q:BMXB="" D
"RTN","BMXSQL5",76,0)
. . . S BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA)
"RTN","BMXSQL5",77,0)
. . . S $P(BMXFLD(BMXA_"."_BMXB),"^",2)=$O(^DD(BMXF(BMXA),"B",BMXB,0))
"RTN","BMXSQL5",78,0)
. . . D SELECT1
"RTN","BMXSQL5",79,0)
. S BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA)
"RTN","BMXSQL5",80,0)
. I '$D(^DD(BMXF(BMXA),"B",BMXB)) S BMXERR="FIELD NOT FOUND" D ERRTACK^BMXSQL(1) Q
"RTN","BMXSQL5",81,0)
. S $P(BMXFLD(BMXA_"."_BMXB),"^",2)=$O(^DD(BMXF(BMXA),"B",BMXB,0))
"RTN","BMXSQL5",82,0)
. D SELECT1
"RTN","BMXSQL5",83,0)
. Q
"RTN","BMXSQL5",84,0)
;
"RTN","BMXSQL5",85,0)
NOTEXP ;File not explicit so Loop through files in BMXF to locate field name
"RTN","BMXSQL5",86,0)
;
"RTN","BMXSQL5",87,0)
I BMXTK(T)["'" S BMXTK(T)=$P(BMXTK(T),"'",2)
"RTN","BMXSQL5",88,0)
S C=0,BMXA=""
"RTN","BMXSQL5",89,0)
I BMXTK(T)="BMXIEN" D Q
"RTN","BMXSQL5",90,0)
. S BMXB=BMXTK(T)
"RTN","BMXSQL5",91,0)
. S BMXA=BMXFO(1) ;File defaults to first named file in FROM
"RTN","BMXSQL5",92,0)
. S BMXA=BMXFNX(BMXA)
"RTN","BMXSQL5",93,0)
. S BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA)
"RTN","BMXSQL5",94,0)
. S $P(BMXFLD(BMXA_"."_BMXB),"^",2)=".001"
"RTN","BMXSQL5",95,0)
. D SELECT1
"RTN","BMXSQL5",96,0)
F S BMXA=$O(BMXF(BMXA)) Q:BMXA="" D Q:$D(BMXERR)
"RTN","BMXSQL5",97,0)
. S BMXB=BMXTK(T)
"RTN","BMXSQL5",98,0)
. I BMXB="*" D Q ;All fields in file BMXA
"RTN","BMXSQL5",99,0)
. . S BMXB="BMXIEN"
"RTN","BMXSQL5",100,0)
. . S BMXA=BMXFO(1) ;File defaults to first named file in FROM
"RTN","BMXSQL5",101,0)
. . S BMXA=BMXFNX(BMXA)
"RTN","BMXSQL5",102,0)
. . S BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA)
"RTN","BMXSQL5",103,0)
. . S $P(BMXFLD(BMXA_"."_BMXB),"^",2)=".001"
"RTN","BMXSQL5",104,0)
. . D SELECT1
"RTN","BMXSQL5",105,0)
. . S BMXB=0 F S BMXB=$O(^DD(BMXF(BMXA),"B",BMXB)) Q:BMXB="" D
"RTN","BMXSQL5",106,0)
. . . S BMXS=BMXA_"."_BMXB
"RTN","BMXSQL5",107,0)
. . . S BMXFLD(BMXS)=BMXF(BMXA)
"RTN","BMXSQL5",108,0)
. . . S $P(BMXFLD(BMXS),"^",2)=$O(^DD(BMXF(BMXA),"B",BMXB,0))
"RTN","BMXSQL5",109,0)
. . . D SELECT1
"RTN","BMXSQL5",110,0)
. . . S C=1
"RTN","BMXSQL5",111,0)
. I $D(^DD(BMXF(BMXA),"B",BMXTK(T))) D Q:$D(BMXERR)
"RTN","BMXSQL5",112,0)
. . S C=C+1
"RTN","BMXSQL5",113,0)
. . I C>1 S BMXERR="AMBIGUOUS FIELD NAME" D ERRTACK^BMXSQL(1) Q
"RTN","BMXSQL5",114,0)
. . S BMXB=BMXTK(T) ;Field Name
"RTN","BMXSQL5",115,0)
. . I BMXB["'" S BMXB=$P(BMXB,"'",2)
"RTN","BMXSQL5",116,0)
. . S BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA)
"RTN","BMXSQL5",117,0)
. . S $P(BMXFLD(BMXA_"."_BMXB),"^",2)=$O(^DD(BMXF(BMXA),"B",BMXB,0))
"RTN","BMXSQL5",118,0)
. . D SELECT1
"RTN","BMXSQL5",119,0)
. . Q
"RTN","BMXSQL5",120,0)
. Q
"RTN","BMXSQL5",121,0)
I C=0 S BMXERR="FIELD NOT FOUND" D ERRTACK^BMXSQL(1) Q
"RTN","BMXSQL5",122,0)
Q
"RTN","BMXSQL5",123,0)
;
"RTN","BMXSQL5",124,0)
SELECT1 ;
"RTN","BMXSQL5",125,0)
N BMXGNOD,BMXFILE,BMXGNOD1
"RTN","BMXSQL5",126,0)
S BMXFLDN=$P(BMXFLD(BMXA_"."_BMXB),"^",2)
"RTN","BMXSQL5",127,0)
S BMXFILE=$P(BMXFLD(BMXA_"."_BMXB),U)
"RTN","BMXSQL5",128,0)
S BMXFLDN(BMXFILE,BMXFLDN)=BMXB
"RTN","BMXSQL5",129,0)
I BMXFLDN=".001" S BMXGNOD="IEN",BMXGNOD1="",$P(BMXGNOD1,U,2)="N"
"RTN","BMXSQL5",130,0)
E S BMXGNOD1=^DD(BMXFILE,BMXFLDN,0)
"RTN","BMXSQL5",131,0)
S BMXGNOD=$P(BMXGNOD1,"^",4)
"RTN","BMXSQL5",132,0)
S $P(BMXFLD(BMXA_"."_BMXB),"^",3)=$P(BMXGNOD,";")
"RTN","BMXSQL5",133,0)
S $P(BMXFLD(BMXA_"."_BMXB),"^",4)=$P(BMXGNOD,";",2)
"RTN","BMXSQL5",134,0)
S $P(BMXFLD(BMXA_"."_BMXB),"^",5)=BMXINTNL
"RTN","BMXSQL5",135,0)
S BMXFLDO(BMXFLD)=BMXFILE_"^"_BMXFLDN_"^"_BMXINTNL
"RTN","BMXSQL5",136,0)
I +$P(BMXGNOD1,U,2) D ;Check for WP
"RTN","BMXSQL5",137,0)
. S BMXGNOD1=+$P(BMXGNOD1,U,2)
"RTN","BMXSQL5",138,0)
. Q:'$D(^DD(BMXGNOD1,.01,0))
"RTN","BMXSQL5",139,0)
. I $P(^DD(BMXGNOD1,.01,0),U,2)["W" S $P(BMXFLDO(BMXFLD),U,4)="W"
"RTN","BMXSQL5",140,0)
;HMW20030630 Modified next line to make data type of Internal[] for pointer an Integer.
"RTN","BMXSQL5",141,0)
I $P(BMXGNOD1,U,2)["P" S BMXGNOD1=$$PTYPE(BMXGNOD1) Q:BMXGNOD1="" S:$G(BMXINTNL)="I" $P(BMXGNOD1,U,2)="N" ;I BMXGNOD1="" then Pointed-to file doesn't exist
"RTN","BMXSQL5",142,0)
I $P(BMXGNOD1,U,2)["D" S $P(BMXFLDO(BMXFLD),U,5)="D"
"RTN","BMXSQL5",143,0)
I $P(BMXGNOD1,U,2)["N" D
"RTN","BMXSQL5",144,0)
. N Z
"RTN","BMXSQL5",145,0)
. S Z=$P(BMXGNOD1,U,2)
"RTN","BMXSQL5",146,0)
. I +$P(Z,",",2)=0 S $P(BMXFLDO(BMXFLD),U,5)="I" ;Integer
"RTN","BMXSQL5",147,0)
S BMXFLDOX(BMXFILE,BMXFLDN,BMXINTNL)=BMXFLD
"RTN","BMXSQL5",148,0)
S BMXFLD=BMXFLD+1
"RTN","BMXSQL5",149,0)
S BMXFLDO=BMXFLD
"RTN","BMXSQL5",150,0)
D SALIAS
"RTN","BMXSQL5",151,0)
Q
"RTN","BMXSQL5",152,0)
;
"RTN","BMXSQL5",153,0)
SETMFL(BMXUPFN,BMXSUBFN,BMXGL,BMXOFF,BMXOTM) ;EP
"RTN","BMXSQL5",154,0)
;
"RTN","BMXSQL5",155,0)
;BMXOTM = One-To-Many
"RTN","BMXSQL5",156,0)
N BMXUPG
"RTN","BMXSQL5",157,0)
S BMXMFL("PARENT",BMXSUBFN)=BMXUPFN
"RTN","BMXSQL5",158,0)
S BMXMFL(BMXUPFN,"SUBFILE",BMXSUBFN)=""
"RTN","BMXSQL5",159,0)
S BMXMFL("SUBFILE",BMXUPFN,BMXSUBFN)=""
"RTN","BMXSQL5",160,0)
S BMXUPG=BMXMFL(BMXUPFN,"GLOC") ;Parent File Global Set in FROM clause
"RTN","BMXSQL5",161,0)
S BMXFNAM=BMXA_"."_BMXFNAM ;TODO: Regression test this line with OTM
"RTN","BMXSQL5",162,0)
I 'BMXOTM S BMXMFL(BMXSUBFN,"GLOC")=BMXUPG_"IEN"_(BMXOFF-1)_","_$C(34)_BMXGL_$C(34)_","
"RTN","BMXSQL5",163,0)
E S BMXMFL(BMXSUBFN,"GLOC")=BMXGL,BMXMFL(BMXSUBFN,"OTM")=""
"RTN","BMXSQL5",164,0)
S BMXMFL(BMXSUBFN,"MULT")="S IEN"_BMXOFF_"=0 F S IEN"_BMXOFF_"=$O("_BMXMFL(BMXSUBFN,"GLOC")_"IEN"_BMXOFF_")) Q:'+IEN"_BMXOFF_" "
"RTN","BMXSQL5",165,0)
I $D(BMXMFL(BMXUPFN,"MULT")) S BMXMFL(BMXSUBFN,"MULT")=BMXMFL(BMXUPFN,"MULT")_" "_BMXMFL(BMXSUBFN,"MULT")
"RTN","BMXSQL5",166,0)
I 'BMXOTM S BMXMFL(BMXSUBFN,"IENS")="N J S BMXIENS="""" F J=0:1:"_BMXOFF_" S BMXIENS=@(""IEN""_J)_"",""_BMXIENS"
"RTN","BMXSQL5",167,0)
E S BMXMFL(BMXSUBFN,"IENS")="N J S BMXIENS="""" S J=1 S BMXIENS=@(""IEN""_J)_"",""_BMXIENS"
"RTN","BMXSQL5",168,0)
S BMXMFL(BMXSUBFN,"EXEC")=BMXMFL(BMXSUBFN,"MULT")_"X BMXMFL(BMXFN,""IENS"")"_" D GETS^DIQ(BMXFN,BMXIENS,BMXGF(BMXFN),""E"",BMXA) D SETIEN(IEN"_BMXOFF_",BMXFN)"
"RTN","BMXSQL5",169,0)
D F1^BMXSQL(BMXF,BMXFNAM,BMXSUBFN)
"RTN","BMXSQL5",170,0)
;
"RTN","BMXSQL5",171,0)
Q
"RTN","BMXSQL5",172,0)
;
"RTN","BMXSQL5",173,0)
PTYPE(BMXGNOD1) ;
"RTN","BMXSQL5",174,0)
;Traverse pointer chain to retrieve data type of pointed-to field
"RTN","BMXSQL5",175,0)
N BMXFILE
"RTN","BMXSQL5",176,0)
I $P(BMXGNOD1,U,2)'["P" Q BMXGNOD1
"RTN","BMXSQL5",177,0)
S BMXFILE=$P(BMXGNOD1,U,2)
"RTN","BMXSQL5",178,0)
S BMXFILE=+$P(BMXFILE,"P",2)
"RTN","BMXSQL5",179,0)
S BMXGNOD1=$G(^DD(BMXFILE,".01",0))
"RTN","BMXSQL5",180,0)
S BMXGNOD1=$$PTYPE(BMXGNOD1)
"RTN","BMXSQL5",181,0)
Q BMXGNOD1
"RTN","BMXSQL6")
0^103^B130304448
"RTN","BMXSQL6",1,0)
BMXSQL6 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; 7/20/2009
"RTN","BMXSQL6",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXSQL6",3,0)
; Line EOR+3 used a 2 argument form of $Q which is not
"RTN","BMXSQL6",4,0)
; in the M 95 standard. Replaced this with a call to $$LAST,
"RTN","BMXSQL6",5,0)
; a new Extrinsic in this routine.
"RTN","BMXSQL6",6,0)
;
"RTN","BMXSQL6",7,0)
;
"RTN","BMXSQL6",8,0)
WRITE ;EP
"RTN","BMXSQL6",9,0)
N BMXFN,C,BMXN,BMXGF,BMXA,BMXFLDF,N,A,IEN0,I
"RTN","BMXSQL6",10,0)
N BMXCNT,BMXCNTB,BMXLEN,BMXLTMP,BMXNUM,BMXORD,BMXTYP
"RTN","BMXSQL6",11,0)
N BMXCFN,BMXCFNX,F,BMXROOT,BMXCID,BMXZ ;From MAKEC
"RTN","BMXSQL6",12,0)
N BMXREC,BMXCHAIN ;TODO: COMMENT AFTER TESTING
"RTN","BMXSQL6",13,0)
N BMXIENS
"RTN","BMXSQL6",14,0)
;Set up FIELD value for GETS^DIQ call
"RTN","BMXSQL6",15,0)
; BMXFLD("NAME")="FILE#^FIELD#"
"RTN","BMXSQL6",16,0)
; Need: BMXFLDN(FieldNumber)
"RTN","BMXSQL6",17,0)
; and : BMXFLDO(SelectOrder)
"RTN","BMXSQL6",18,0)
; Get file number -- for now just use first file in array
"RTN","BMXSQL6",19,0)
; TODO: Set up same main file and related files here and in enumerator
"RTN","BMXSQL6",20,0)
S C=0,BMXN=""
"RTN","BMXSQL6",21,0)
N F
"RTN","BMXSQL6",22,0)
S BMXGF=0
"RTN","BMXSQL6",23,0)
S F=0 F S F=$O(BMXF(F)) Q:F="" S BMXFN=BMXF(F) D
"RTN","BMXSQL6",24,0)
. S C=0,BMXN=-1 F S BMXN=$O(BMXFLDO(BMXN)) Q:BMXN="" D
"RTN","BMXSQL6",25,0)
. . Q:$P(BMXFLDO(BMXN),U)'=BMXFN
"RTN","BMXSQL6",26,0)
. . I $P(BMXFLDO(BMXN),U,2)=".001" S BMXGF=BMXGF+1 Q
"RTN","BMXSQL6",27,0)
. . S C=C+1
"RTN","BMXSQL6",28,0)
. . S $P(BMXGF(BMXFN),";",C)=$P(BMXFLDO(BMXN),U,2)
"RTN","BMXSQL6",29,0)
. . S:'$D(BMXGF(BMXFN,"INTERNAL")) BMXGF(BMXFN,"INTERNAL")="E"
"RTN","BMXSQL6",30,0)
. . I $P(BMXFLDO(BMXN),U,3)="I" S BMXGF(BMXFN,"INTERNAL")="IE"
"RTN","BMXSQL6",31,0)
. . S BMXGF=BMXGF+1
"RTN","BMXSQL6",32,0)
. . Q
"RTN","BMXSQL6",33,0)
. Q
"RTN","BMXSQL6",34,0)
;
"RTN","BMXSQL6",35,0)
I BMXGF>1 K BMXTK("DISTINCT") ;Distinct supported for only one field
"RTN","BMXSQL6",36,0)
S N=0,BMXFLDF=0,I=1,BMXNUM=0
"RTN","BMXSQL6",37,0)
D FIELDS
"RTN","BMXSQL6",38,0)
D MAKEC
"RTN","BMXSQL6",39,0)
;
"RTN","BMXSQL6",40,0)
;
"RTN","BMXSQL6",41,0)
I BMXCOL D COLTYPE^BMXSQL,ERRTACK^BMXSQL(I) Q ;Column info only
"RTN","BMXSQL6",42,0)
;
"RTN","BMXSQL6",43,0)
S BMXA="A"
"RTN","BMXSQL6",44,0)
N G,R
"RTN","BMXSQL6",45,0)
;---> Loop through results global
"RTN","BMXSQL6",46,0)
F S N=$O(^BMXTMP($J,N)) Q:'+N D
"RTN","BMXSQL6",47,0)
. K A
"RTN","BMXSQL6",48,0)
. S R=0 F S R=$O(BMXFO(R)) Q:'+R D ;For each file in ORDER array
"RTN","BMXSQL6",49,0)
. . S IEN0=0
"RTN","BMXSQL6",50,0)
. . S BMXFN=BMXFO(R)
"RTN","BMXSQL6",51,0)
. . Q:$D(BMXMFL(BMXFN,"MULT"))
"RTN","BMXSQL6",52,0)
. . I R=1 S IEN0=^BMXTMP($J,N) ;Primary file
"RTN","BMXSQL6",53,0)
. . I R>1,$D(BMXFJ("JOIN",BMXFN)) D ;Joined file
"RTN","BMXSQL6",54,0)
. . . S IEN0=0
"RTN","BMXSQL6",55,0)
. . . S G=BMXFJ("JOIN",BMXFN)
"RTN","BMXSQL6",56,0)
. . . S V=BMXFF(G,"JOIN","IEN")
"RTN","BMXSQL6",57,0)
. . . S @V=^BMXTMP($J,N)
"RTN","BMXSQL6",58,0)
. . . X BMXFF(G,"JOIN")
"RTN","BMXSQL6",59,0)
. . I +IEN0 D ;Removed $D(BMXGF(BMXFN)) for mult fld on extdnd ptr
"RTN","BMXSQL6",60,0)
. . . D SUBFILE(BMXFN)
"RTN","BMXSQL6",61,0)
. . I +IEN0,$D(BMXFLDN(BMXFN,.001)) D SETIEN(IEN0,BMXFN)
"RTN","BMXSQL6",62,0)
. . ;
"RTN","BMXSQL6",63,0)
. . I 0,R>1,$D(BMXMFL(BMXFN,"MULT")) D ;Multiple field
"RTN","BMXSQL6",64,0)
. . . Q:'+IEN0
"RTN","BMXSQL6",65,0)
. . . Q:'$D(BMXGF(BMXFN)) ;Intervening multiple
"RTN","BMXSQL6",66,0)
. . . ;Call GETS for each subentry in multiple
"RTN","BMXSQL6",67,0)
. . . X BMXMFL(BMXFN,"EXEC")
"RTN","BMXSQL6",68,0)
. S F=0,BMXCNT=0
"RTN","BMXSQL6",69,0)
. ;
"RTN","BMXSQL6",70,0)
. D RECORD
"RTN","BMXSQL6",71,0)
. D OUT
"RTN","BMXSQL6",72,0)
;
"RTN","BMXSQL6",73,0)
;
"RTN","BMXSQL6",74,0)
;---> Tack on Error Delimiter and any error.
"RTN","BMXSQL6",75,0)
S I=I+1
"RTN","BMXSQL6",76,0)
D ERRTACK^BMXSQL(I)
"RTN","BMXSQL6",77,0)
D COLTYPE^BMXSQL
"RTN","BMXSQL6",78,0)
Q
"RTN","BMXSQL6",79,0)
;
"RTN","BMXSQL6",80,0)
SETIEN(BMXIEN,BMXFN) ;
"RTN","BMXSQL6",81,0)
;B ;SETIEN
"RTN","BMXSQL6",82,0)
Q:'$D(BMXFLDN(BMXFN,.001))
"RTN","BMXSQL6",83,0)
Q:'+BMXIEN
"RTN","BMXSQL6",84,0)
S A(BMXFN,BMXIEN_",",.001,"E")=BMXIEN
"RTN","BMXSQL6",85,0)
Q
"RTN","BMXSQL6",86,0)
;
"RTN","BMXSQL6",87,0)
SUBFILE(BMXFN) ;
"RTN","BMXSQL6",88,0)
;Execute GETS for Any fields in BMXGF(SUBFILE)
"RTN","BMXSQL6",89,0)
;
"RTN","BMXSQL6",90,0)
;If the subfile itself has subfiles, call SUBFILE(BMXSUBFN)
"RTN","BMXSQL6",91,0)
; (Loop through BMXMFL(BMXFN,"SUBFILE",BMXSUBFN))
"RTN","BMXSQL6",92,0)
I $D(BMXMFL(BMXFN,"SUBFILE")) D
"RTN","BMXSQL6",93,0)
. N BMXSUBFN
"RTN","BMXSQL6",94,0)
. S BMXSUBFN=0
"RTN","BMXSQL6",95,0)
. F S BMXSUBFN=$O(BMXMFL(BMXFN,"SUBFILE",BMXSUBFN)) Q:'+BMXSUBFN D SUBFILE(BMXSUBFN)
"RTN","BMXSQL6",96,0)
. Q
"RTN","BMXSQL6",97,0)
;
"RTN","BMXSQL6",98,0)
I $D(BMXGF(BMXFN)) D
"RTN","BMXSQL6",99,0)
. I '$D(BMXMFL(BMXFN,"MULT")) S BMXMSCR=1 D GETS^DIQ(BMXFN,IEN0_",",BMXGF(BMXFN),BMXGF(BMXFN,"INTERNAL"),BMXA) Q
"RTN","BMXSQL6",100,0)
. E X BMXMFL(BMXFN,"EXEC") Q
"RTN","BMXSQL6",101,0)
;
"RTN","BMXSQL6",102,0)
;
"RTN","BMXSQL6",103,0)
Q
"RTN","BMXSQL6",104,0)
;
"RTN","BMXSQL6",105,0)
FIELDS ;---> Write Field Names
"RTN","BMXSQL6",106,0)
;Field name is TAAAAANAME
"RTN","BMXSQL6",107,0)
;Where T is the field type (T=Text; D=Date)
"RTN","BMXSQL6",108,0)
; AAAAA is the field size (see NUMCHAR routine)
"RTN","BMXSQL6",109,0)
; NAME is the field name
"RTN","BMXSQL6",110,0)
N BMXNUM,BMXFNUM,BMXFNAM,R
"RTN","BMXSQL6",111,0)
K BMXLEN,BMXTYP
"RTN","BMXSQL6",112,0)
S BMXFLDF=1
"RTN","BMXSQL6",113,0)
S BMXNUM=0
"RTN","BMXSQL6",114,0)
;B ;In FIELDS sub
"RTN","BMXSQL6",115,0)
D ;:$D(A)
"RTN","BMXSQL6",116,0)
. I BMXNUM S ^BMXTEMP($J,I)="IEN^",BMXLEN(I)=10,BMXTYP(I)="T",I=I+1 ;TODO: Change from text to number
"RTN","BMXSQL6",117,0)
. S BMXFNUM=0
"RTN","BMXSQL6",118,0)
. S BMXFNAM=0
"RTN","BMXSQL6",119,0)
. F R=0:1:(BMXFLDO-1) S BMXFN=$P(BMXFLDO(R),U),BMXFNUM=$P(BMXFLDO(R),U,2) D
"RTN","BMXSQL6",120,0)
. . ;S BMXFNAM=$P(^DD(BMXFN,BMXFNUM,0),"^") ;Get type here
"RTN","BMXSQL6",121,0)
. . S BMXFNAM=BMXFLDN(BMXFN,BMXFNUM)
"RTN","BMXSQL6",122,0)
. . I $P(BMXFLDO(R),U,3)="I" S BMXFNAM="INTERNAL["_BMXFNAM_"]"
"RTN","BMXSQL6",123,0)
. . S BMXFNAM=$TR(BMXFNAM," ","_")
"RTN","BMXSQL6",124,0)
. . I BMXF>1 S BMXFNAM=$TR($P(BMXFNX(BMXFN),".")," ","_")_"."_BMXFNAM
"RTN","BMXSQL6",125,0)
. . S BMXTYP(I)="T"
"RTN","BMXSQL6",126,0)
. . S:$P(BMXFLDO(R),U,5)="D" BMXTYP(I)="D"
"RTN","BMXSQL6",127,0)
. . S:$P(BMXFLDO(R),U,5)="I" BMXTYP(I)="I"
"RTN","BMXSQL6",128,0)
. . S BMXLEN(I)=0 ;Start with length zero
"RTN","BMXSQL6",129,0)
. . ;I $D(BMXFLDA(BMXFN,BMXFNUM)) S BMXFNAM=BMXFLDA(BMXFN,BMXFNUM)
"RTN","BMXSQL6",130,0)
. . I $P(BMXFLDO(R),U,6)]"" S BMXFNAM=$P(BMXFLDO(R),U,6)
"RTN","BMXSQL6",131,0)
. . S ^BMXTEMP($J,I)=BMXFNAM_"^"
"RTN","BMXSQL6",132,0)
. . S I=I+1
"RTN","BMXSQL6",133,0)
. S ^BMXTEMP($J,I-1)=$E(^BMXTEMP($J,I-1),1,$L(^BMXTEMP($J,I-1))-1)_$C(30)
"RTN","BMXSQL6",134,0)
Q
"RTN","BMXSQL6",135,0)
;
"RTN","BMXSQL6",136,0)
OUT ;
"RTN","BMXSQL6",137,0)
;Output to BMXTEMP($J
"RTN","BMXSQL6",138,0)
Q:'$D(BMXREC)
"RTN","BMXSQL6",139,0)
N J,K,L,BMXLENT
"RTN","BMXSQL6",140,0)
S J=0 F S J=$O(BMXREC(J)) Q:'+J D
"RTN","BMXSQL6",141,0)
. S K=0 F S K=$O(BMXREC(J,K)) Q:'+K D
"RTN","BMXSQL6",142,0)
. . I +$O(BMXREC(J,K,0)) D Q ;WP
"RTN","BMXSQL6",143,0)
. . . S L=0,BMXLENT=0 F S L=$O(BMXREC(J,K,L)) Q:'+L D
"RTN","BMXSQL6",144,0)
. . . . S:'$D(^BMXTEMP($J,I)) ^BMXTEMP($J,I)=""
"RTN","BMXSQL6",145,0)
. . . . S:$L(^BMXTEMP($J,I))>250 I=I+1,^BMXTEMP($J,I)=""
"RTN","BMXSQL6",146,0)
. . . . S ^BMXTEMP($J,I)=^BMXTEMP($J,I)_BMXREC(J,K,L)
"RTN","BMXSQL6",147,0)
. . . . S BMXLENT=BMXLENT+$L(BMXREC(J,K,L))
"RTN","BMXSQL6",148,0)
. . . I BMXLEN(K)<BMXLENT S BMXLEN(K)=BMXLENT
"RTN","BMXSQL6",149,0)
. . S:'$D(^BMXTEMP($J,I)) ^BMXTEMP($J,I)=""
"RTN","BMXSQL6",150,0)
. . S:$L(^BMXTEMP($J,I))>250 I=I+1,^BMXTEMP($J,I)=""
"RTN","BMXSQL6",151,0)
. . I $G(BMXTK("DISTINCT"))="TRUE",BMXREC(J,K)]"" Q:$D(^BMXTEMP($J,"DISTINCT",BMXREC(J,K)))
"RTN","BMXSQL6",152,0)
. . S ^BMXTEMP($J,I)=^BMXTEMP($J,I)_BMXREC(J,K)
"RTN","BMXSQL6",153,0)
. . S:$L(BMXREC(J,K))>BMXLEN(K) BMXLEN(K)=$L(BMXREC(J,K))
"RTN","BMXSQL6",154,0)
. . I $G(BMXTK("DISTINCT"))="TRUE" S ^BMXTEMP($J,"DISTINCT",BMXREC(J,K))=""
"RTN","BMXSQL6",155,0)
Q
"RTN","BMXSQL6",156,0)
;
"RTN","BMXSQL6",157,0)
RECORD ;
"RTN","BMXSQL6",158,0)
;For each chain
"RTN","BMXSQL6",159,0)
N C,BMXCQ,BMXLCQ,BMXCQN,BMXLCQN,BMXTRACK,BMXNODE,BMXCNAME,BMXWP
"RTN","BMXSQL6",160,0)
K BMXREC,BMXCHAIN ;TODO: REMOVE AFTER TESTING
"RTN","BMXSQL6",161,0)
D BLDCHN
"RTN","BMXSQL6",162,0)
S BMXREC=0
"RTN","BMXSQL6",163,0)
D RECINI
"RTN","BMXSQL6",164,0)
S C=0 F S C=$O(BMXCHAIN(C)) Q:'+C D
"RTN","BMXSQL6",165,0)
. ;New chain
"RTN","BMXSQL6",166,0)
. ;Go to the end of the chain, writing record pieces as you go
"RTN","BMXSQL6",167,0)
. ;At the end of the chain, write end-of-record marker,increment record counter, copy previous record
"RTN","BMXSQL6",168,0)
. K BMXTRACK
"RTN","BMXSQL6",169,0)
. S BMXCNAME="BMXCHAIN("_C_")"
"RTN","BMXSQL6",170,0)
. S BMXCQN=""
"RTN","BMXSQL6",171,0)
. S BMXCQ=BMXCNAME F S BMXCQ=$Q(@BMXCQ) Q:BMXCQ="" Q:$P(BMXCQ,",")'=("BMXCHAIN("_C) D
"RTN","BMXSQL6",172,0)
. . S BMXNODE=@BMXCQ
"RTN","BMXSQL6",173,0)
. . I $P(BMXNODE,U,2)="" Q
"RTN","BMXSQL6",174,0)
. . S BMXWP=$P(BMXNODE,U,3)
"RTN","BMXSQL6",175,0)
. . S BMXLCQ=$L(BMXCQ,",")
"RTN","BMXSQL6",176,0)
. . S BMXCQN=$Q(@BMXCQ)
"RTN","BMXSQL6",177,0)
. . S BMXLCQN=$L(BMXCQN,",")
"RTN","BMXSQL6",178,0)
. . I BMXWP="W" D
"RTN","BMXSQL6",179,0)
. . . S BMXREC(BMXREC,$P(BMXNODE,U,2),$P(BMXNODE,U,4))=$P(BMXNODE,U)
"RTN","BMXSQL6",180,0)
. . . S BMXTRACK(BMXLCQ-1,$P(BMXNODE,U,2))=BMXNODE
"RTN","BMXSQL6",181,0)
. . E D
"RTN","BMXSQL6",182,0)
. . . S BMXREC(BMXREC,$P(BMXNODE,U,2))=$P(BMXNODE,U)_U
"RTN","BMXSQL6",183,0)
. . . S BMXTRACK(BMXLCQ,$P(BMXNODE,U,2))=BMXNODE
"RTN","BMXSQL6",184,0)
. . I BMXCQN="" D EOR Q
"RTN","BMXSQL6",185,0)
. . I $P(BMXCQN,",")'=("BMXCHAIN("_C) D EOR Q
"RTN","BMXSQL6",186,0)
. . I BMXLCQN>BMXLCQ Q
"RTN","BMXSQL6",187,0)
. . I (BMXLCQN>$S(BMXWP="W":7,1:6)) D Q
"RTN","BMXSQL6",188,0)
. . . I ($P(BMXCQ,",",1,BMXLCQ-2)=$P(BMXCQN,",",1,BMXLCQN-2)) Q
"RTN","BMXSQL6",189,0)
. . . D EOR ;End of chain
"RTN","BMXSQL6",190,0)
Q
"RTN","BMXSQL6",191,0)
;
"RTN","BMXSQL6",192,0)
RECINI ;
"RTN","BMXSQL6",193,0)
N J
"RTN","BMXSQL6",194,0)
S BMXREC=BMXREC+1
"RTN","BMXSQL6",195,0)
F J=1:1:BMXFLDO D
"RTN","BMXSQL6",196,0)
. I $P(BMXFLDO(J-1),U,4)="W" S BMXREC(BMXREC,J,999999)="^" Q
"RTN","BMXSQL6",197,0)
. S BMXREC(BMXREC,J)="^"
"RTN","BMXSQL6",198,0)
Q
"RTN","BMXSQL6",199,0)
;
"RTN","BMXSQL6",200,0)
EOR ;
"RTN","BMXSQL6",201,0)
;B ;EOR
"RTN","BMXSQL6",202,0)
N J,K,L,M,I,N
"RTN","BMXSQL6",203,0)
; S M=$Q(BMXREC(9999999),-1) //SMH - Another Cacheism
"RTN","BMXSQL6",204,0)
S M=$$LAST("BMXREC")
"RTN","BMXSQL6",205,0)
S @M=$TR(@M,"^",$C(30))
"RTN","BMXSQL6",206,0)
Q:BMXCQN=""
"RTN","BMXSQL6",207,0)
I BMXCQN'="" D RECINI
"RTN","BMXSQL6",208,0)
;K BMXTRACK(BMXLCQ) ;Also kill all track levels between current and next level
"RTN","BMXSQL6",209,0)
F K BMXTRACK($O(BMXTRACK(999999),-1)) Q:$O(BMXTRACK(9999999),-1)'>BMXLCQN
"RTN","BMXSQL6",210,0)
S J=0 F S J=$O(BMXTRACK(J)) Q:'+J D ;Level
"RTN","BMXSQL6",211,0)
. S K=0 F S K=$O(BMXTRACK(J,K)) Q:'+K D ;Order
"RTN","BMXSQL6",212,0)
. . I $D(BMXTRACK(J,K)) S BMXNODE=BMXTRACK(J,K) S BMXREC(BMXREC,$P(BMXNODE,U,2))=$P(BMXNODE,U)_U
"RTN","BMXSQL6",213,0)
. . S L=0 F S L=$O(BMXTRACK(J,K,L)) Q:'+L D ;wp node
"RTN","BMXSQL6",214,0)
. . . I $D(BMXTRACK(J,K,L)) S BMXNODE=BMXTRACK(J,K,L) S BMXREC(BMXREC,$P(BMXNODE,U,2),L)=$P(BMXNODE,U)
"RTN","BMXSQL6",215,0)
Q
"RTN","BMXSQL6",216,0)
;
"RTN","BMXSQL6",217,0)
BLDCHN ;
"RTN","BMXSQL6",218,0)
N B
"RTN","BMXSQL6",219,0)
D MAKEB
"RTN","BMXSQL6",220,0)
;D MAKEC
"RTN","BMXSQL6",221,0)
D BUILD
"RTN","BMXSQL6",222,0)
Q
"RTN","BMXSQL6",223,0)
;
"RTN","BMXSQL6",224,0)
MAKEC ;
"RTN","BMXSQL6",225,0)
;MAKE Chain
"RTN","BMXSQL6",226,0)
;How many chains are there?
"RTN","BMXSQL6",227,0)
S BMXZ=0 S BMXCID=1 K BMXCFN
"RTN","BMXSQL6",228,0)
;
"RTN","BMXSQL6",229,0)
;
"RTN","BMXSQL6",230,0)
;Create BMXCHNP(BMXCID)
"RTN","BMXSQL6",231,0)
S F=0 F S F=$O(BMXMFL(F)) Q:'+F I '$D(BMXMFL("SUBFILE",F)),$D(BMXMFL("PARENT",F)) S BMXMFL("BOTTOM",F)=""
"RTN","BMXSQL6",232,0)
N BMXCB,BMXCHNP,BMXP
"RTN","BMXSQL6",233,0)
S BMXCID=0,BMXCB=0,BMXCHNP=0
"RTN","BMXSQL6",234,0)
I $D(BMXMFL("BOTTOM")) F S BMXCB=$O(BMXMFL("BOTTOM",BMXCB)) Q:'BMXCB D
"RTN","BMXSQL6",235,0)
. S BMXCID=BMXCID+1,BMXCHNP=BMXCID
"RTN","BMXSQL6",236,0)
. S BMXCHNP(BMXCID)=BMXCB
"RTN","BMXSQL6",237,0)
. S BMXP=BMXCB
"RTN","BMXSQL6",238,0)
. F Q:'$D(BMXMFL("PARENT",BMXP)) S BMXP=BMXMFL("PARENT",BMXP) S BMXCHNP(BMXCID)=BMXP_U_BMXCHNP(BMXCID)
"RTN","BMXSQL6",239,0)
;
"RTN","BMXSQL6",240,0)
N J,K,L,M
"RTN","BMXSQL6",241,0)
;Create BMXMFL("BASE")="FILE1^FILE2^...^FILEN"
"RTN","BMXSQL6",242,0)
S F=0,M=0,BMXMFL("BASE")="" F S F=$O(BMXMFL(F)) Q:'+F I (('$D(BMXMFL("PARENT",F)))&('$D(BMXMFL(F,"SUBFILE"))))!(BMXFO(1)=F) S M=M+1,$P(BMXMFL("BASE"),U,M)=F ;Changed to make BMXFO(1) always a member of the base
"RTN","BMXSQL6",243,0)
;
"RTN","BMXSQL6",244,0)
;Create BMXCFN(BMXCID,BMXZ,FILE)
"RTN","BMXSQL6",245,0)
I BMXCID=0 S BMXCID=1
"RTN","BMXSQL6",246,0)
S J=0,BMXZ=0 F J=1:1:BMXCID D
"RTN","BMXSQL6",247,0)
. I BMXMFL("BASE")]"" F L=1:1:$L(BMXMFL("BASE"),"^") S F=$P(BMXMFL("BASE"),"^",L) D
"RTN","BMXSQL6",248,0)
. . S BMXZ=BMXZ+100
"RTN","BMXSQL6",249,0)
. . S BMXCFN(J,BMXZ,F)=""
"RTN","BMXSQL6",250,0)
. I +BMXCHNP F K=1:1:$L(BMXCHNP(J),"^") S F=$P(BMXCHNP(J),"^",K) D
"RTN","BMXSQL6",251,0)
. . Q:F=BMXFO(1) ;BMXFO(1) Is always a member of the base
"RTN","BMXSQL6",252,0)
. . S BMXZ=BMXZ+100
"RTN","BMXSQL6",253,0)
. . S BMXCFN(J,BMXZ,F)=""
"RTN","BMXSQL6",254,0)
;
"RTN","BMXSQL6",255,0)
;
"RTN","BMXSQL6",256,0)
;B ;FIXCFN
"RTN","BMXSQL6",257,0)
D FIXCFN
"RTN","BMXSQL6",258,0)
Q
"RTN","BMXSQL6",259,0)
;
"RTN","BMXSQL6",260,0)
BUILD ;Building BMXCHAIN(
"RTN","BMXSQL6",261,0)
N BMXIEN,BMXCID,BMXFLD,BMXCS,BMXINT,BMXCFNC,BMXCFIEN
"RTN","BMXSQL6",262,0)
S BMXCID=0,BMXIEN=0
"RTN","BMXSQL6",263,0)
F S BMXCID=$O(BMXCFN(BMXCID)) Q:'+BMXCID D
"RTN","BMXSQL6",264,0)
. S BMXCFNC=0 F S BMXCFNC=$O(BMXCFN(BMXCID,BMXCFNC)) Q:'+BMXCFNC S BMXCFN=+BMXCFN(BMXCID,BMXCFNC) D
"RTN","BMXSQL6",265,0)
. . S BMXIEN=0 F S BMXIEN=$O(B(BMXCFN,BMXIEN)) Q:BMXIEN="" D
"RTN","BMXSQL6",266,0)
. . . S $P(BMXCFN(BMXCID,BMXCFNC),U,2)=BMXIEN
"RTN","BMXSQL6",267,0)
. . . S BMXFLD=0 F S BMXFLD=$O(B(BMXCFN,BMXIEN,BMXFLD)) Q:'+BMXFLD D
"RTN","BMXSQL6",268,0)
. . . . S BMXINT="D" F S BMXINT=$O(B(BMXCFN,BMXIEN,BMXFLD,BMXINT)) Q:BMXINT="" D
"RTN","BMXSQL6",269,0)
. . . . . Q:'$D(BMXFLDOX(BMXCFN,BMXFLD,BMXINT))
"RTN","BMXSQL6",270,0)
. . . . . I $P(BMXFLDO(BMXFLDOX(BMXCFN,BMXFLD,BMXINT)),U,4)="W" D MCWP Q
"RTN","BMXSQL6",271,0)
. . . . . D FIXIEN
"RTN","BMXSQL6",272,0)
. . . . . S BMXCS="BMXCHAIN("_BMXCID_","_$S($L(BMXIEN,",")=2:1,1:2)_","_BMXCFIEN_","_BMXFLD_","_$C(34)_BMXINT_$C(34)_")"
"RTN","BMXSQL6",273,0)
. . . . . S @BMXCS=B(BMXCFN,BMXIEN,BMXFLD,BMXINT)_U_(BMXFLDOX(BMXCFN,BMXFLD,BMXINT)+1)
"RTN","BMXSQL6",274,0)
Q
"RTN","BMXSQL6",275,0)
;
"RTN","BMXSQL6",276,0)
FIXIEN ;
"RTN","BMXSQL6",277,0)
N BMXC,BMXCFN1,BMXOFF
"RTN","BMXSQL6",278,0)
S BMXC=BMXCFNC
"RTN","BMXSQL6",279,0)
S BMXCFIEN=BMXCFN_","_$P(BMXIEN,",",$L(BMXIEN,","))
"RTN","BMXSQL6",280,0)
S BMXOFF=1
"RTN","BMXSQL6",281,0)
F S BMXC=$O(BMXCFN(BMXCID,BMXC),-1) Q:'+BMXC D
"RTN","BMXSQL6",282,0)
. S BMXCFN1=+BMXCFN(BMXCID,BMXC)
"RTN","BMXSQL6",283,0)
. I '$D(BMXMFL(BMXCFN,"OTM")) D
"RTN","BMXSQL6",284,0)
. . I '$D(BMXMFL(BMXCFN1,"SUBFILE",BMXCFN)) Q
"RTN","BMXSQL6",285,0)
. . S BMXCFIEN=BMXCFN1_","_$P(BMXIEN,",",$L(BMXIEN,",")-BMXOFF)_","_BMXCFIEN
"RTN","BMXSQL6",286,0)
. I $D(BMXMFL(BMXCFN,"OTM")) D
"RTN","BMXSQL6",287,0)
. . I '$D(BMXMFL(BMXCFN1,"SUBFILE",BMXCFN)) Q
"RTN","BMXSQL6",288,0)
. . S BMXCFIEN=BMXCFN1_$P(BMXCFN(BMXCID,BMXC),U,2)_","_BMXCFIEN
"RTN","BMXSQL6",289,0)
. S BMXOFF=BMXOFF+1
"RTN","BMXSQL6",290,0)
;
"RTN","BMXSQL6",291,0)
;
"RTN","BMXSQL6",292,0)
Q
"RTN","BMXSQL6",293,0)
;
"RTN","BMXSQL6",294,0)
FIXCFN ;
"RTN","BMXSQL6",295,0)
N J,K,L
"RTN","BMXSQL6",296,0)
S J=0 F S J=$O(BMXCFN(J)) Q:'+J D
"RTN","BMXSQL6",297,0)
. S K=0 F S K=$O(BMXCFN(J,K)) Q:'+K D
"RTN","BMXSQL6",298,0)
. . S L=0 F S L=$O(BMXCFN(J,K,L)) Q:'+L D
"RTN","BMXSQL6",299,0)
. . . K BMXCFN(J,K,L)
"RTN","BMXSQL6",300,0)
. . . S BMXCFN(J,K)=L
"RTN","BMXSQL6",301,0)
;
"RTN","BMXSQL6",302,0)
Q
"RTN","BMXSQL6",303,0)
;
"RTN","BMXSQL6",304,0)
MCWP ;
"RTN","BMXSQL6",305,0)
;MAKEC Process WP Field
"RTN","BMXSQL6",306,0)
N BMXIENL,BMXWP
"RTN","BMXSQL6",307,0)
S BMXIENL=1
"RTN","BMXSQL6",308,0)
S:$L(BMXIEN,",")>2 BMXIENL=2
"RTN","BMXSQL6",309,0)
S BMXWP=0
"RTN","BMXSQL6",310,0)
;
"RTN","BMXSQL6",311,0)
F S BMXWP=$O(B(BMXCFN,BMXIEN,BMXFLD,BMXWP)) Q:'+BMXWP D
"RTN","BMXSQL6",312,0)
. S BMXCS="BMXCHAIN("_BMXCID_","_BMXIENL_","_BMXCFN_BMXIEN_","_BMXFLD_","_$C(34)_BMXINT_$C(34)_","_BMXWP_")"
"RTN","BMXSQL6",313,0)
. S @BMXCS=B(BMXCFN,BMXIEN,BMXFLD,BMXWP)_U_(BMXFLDOX(BMXCFN,BMXFLD,BMXINT)+1)_U_"W"_U_BMXWP
"RTN","BMXSQL6",314,0)
Q
"RTN","BMXSQL6",315,0)
;
"RTN","BMXSQL6",316,0)
;
"RTN","BMXSQL6",317,0)
MAKEB ;
"RTN","BMXSQL6",318,0)
N BMXFILE,BMXIEN,BMXFLD,BMXINT
"RTN","BMXSQL6",319,0)
N BMXSUB,BMXIENR
"RTN","BMXSQL6",320,0)
S BMXFILE=0 F S BMXFILE=$O(A(BMXFILE)) Q:'+BMXFILE D
"RTN","BMXSQL6",321,0)
. S BMXIEN=0 F S BMXIEN=$O(A(BMXFILE,BMXIEN)) Q:'+BMXIEN D
"RTN","BMXSQL6",322,0)
. . S BMXFLD=0 F S BMXFLD=$O(A(BMXFILE,BMXIEN,BMXFLD)) Q:'+BMXFLD D
"RTN","BMXSQL6",323,0)
. . . S BMXINT=0 F S BMXINT=$O(A(BMXFILE,BMXIEN,BMXFLD,BMXINT)) Q:BMXINT="" D
"RTN","BMXSQL6",324,0)
. . . . S BMXIENR=$$REVERSE(BMXIEN)
"RTN","BMXSQL6",325,0)
. . . . S BMXSUB="B("_BMXFILE_","_$C(34)_BMXIENR_$C(34)_","_BMXFLD_","_$C(34)_BMXINT_$C(34)_")"
"RTN","BMXSQL6",326,0)
. . . . I $D(BMXFLDOX(BMXFILE,BMXFLD,BMXINT)),$P(BMXFLDO(BMXFLDOX(BMXFILE,BMXFLD,BMXINT)),U,5)="D" D Q
"RTN","BMXSQL6",327,0)
. . . . . S @BMXSUB=$TR(A(BMXFILE,BMXIEN,BMXFLD,BMXINT),"@"," ")
"RTN","BMXSQL6",328,0)
. . . . S @BMXSUB=A(BMXFILE,BMXIEN,BMXFLD,BMXINT)
"RTN","BMXSQL6",329,0)
Q
"RTN","BMXSQL6",330,0)
;
"RTN","BMXSQL6",331,0)
REVERSE(BMXIEN) ;
"RTN","BMXSQL6",332,0)
N J,T,C
"RTN","BMXSQL6",333,0)
S C=1
"RTN","BMXSQL6",334,0)
F J=$L(BMXIEN,","):-1:1 D
"RTN","BMXSQL6",335,0)
. S $P(T,",",C)=$P(BMXIEN,",",J)
"RTN","BMXSQL6",336,0)
. S C=C+1
"RTN","BMXSQL6",337,0)
Q T
"RTN","BMXSQL6",338,0)
LAST(VAR) ; Get last entry in an array //SMH new code
"RTN","BMXSQL6",339,0)
N SUB1 S SUB1=$O(@VAR@(""),-1)
"RTN","BMXSQL6",340,0)
N SUB2 S SUB2=$O(@VAR@(SUB1,""),-1)
"RTN","BMXSQL6",341,0)
N SUB3 S SUB3=$O(@VAR@(SUB1,SUB2,""),-1)
"RTN","BMXSQL6",342,0)
I SUB3="" Q $NA(@VAR@(SUB1,SUB2))
"RTN","BMXSQL6",343,0)
E Q $NA(@VAR@(SUB1,SUB2,SUB3))
"RTN","BMXSQL7")
0^104^B65321243
"RTN","BMXSQL7",1,0)
BMXSQL7 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
"RTN","BMXSQL7",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXSQL7",3,0)
;
"RTN","BMXSQL7",4,0)
;
"RTN","BMXSQL7",5,0)
CHKCR(BMXFNUM,BMXFLDNU,BMXRET) ;Returns cross reference to iterate on for related file
"RTN","BMXSQL7",6,0)
N BMXREF,BMXHIT,BMXRNOD,BMXTMP,BMXTMPV,BMXTMPI,BMXTMPP,BMXPFFN,BMXPFF,Q
"RTN","BMXSQL7",7,0)
N BMXHIT,BMXREF,BMXGL,BMXNOD,BMXRNAM,BMXTMPL,BMXTMPN,BMXTST
"RTN","BMXSQL7",8,0)
;
"RTN","BMXSQL7",9,0)
S BMXNOD=^DD(BMXFNUM,BMXFLDNU,0)
"RTN","BMXSQL7",10,0)
S BMXGL=^DIC(BMXFNUM,0,"GL") ;Subfile global
"RTN","BMXSQL7",11,0)
S BMXREF=0,BMXHIT=0,Q=$C(34),BMXRET=""
"RTN","BMXSQL7",12,0)
F S BMXREF=$O(^DD(BMXFNUM,BMXFLDNU,1,BMXREF)) Q:'+BMXREF D Q:BMXHIT
"RTN","BMXSQL7",13,0)
. Q:'$D(^DD(BMXFNUM,BMXFLDNU,1,BMXREF,0))
"RTN","BMXSQL7",14,0)
. S BMXRNOD=^DD(BMXFNUM,BMXFLDNU,1,BMXREF,0)
"RTN","BMXSQL7",15,0)
. Q:$P(BMXRNOD,U,3)]""
"RTN","BMXSQL7",16,0)
. S BMXRNAM=$P(BMXRNOD,U,2)
"RTN","BMXSQL7",17,0)
. S BMXTMP=BMXGL_Q_BMXRNAM_Q_")"
"RTN","BMXSQL7",18,0)
. S BMXTST=$P(BMXTMP,")")_",IEN0,"
"RTN","BMXSQL7",19,0)
. Q:'$D(@BMXTMP)
"RTN","BMXSQL7",20,0)
. S BMXTMPV=0,BMXTMPV=$O(@BMXTMP@(BMXTMPV))
"RTN","BMXSQL7",21,0)
. Q:BMXTMPV=""
"RTN","BMXSQL7",22,0)
. S BMXTMP=BMXGL_Q_BMXRNAM_Q_","_Q_BMXTMPV_Q_")"
"RTN","BMXSQL7",23,0)
. S BMXTMPI=0,BMXTMPI=$O(@BMXTMP@(BMXTMPI))
"RTN","BMXSQL7",24,0)
. S BMXTMP=$S(BMXGL[",":$P(BMXGL,",")_")",1:$P(BMXGL,"("))
"RTN","BMXSQL7",25,0)
. Q:'$D(@BMXTMP@(BMXTMPI))
"RTN","BMXSQL7",26,0)
. S BMXTMPL=$P(BMXNOD,U,4)
"RTN","BMXSQL7",27,0)
. S BMXTMPP=$P(BMXTMPL,";",2)
"RTN","BMXSQL7",28,0)
. S BMXTMPL=$P(BMXTMPL,";")
"RTN","BMXSQL7",29,0)
. Q:BMXTMPL=""
"RTN","BMXSQL7",30,0)
. S BMXTMP=BMXGL_BMXTMPI_")"
"RTN","BMXSQL7",31,0)
. Q:'$D(@BMXTMP@(BMXTMPL))
"RTN","BMXSQL7",32,0)
. S BMXTMPN=@BMXTMP@(BMXTMPL)
"RTN","BMXSQL7",33,0)
. S BMXTMPP=$P(BMXTMPN,"^",BMXTMPP)
"RTN","BMXSQL7",34,0)
. I BMXTMPP=BMXTMPV S BMXRET=BMXTST,BMXHIT=1
"RTN","BMXSQL7",35,0)
Q BMXHIT
"RTN","BMXSQL7",36,0)
;
"RTN","BMXSQL7",37,0)
;
"RTN","BMXSQL7",38,0)
WHERE ;EP - WHERE-clause processing
"RTN","BMXSQL7",39,0)
;
"RTN","BMXSQL7",40,0)
;Set up the defualt iterator in BMXX(1) to scan the entire file.
"RTN","BMXSQL7",41,0)
;For now, just use first file in the FROM group
"RTN","BMXSQL7",42,0)
;Later, pick the smallest file if more than one file
"RTN","BMXSQL7",43,0)
;
"RTN","BMXSQL7",44,0)
;Set up BMXFF array for each expression element
"RTN","BMXSQL7",45,0)
; BMXFF(n)=FILENAME^FIELDNAME^OPERATOR^VALUE^FILENUMBER^FIELDNUMBER
"RTN","BMXSQL7",46,0)
; ^FILE GLOBAL^FIELD DATA LOCATION
"RTN","BMXSQL7",47,0)
; BMXFF(n,0)=Field descriptor ^DD(FILE,FIELD,0)
"RTN","BMXSQL7",48,0)
;
"RTN","BMXSQL7",49,0)
N BMXGL,BMXOP,BMXTYP,BMXV,BMXV1,BMXV2,BMXFILE,BMXTMP
"RTN","BMXSQL7",50,0)
N BMXINTNL,BMXTMPLT
"RTN","BMXSQL7",51,0)
N BMXIEN
"RTN","BMXSQL7",52,0)
S BMXGL=^DIC(BMXFO(1),0,"GL")
"RTN","BMXSQL7",53,0)
S BMXX=1
"RTN","BMXSQL7",54,0)
S BMXX(1)="S D0=0 F S D0=$O("_BMXGL_"D0)) Q:'+D0 Q:BMXM>BMXXMAX "
"RTN","BMXSQL7",55,0)
S BMXTMP=BMXGL
"RTN","BMXSQL7",56,0)
I BMXTMP["," S BMXTMP=$TR(BMXTMP,",",")")
"RTN","BMXSQL7",57,0)
E S BMXTMP=$P(BMXTMP,"(",1)
"RTN","BMXSQL7",58,0)
I $D(@BMXTMP@("B")) D
"RTN","BMXSQL7",59,0)
. S BMXX(1)="S BMXTMP=0 F S BMXTMP=$O("_BMXGL_$C(34)_"B"_$C(34)_",BMXTMP)) Q:BMXTMP="""" S D0=0 F S D0=$O("_BMXGL_$C(34)_"B"_$C(34)_",BMXTMP,D0)) Q:'+D0 Q:BMXM>BMXXMAX "
"RTN","BMXSQL7",60,0)
;
"RTN","BMXSQL7",61,0)
;--->BMXFF array:
"RTN","BMXSQL7",62,0)
;
"RTN","BMXSQL7",63,0)
S T=$G(BMXTK("WHERE"))
"RTN","BMXSQL7",64,0)
S BMXFF=0,C=0
"RTN","BMXSQL7",65,0)
Q:'+T
"RTN","BMXSQL7",66,0)
F S T=$O(BMXTK(T)) Q:'+T Q:T=$G(BMXTK("ORDER BY")) Q:T=$G(BMXTK("GROUP BY")) D Q:$D(BMXERR)
"RTN","BMXSQL7",67,0)
. ;Get the file of the field
"RTN","BMXSQL7",68,0)
. I "AND^OR^(^)"[BMXTK(T) D Q
"RTN","BMXSQL7",69,0)
. . S C=C+1
"RTN","BMXSQL7",70,0)
. . S BMXFF(C)=BMXTK(T)
"RTN","BMXSQL7",71,0)
. . S BMXFF=C
"RTN","BMXSQL7",72,0)
. S BMXTK(T)=$TR(BMXTK(T),"_"," ")
"RTN","BMXSQL7",73,0)
. S BMXTK(T)=$TR(BMXTK(T),"'","")
"RTN","BMXSQL7",74,0)
. S BMXINTNL=0
"RTN","BMXSQL7",75,0)
. S BMXTMPLT=0
"RTN","BMXSQL7",76,0)
. S BMXIEN=0
"RTN","BMXSQL7",77,0)
. I BMXTK(T)["INTERNAL[" S BMXINTNL=1,BMXTK(T)=$P(BMXTK(T),"[",2),BMXTK(T)=$P(BMXTK(T),"]",1)
"RTN","BMXSQL7",78,0)
. I BMXTK(T)["TEMPLATE[" S BMXTMPLT=1,BMXTK(T)=$P(BMXTK(T),"[",2),BMXTK(T)=$P(BMXTK(T),"]",1),BMXIEN=1
"RTN","BMXSQL7",79,0)
. I BMXTK(T)["BMXIEN" S BMXIEN=1
"RTN","BMXSQL7",80,0)
. S BMXFILE=$$FLDFILE^BMXSQL2(BMXTK(T))
"RTN","BMXSQL7",81,0)
. Q:$D(BMXERR)
"RTN","BMXSQL7",82,0)
. S C=C+1
"RTN","BMXSQL7",83,0)
. S BMXFF=C ;This is a count of the where fields
"RTN","BMXSQL7",84,0)
. I BMXFILE]"" D
"RTN","BMXSQL7",85,0)
. . S $P(BMXFF(C),U,1)=$P(BMXFILE,U,1) ;FILENAME
"RTN","BMXSQL7",86,0)
. . S $P(BMXFF(C),U,2)=$P(BMXFILE,U,2) ;FIELDNAME
"RTN","BMXSQL7",87,0)
. . S $P(BMXFF(C),U,5)=$P(BMXFILE,U,3) ;FILENUMBER
"RTN","BMXSQL7",88,0)
. . S $P(BMXFF(C),U,6)=$P(BMXFILE,U,4) ;FIELDNUMBER
"RTN","BMXSQL7",89,0)
. . I $P(BMXFILE,U,3),$D(^DIC($P(BMXFILE,U,3),0,"GL")) S $P(BMXFF(C),U,7)=^DIC($P(BMXFILE,U,3),0,"GL")
"RTN","BMXSQL7",90,0)
. . I BMXIEN S BMXFF(C,0)="IEN",BMXFF(C,"IEN")=1,BMXFF(C,"TYPE")="IEN"
"RTN","BMXSQL7",91,0)
. . E S BMXFF(C,0)=$S(+$P(BMXFILE,U,3):^DD($P(BMXFILE,U,3),$P(BMXFILE,U,4),0),1:"")
"RTN","BMXSQL7",92,0)
. . I BMXINTNL S BMXFF(C,"INTERNAL")=1
"RTN","BMXSQL7",93,0)
. ;
"RTN","BMXSQL7",94,0)
. ;If BMXFF(C) is a pointer, traverse pointer chain to retrieve type
"RTN","BMXSQL7",95,0)
. I $P(BMXFF(C,0),U,2)["P" D
"RTN","BMXSQL7",96,0)
. . ;B ;WHERE Pointer Type
"RTN","BMXSQL7",97,0)
. . N BMXFILN,BMXFLDN,BMXDD
"RTN","BMXSQL7",98,0)
. . S BMXDD=BMXFF(C,0)
"RTN","BMXSQL7",99,0)
. . F Q:$P(BMXDD,U,2)'["P" D:$P(BMXDD,U,2)["P"
"RTN","BMXSQL7",100,0)
. . . S BMXFILN=$P(BMXDD,U,2)
"RTN","BMXSQL7",101,0)
. . . S BMXFILN=+$P(BMXFILN,"P",2)
"RTN","BMXSQL7",102,0)
. . . S BMXDD=^DD(BMXFILN,".01",0)
"RTN","BMXSQL7",103,0)
. . S BMXFF(C,"TYPE")=$S($P(BMXDD,U,2)["D":"DATE",$P(BMXDD,U,2)["S":"SET",1:"OTHER")
"RTN","BMXSQL7",104,0)
. . I BMXFF(C,"TYPE")="SET" S $P(BMXFF(C,"TYPE"),U,2)=$P(BMXDD,U,3)
"RTN","BMXSQL7",105,0)
. ;B ;WHERE Set Type
"RTN","BMXSQL7",106,0)
. I ($P(BMXFF(C,0),U,2)["S")!($P($G(BMXFF(C,"TYPE")),U)="SET") D ;Set
"RTN","BMXSQL7",107,0)
. . N BMXSET,BMXSETP
"RTN","BMXSQL7",108,0)
. . I $P(BMXFF(C,0),U,2)["S" D
"RTN","BMXSQL7",109,0)
. . . S BMXFF(C,"TYPE")="SET"
"RTN","BMXSQL7",110,0)
. . . S $P(BMXFF(C,"TYPE"),U,2)=$P(BMXFF(C,0),U,3)
"RTN","BMXSQL7",111,0)
. . S BMXSET=$P(BMXFF(C,"TYPE"),U,2)
"RTN","BMXSQL7",112,0)
. . F J=1:1:$L(BMXSET,";") D
"RTN","BMXSQL7",113,0)
. . . S BMXSETP=$P(BMXSET,";",J)
"RTN","BMXSQL7",114,0)
. . . Q:BMXSETP=""
"RTN","BMXSQL7",115,0)
. . . S BMXFF(C,"SET",$P(BMXSETP,":",2))=$P(BMXSETP,":")
"RTN","BMXSQL7",116,0)
. ;
"RTN","BMXSQL7",117,0)
. ;Set up comparisons based on operators
"RTN","BMXSQL7",118,0)
. S T=T+1
"RTN","BMXSQL7",119,0)
. S BMXOP=BMXTK(T)
"RTN","BMXSQL7",120,0)
. I BMXTMPLT S BMXOP="="
"RTN","BMXSQL7",121,0)
. I "^<^>^=^[^<>^>=^<=^LIKE"[BMXOP D Q
"RTN","BMXSQL7",122,0)
. . S $P(BMXFF(C),U,3)=BMXTK(T)
"RTN","BMXSQL7",123,0)
. . ;Get the comparison value
"RTN","BMXSQL7",124,0)
. . S T=T+1
"RTN","BMXSQL7",125,0)
. . S BMXTMP=BMXTK(T)
"RTN","BMXSQL7",126,0)
. . S BMXTMP=$TR(BMXTMP,"'","")
"RTN","BMXSQL7",127,0)
. . I BMXOP="LIKE" S BMXTMP=$P(BMXTMP,"%"),$P(BMXFF(C),U,4)=BMXTMP Q
"RTN","BMXSQL7",128,0)
. . I BMXTMPLT D TMPLATE Q
"RTN","BMXSQL7",129,0)
. . I BMXTMP="*" S T=T+1,BMXTMP=BMXTK(T) D OTM Q
"RTN","BMXSQL7",130,0)
. . I BMXTMP[".",BMXTK(T)'["'" D ;This is a join ;TODO: Extended pointers
"RTN","BMXSQL7",131,0)
. . . ;Setting BMXFJ("JOIN"
"RTN","BMXSQL7",132,0)
. . . S BMXTMP=BMXTK(T)
"RTN","BMXSQL7",133,0)
. . . I $D(BMXF($P(BMXTMP,"."))),BMXF($P(BMXTMP,"."))=BMXFO(1) D Q
"RTN","BMXSQL7",134,0)
. . . . S BMXTMP=BMXTK(T-2)
"RTN","BMXSQL7",135,0)
. . . . D OTM
"RTN","BMXSQL7",136,0)
. . . N BMXJN
"RTN","BMXSQL7",137,0)
. . . S BMXFF(C,"JOIN")="Pointer chain"
"RTN","BMXSQL7",138,0)
. . . S BMXJN=+$P($P(BMXFF(C,0),U,2),"P",2)
"RTN","BMXSQL7",139,0)
. . . S BMXFJ("JOIN",+$P($P(BMXFF(C,0),U,2),"P",2))=C
"RTN","BMXSQL7",140,0)
. . . S:+$P($P(BMXFF(C,0),U,2),"P",2)=2 BMXFJ("JOIN",9000001)=C ;IHS Only -- auto join PATIENT to VA PATIENT
"RTN","BMXSQL7",141,0)
. . I ($P(BMXFF(C,0),U,2)["D")!($G(BMXFF(C,"TYPE"))="DATE") D ;Date
"RTN","BMXSQL7",142,0)
. . . Q:$D(BMXFF(C,"INTERNAL"))
"RTN","BMXSQL7",143,0)
. . . I BMXTMP]"" S X=BMXTMP,%DT="T" D ^%DT S BMXTMP=Y
"RTN","BMXSQL7",144,0)
. . I $P($G(BMXFF(C,"TYPE")),U)="SET" D
"RTN","BMXSQL7",145,0)
. . . Q:$D(BMXFF(C,"INTERNAL"))
"RTN","BMXSQL7",146,0)
. . . Q:BMXTMP=""
"RTN","BMXSQL7",147,0)
. . . I $G(BMXFF(C,"SET",BMXTMP))="" S BMXTMP="ZZZZZZ" Q
"RTN","BMXSQL7",148,0)
. . . S BMXTMP=$G(BMXFF(C,"SET",BMXTMP))
"RTN","BMXSQL7",149,0)
. . S $P(BMXFF(C),U,4)=BMXTMP
"RTN","BMXSQL7",150,0)
. . Q
"RTN","BMXSQL7",151,0)
. I BMXOP="BETWEEN" D
"RTN","BMXSQL7",152,0)
. . S $P(BMXFF(C),U,3)="BETWEEN"
"RTN","BMXSQL7",153,0)
. . ;Get the comparison value
"RTN","BMXSQL7",154,0)
. . S T=T+1
"RTN","BMXSQL7",155,0)
. . S BMXV1=BMXTK(T)
"RTN","BMXSQL7",156,0)
. . S:BMXV1["'" BMXV1=$P(BMXV1,"'",2)
"RTN","BMXSQL7",157,0)
. . S T=T+1
"RTN","BMXSQL7",158,0)
. . I BMXTK(T)'="AND" S BMXERR="'BETWEEN' VALUES NOT SPECIFIED" D ERROR Q
"RTN","BMXSQL7",159,0)
. . S T=T+1
"RTN","BMXSQL7",160,0)
. . S BMXV2=BMXTK(T)
"RTN","BMXSQL7",161,0)
. . S:BMXV2["'" BMXV2=$P(BMXV2,"'",2)
"RTN","BMXSQL7",162,0)
. . I ($P(BMXFF(C,0),U,2)["D")!($G(BMXFF(C,"TYPE"))="DATE") D ;Date
"RTN","BMXSQL7",163,0)
. . . Q:$D(BMXFF(C,"INTERNAL"))
"RTN","BMXSQL7",164,0)
. . . S X=BMXV1,%DT="T" D ^%DT S BMXV1=Y
"RTN","BMXSQL7",165,0)
. . . S X=BMXV2,%DT="T" D ^%DT S BMXV2=Y
"RTN","BMXSQL7",166,0)
. . I BMXV1>BMXV2 S BMXTMP=BMXV1,BMXV1=BMXV2,BMXV2=BMXTMP
"RTN","BMXSQL7",167,0)
. . S $P(BMXFF(C),U,4)=BMXV1_"~"_BMXV2
"RTN","BMXSQL7",168,0)
. . Q
"RTN","BMXSQL7",169,0)
. I $P(BMXFF(C),U,3)="" S BMXERR="INVALID OPERATOR" D ERROR Q
"RTN","BMXSQL7",170,0)
. I $D(BMXTK(T+1)),BMXTK(T+1)["[INDEX:" D
"RTN","BMXSQL7",171,0)
. . S T=T+1
"RTN","BMXSQL7",172,0)
. . N BMXIND
"RTN","BMXSQL7",173,0)
. . S BMXIND=$P(BMXTK(T),"INDEX:",2)
"RTN","BMXSQL7",174,0)
. . S:BMXIND["]" BMXIND=$P(BMXIND,"]")
"RTN","BMXSQL7",175,0)
. . S:BMXIND["'" BMXIND=$P(BMXIND,"'",2)
"RTN","BMXSQL7",176,0)
. . S BMXFF("INDEX")=BMXIND
"RTN","BMXSQL7",177,0)
. Q
"RTN","BMXSQL7",178,0)
;
"RTN","BMXSQL7",179,0)
Q:$D(BMXERR)
"RTN","BMXSQL7",180,0)
D JOIN^BMXSQL4
"RTN","BMXSQL7",181,0)
Q
"RTN","BMXSQL7",182,0)
;
"RTN","BMXSQL7",183,0)
TMPLATE ;
"RTN","BMXSQL7",184,0)
N BMXTNUM,BMXTNOD
"RTN","BMXSQL7",185,0)
I BMXTMP["[" S BMXTMP=$P(BMXTMP,"[",2),BMXTMP=$P(BMXTMP,"]")
"RTN","BMXSQL7",186,0)
S BMXTMP=$TR(BMXTMP,"_"," ")
"RTN","BMXSQL7",187,0)
;Test template validity
"RTN","BMXSQL7",188,0)
I '$D(^DIBT("B",BMXTMP)) S BMXERR="TEMPLATE NOT FOUND" D ERROR Q
"RTN","BMXSQL7",189,0)
S BMXTNUM=$O(^DIBT("B",BMXTMP,0))
"RTN","BMXSQL7",190,0)
I '$D(^DIBT(BMXTNUM,0)) S BMXERR="TEMPLATE NOT FOUND" D ERROR Q
"RTN","BMXSQL7",191,0)
S BMXTNOD=^DIBT(BMXTNUM,0)
"RTN","BMXSQL7",192,0)
I $P(BMXTNOD,U,4)'=$P(BMXFF(C),U,5) S BMXERR="TEMPLATE DOES NOT MATCH FILE" D ERROR Q
"RTN","BMXSQL7",193,0)
I '$D(^DIBT(BMXTNUM,1)) S BMXERR="TEMPLATE HAS NO ENTRIES" D ERROR Q
"RTN","BMXSQL7",194,0)
S BMXFF(C,0)="IEN",BMXFF(C,"IEN")="TEMPLATE",BMXFF(C,"TYPE")="IEN"
"RTN","BMXSQL7",195,0)
S $P(BMXFF(C),U,4)=BMXTMP
"RTN","BMXSQL7",196,0)
;
"RTN","BMXSQL7",197,0)
Q
"RTN","BMXSQL7",198,0)
;
"RTN","BMXSQL7",199,0)
OTM ;One-To-Many
"RTN","BMXSQL7",200,0)
N BMXUPFN,BMXSUBFN,BMXA,BMXB,BMXSUBFLD,BMXFNAM
"RTN","BMXSQL7",201,0)
I BMXTMP["INTERNAL[" S BMXTMP=$P(BMXTMP,"INTERNAL[",2),BMXTMP=$P(BMXTMP,"]")
"RTN","BMXSQL7",202,0)
S BMXUPFN=BMXFO(1)
"RTN","BMXSQL7",203,0)
S BMXA=$TR($P(BMXTMP,"."),"_"," ")
"RTN","BMXSQL7",204,0)
S BMXB=$TR($P(BMXTMP,".",2),"_"," ")
"RTN","BMXSQL7",205,0)
S BMXFNAM=BMXB ;Required by SETMFL. Won't work if filename BMXB [ "."
"RTN","BMXSQL7",206,0)
;Get the subfile
"RTN","BMXSQL7",207,0)
I '$D(BMXF(BMXA)) S BMXERR="Related File Not Found" Q
"RTN","BMXSQL7",208,0)
S BMXSUBFN=BMXF(BMXA)
"RTN","BMXSQL7",209,0)
I '$D(^DD(BMXSUBFN,0)) S BMXERR="Related file not found" Q
"RTN","BMXSQL7",210,0)
;Get the field that points to the main file
"RTN","BMXSQL7",211,0)
I '$D(^DD(BMXSUBFN,"B",BMXB)) S BMXERR="Related field not found" Q
"RTN","BMXSQL7",212,0)
S BMXSUBFLD=$O(^DD(BMXSUBFN,"B",BMXB,0))
"RTN","BMXSQL7",213,0)
I '+BMXSUBFLD S BMXERR="Related field not found" Q
"RTN","BMXSQL7",214,0)
;
"RTN","BMXSQL7",215,0)
;Find a normal index on that field
"RTN","BMXSQL7",216,0)
;Set up for call to CHKCR^BMXSQL7
"RTN","BMXSQL7",217,0)
N BMXEXEC
"RTN","BMXSQL7",218,0)
I '$$CHKCR^BMXSQL7(BMXSUBFN,BMXSUBFLD,.BMXEXEC) S BMXERR="Related File not indexed" Q
"RTN","BMXSQL7",219,0)
;
"RTN","BMXSQL7",220,0)
;
"RTN","BMXSQL7",221,0)
S BMXFF(C,"JOIN")="One-to-many Join"
"RTN","BMXSQL7",222,0)
;
"RTN","BMXSQL7",223,0)
;Call SETMFL^BMXSQL5 to set up the iteration code
"RTN","BMXSQL7",224,0)
D SETMFL^BMXSQL5(BMXUPFN,BMXSUBFN,BMXEXEC,1,1)
"RTN","BMXSQL7",225,0)
;
"RTN","BMXSQL7",226,0)
;
"RTN","BMXSQL7",227,0)
;Upfile is the mainfile, Subfile is the related file
"RTN","BMXSQL7",228,0)
;BMXOFF is 1 but What is BMXGL?
"RTN","BMXSQL7",229,0)
;
"RTN","BMXSQL7",230,0)
Q
"RTN","BMXSQL7",231,0)
;
"RTN","BMXSQL7",232,0)
ERROR Q
"RTN","BMXSQL91")
0^105^B25109398
"RTN","BMXSQL91",1,0)
BMXSQL91 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
"RTN","BMXSQL91",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXSQL91",3,0)
;
"RTN","BMXSQL91",4,0)
;Below is dead code, but keep for later
"RTN","BMXSQL91",5,0)
SETX2 ;Don't need this unless porting to machine with
"RTN","BMXSQL91",6,0)
;local variable size limitations
"RTN","BMXSQL91",7,0)
N F,LVL,ROOT,START
"RTN","BMXSQL91",8,0)
S LVL=1,START=1
"RTN","BMXSQL91",9,0)
S ROOT="BMXY"
"RTN","BMXSQL91",10,0)
F F=1:1:BMXFF D Q:$D(BMXERR)
"RTN","BMXSQL91",11,0)
. S BMX=BMXFF(F)
"RTN","BMXSQL91",12,0)
. I BMX="(" D Q ;Increment level
"RTN","BMXSQL91",13,0)
. . S LVL=LVL+1
"RTN","BMXSQL91",14,0)
. . ;S ROOT=$S(ROOT["(":$P(ROOT,")")_","_0_")",1:ROOT_"("_0_")")
"RTN","BMXSQL91",15,0)
. . ;Get operator following close paren corresponding to this open
"RTN","BMXSQL91",16,0)
. . ;If op = OR then set up FOR loop in zeroeth node
"RTN","BMXSQL91",17,0)
. . ;if op = AND then set up
"RTN","BMXSQL91",18,0)
. I BMX=")" D Q ;Decrement level
"RTN","BMXSQL91",19,0)
. . S LVL=LVL-1
"RTN","BMXSQL91",20,0)
. . I LVL=1,$D(BMXFF(F+1)),BMXFF(F+1)="&" D Q
"RTN","BMXSQL91",21,0)
. . . S BMXX=BMXX+1
"RTN","BMXSQL91",22,0)
. . . S BMXX(BMXX)=""
"RTN","BMXSQL91",23,0)
. . . F J=START:1:F S BMXX(BMXX)=BMXX(BMXX)_BMXFF(J)
"RTN","BMXSQL91",24,0)
. . . S START=F+2
"RTN","BMXSQL91",25,0)
. . . ;S BMXX(BMXX)="I "_BMXX(BMXX)_" X BMXX("_BMXX+1_")"
"RTN","BMXSQL91",26,0)
. I BMX="AND" D Q ;Chain to previous expression at current level
"RTN","BMXSQL91",27,0)
. I BMX="OR" D Q ;Create FOR-loop to execute screens
"RTN","BMXSQL91",28,0)
;
"RTN","BMXSQL91",29,0)
Q
"RTN","BMXSQL91",30,0)
;
"RTN","BMXSQL91",31,0)
;
"RTN","BMXSQL91",32,0)
;S F=0 F S F=$O(BMXMFL(F)) Q:'+F S:'$D(BMXMFL(F,"SUBFILE")) BMXMFL("NOSUBFILE",F)=""
"RTN","BMXSQL91",33,0)
;I $D(BMXMFL("NOSUBFILE")) S F=0 F S F=$O(BMXMFL("NOSUBFILE",F)) Q:'+F D MAKEC1
"RTN","BMXSQL91",34,0)
;I $D(BMXMFL("SUBFILE")) S F=0 F S F=$O(BMXMFL("SUBFILE",F)) Q:'+F D MAKEC1 ;S BMXROOTZ=BMXZ+100
"RTN","BMXSQL91",35,0)
;
"RTN","BMXSQL91",36,0)
Q
"RTN","BMXSQL91",37,0)
MAKEC1 ;
"RTN","BMXSQL91",38,0)
I '$D(BMXMFL(F,"SUBFILE")),'$D(BMXMFL(F,"MULT")) S BMXZ=BMXZ+100,BMXCFN(BMXCID,BMXZ,F)="" Q
"RTN","BMXSQL91",39,0)
Q:'$D(BMXMFL(F,"SUBFILE"))
"RTN","BMXSQL91",40,0)
Q:$D(BMXMFL(F,"MULT"))
"RTN","BMXSQL91",41,0)
S BMXROOT=F
"RTN","BMXSQL91",42,0)
S BMXROOTZ=BMXZ+100
"RTN","BMXSQL91",43,0)
S BMXROOTC=BMXCID
"RTN","BMXSQL91",44,0)
D MCNT(F)
"RTN","BMXSQL91",45,0)
Q
"RTN","BMXSQL91",46,0)
;
"RTN","BMXSQL91",47,0)
MCNT(F) ;
"RTN","BMXSQL91",48,0)
N S
"RTN","BMXSQL91",49,0)
;B ;MCNT
"RTN","BMXSQL91",50,0)
I '$D(BMXMFL(F,"SUBFILE")) D MCNT2 Q
"RTN","BMXSQL91",51,0)
S S=0 F S S=$O(BMXMFL(F,"SUBFILE",S)) Q:'+S S:'$D(BMXCFN(BMXCID,BMXZ,F)) BMXZ=BMXZ+100,BMXCFN(BMXCID,BMXZ,F)="" S BMXZ=BMXZ+100,BMXCFN(BMXCID,BMXZ,S)="",BMXCFNX(S,F)="" D MCNT(S)
"RTN","BMXSQL91",52,0)
Q
"RTN","BMXSQL91",53,0)
;
"RTN","BMXSQL91",54,0)
MCNT2 ;
"RTN","BMXSQL91",55,0)
;B ;Back-chain
"RTN","BMXSQL91",56,0)
;TODO: RESTART HERE -- $O(BMXCFN(BMXCID,0)) NEEDS TO BE CHANGED TO SOMETHING BESIDES 0
"RTN","BMXSQL91",57,0)
N BMXFTOP,BMXFBACK
"RTN","BMXSQL91",58,0)
F S BMXFTOP=$O(BMXCFN(BMXROOTC,BMXROOTZ,0)) Q:BMXFTOP=BMXROOT S BMXFBACK=$O(BMXCFNX(BMXFTOP,0)) S BMXROOTZ=BMXROOTZ-1,BMXCFN(BMXCID,BMXROOTZ,BMXFBACK)=""
"RTN","BMXSQL91",59,0)
S BMXCID=BMXCID+1,BMXROOTC=BMXCID
"RTN","BMXSQL91",60,0)
;Get the root files
"RTN","BMXSQL91",61,0)
I $D(BMXMFL("NOSUBFILE")) D
"RTN","BMXSQL91",62,0)
. N F
"RTN","BMXSQL91",63,0)
. S F=0 F S F=$O(BMXMFL("NOSUBFILE",F)) Q:'+F D
"RTN","BMXSQL91",64,0)
. . Q:$D(BMXMFL(F,"MULT"))
"RTN","BMXSQL91",65,0)
. . Q:F=BMXROOT
"RTN","BMXSQL91",66,0)
. . S BMXZ=BMXZ+100
"RTN","BMXSQL91",67,0)
. . S BMXCFN(BMXCID,BMXZ,F)=""
"RTN","BMXSQL91",68,0)
S BMXROOTZ=BMXZ+100
"RTN","BMXSQL91",69,0)
Q
"RTN","BMXSQL91",70,0)
;
"RTN","BMXSQL91",71,0)
;
"RTN","BMXSQL91",72,0)
ITER ;Iterate through result array A
"RTN","BMXSQL91",73,0)
S BMXCNT=BMXFLDO ;Field count
"RTN","BMXSQL91",74,0)
S F=0
"RTN","BMXSQL91",75,0)
S:BMXNUM ^BMXTEMP($J,I)=IEN0_"^"
"RTN","BMXSQL91",76,0)
S BMXCNTB=0
"RTN","BMXSQL91",77,0)
S BMXORD=BMXNUM
"RTN","BMXSQL91",78,0)
N BMXONOD
"RTN","BMXSQL91",79,0)
N BMXINT
"RTN","BMXSQL91",80,0)
;B ;WRITE Before REORG
"RTN","BMXSQL91",81,0)
N M,N S N=0
"RTN","BMXSQL91",82,0)
D REORG
"RTN","BMXSQL91",83,0)
;B ;WRITE After REORG
"RTN","BMXSQL91",84,0)
F S N=$O(M(N)) Q:'+N D
"RTN","BMXSQL91",85,0)
. S O=0
"RTN","BMXSQL91",86,0)
. F O=1:1:$L(M(N),U) S BMXFLDO(O-1,"IEN0")=$P(M(N),U,O)
"RTN","BMXSQL91",87,0)
. S BMXORD=BMXNUM
"RTN","BMXSQL91",88,0)
. D OA
"RTN","BMXSQL91",89,0)
Q
"RTN","BMXSQL91",90,0)
;
"RTN","BMXSQL91",91,0)
REORG N R,IEN,J,CONT,TEST
"RTN","BMXSQL91",92,0)
F R=0:1:BMXFLDO-1 S IEN(R)=0
"RTN","BMXSQL91",93,0)
F J=1:1 D Q:'CONT
"RTN","BMXSQL91",94,0)
. S CONT=0
"RTN","BMXSQL91",95,0)
. F R=1:1:BMXFLDO D
"RTN","BMXSQL91",96,0)
. . S TEST=$O(A(+BMXFLDO(R-1),IEN(R-1)))
"RTN","BMXSQL91",97,0)
. . I +TEST S IEN(R-1)=TEST,CONT=1
"RTN","BMXSQL91",98,0)
. . S $P(M(J),U,R)=IEN(R-1)
"RTN","BMXSQL91",99,0)
. Q
"RTN","BMXSQL91",100,0)
I M(J)=M(J-1) K M(J)
"RTN","BMXSQL91",101,0)
Q
"RTN","BMXSQL91",102,0)
;
"RTN","BMXSQL91",103,0)
;
"RTN","BMXSQL91",104,0)
OA ;
"RTN","BMXSQL91",105,0)
I $D(A) F R=0:1:(BMXFLDO-1) S F=$P(BMXFLDO(R),U,2),BMXFN=$P(BMXFLDO(R),U),BMXINT=$P(BMXFLDO(R),U,3) D S:(R+1)<BMXFLDO ^BMXTEMP($J,I)=^BMXTEMP($J,I)_U
"RTN","BMXSQL91",106,0)
. ;S IEN0=BMXFLDO(R,"IEN0") F S IEN0=$O(A(BMXFN,IEN0)) Q:'+IEN0 Q:$D(A(BMXFN,IEN0,F,BMXINT))
"RTN","BMXSQL91",107,0)
. S IEN0=BMXFLDO(R,"IEN0")
"RTN","BMXSQL91",108,0)
. Q:'+IEN0
"RTN","BMXSQL91",109,0)
. S BMXORD=BMXORD+1
"RTN","BMXSQL91",110,0)
. I $D(^DD(BMXFN,F,0)),$P(^DD(BMXFN,F,0),U,2) D I 1 ;Multiple or WP
"RTN","BMXSQL91",111,0)
. . ;Get the subfile number into FL1
"RTN","BMXSQL91",112,0)
. . S FL1=+$P(^DD(BMXFN,F,0),U,2)
"RTN","BMXSQL91",113,0)
. . S FLD1=$O(^DD(FL1,0))
"RTN","BMXSQL91",114,0)
. . I $P(^DD(FL1,FLD1,0),U,2)["W" D ;WP
"RTN","BMXSQL91",115,0)
. . . S WPL=0,BMXLTMP=0
"RTN","BMXSQL91",116,0)
. . . F S WPL=$O(A(BMXFN,IEN0,F,WPL)) Q:'WPL S I=I+1 D
"RTN","BMXSQL91",117,0)
. . . . S ^BMXTEMP($J,I)=A(BMXFN,IEN0,F,WPL)_" "
"RTN","BMXSQL91",118,0)
. . . . S BMXLTMP=BMXLTMP+$L(A(BMXFN,IEN0,F,WPL))+1
"RTN","BMXSQL91",119,0)
. . . . Q
"RTN","BMXSQL91",120,0)
. . . S:BMXLTMP>BMXLEN(BMXORD) BMXLEN(BMXORD)=BMXLTMP
"RTN","BMXSQL91",121,0)
. . . Q
"RTN","BMXSQL91",122,0)
. . D ;It's a multiple. Implement in next phase
"RTN","BMXSQL91",123,0)
. . . ;S BMXMCT=BMXMCT+1
"RTN","BMXSQL91",124,0)
. . . ;S BMXMCT(BMXMCT)=BMXFN_U_F
"RTN","BMXSQL91",125,0)
. . . Q ;Process A( for multiple field
"RTN","BMXSQL91",126,0)
. . Q
"RTN","BMXSQL91",127,0)
. E D ;Not a multiple
"RTN","BMXSQL91",128,0)
. . S I=I+1
"RTN","BMXSQL91",129,0)
. . I $G(BMXTK("DISTINCT"))="TRUE" D Q
"RTN","BMXSQL91",130,0)
. . . Q:A(BMXFN,IEN0,F,BMXINT)=""
"RTN","BMXSQL91",131,0)
. . . I $D(^BMXTMPD($J,A(BMXFN,IEN0,F,BMXINT))) Q
"RTN","BMXSQL91",132,0)
. . . S ^BMXTMPD($J,A(BMXFN,IEN0,F,BMXINT))=""
"RTN","BMXSQL91",133,0)
. . . S ^BMXTEMP($J,I)=A(BMXFN,IEN0,F,BMXINT)
"RTN","BMXSQL91",134,0)
. . . S:$L(A(BMXFN,IEN0,F,BMXINT))>BMXLEN(BMXORD) BMXLEN(BMXORD)=$L(A(BMXFN,IEN0,F,BMXINT))
"RTN","BMXSQL91",135,0)
. . . Q
"RTN","BMXSQL91",136,0)
. . S ^BMXTEMP($J,I)=A(BMXFN,IEN0,F,BMXINT)
"RTN","BMXSQL91",137,0)
. . S:$L(A(BMXFN,IEN0,F,BMXINT))>BMXLEN(BMXORD) BMXLEN(BMXORD)=$L(A(BMXFN,IEN0,F,BMXINT))
"RTN","BMXSQL91",138,0)
. Q
"RTN","BMXSQL91",139,0)
;---> Set data in result global.
"RTN","BMXSQL91",140,0)
I $D(^BMXTEMP($J,I)) S ^BMXTEMP($J,I)=^BMXTEMP($J,I)_$C(30)
"RTN","BMXSQL91",141,0)
ZZZ Q
"RTN","BMXTABLE")
0^106^B130270
"RTN","BMXTABLE",1,0)
BMXTABLE ; IHS/OIT/HMW - BMX RETURN ENTIRE TABLE ;
"RTN","BMXTABLE",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXTABLE",3,0)
;
"RTN","BMXTABLE",4,0)
TABLE(BMXGBL,BMXFL,BMXMX) ;EP
"RTN","BMXTABLE",5,0)
;
"RTN","BMXTABLE",6,0)
D FIND^BMXFIND(.BMXGBL,BMXFL,"*",,,BMXMX,,,,1)
"RTN","BMXTABLE",7,0)
Q
"RTN","BMXTRS")
0^107^B1202427
"RTN","BMXTRS",1,0)
BMXTRS ; IHS/OIT/HMW - UPPERCASE-LOWERCASE ;
"RTN","BMXTRS",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXTRS",3,0)
;
"RTN","BMXTRS",4,0)
T(X) ;EP
"RTN","BMXTRS",5,0)
;---> Translate word to mixed case.
"RTN","BMXTRS",6,0)
;
"RTN","BMXTRS",7,0)
N BMXWORD,I
"RTN","BMXTRS",8,0)
I '$D(X) Q ""
"RTN","BMXTRS",9,0)
I X="^" Q X
"RTN","BMXTRS",10,0)
I X=" " Q X
"RTN","BMXTRS",11,0)
;-----> REMOVE LEADING INAPPROPRIATE CHARACTERS IF PRESENT.
"RTN","BMXTRS",12,0)
F Q:$E(X)'?1P S X=$E(X,2,99)
"RTN","BMXTRS",13,0)
;-----> CHANGE FIRST LETTER TO UPPERCASE:
"RTN","BMXTRS",14,0)
S BMXWORD=$E(X)
"RTN","BMXTRS",15,0)
I $E(BMXWORD)?1L S BMXWORD=$C($A($E(BMXWORD))-32)
"RTN","BMXTRS",16,0)
;-----> DO NEXT CHARACTER
"RTN","BMXTRS",17,0)
F I=2:1:$L(X) D CHAR
"RTN","BMXTRS",18,0)
;-----> REMOVE TRAILING SPACE OR QUOTE.
"RTN","BMXTRS",19,0)
F Q:""" "'[$E(BMXWORD,$L(BMXWORD)) D
"RTN","BMXTRS",20,0)
.S BMXWORD=$E(BMXWORD,1,($L(BMXWORD)-1))
"RTN","BMXTRS",21,0)
;-----> RESET X EQUAL TO RESULT
"RTN","BMXTRS",22,0)
EOJ ;
"RTN","BMXTRS",23,0)
Q BMXWORD
"RTN","BMXTRS",24,0)
;
"RTN","BMXTRS",25,0)
CHAR ;
"RTN","BMXTRS",26,0)
;-----> IF THE CHARACTER IS UPPERCASE AND PREVIOUS CHARACTER IS NOT
"RTN","BMXTRS",27,0)
;-----> PUNCTUATION (EXCEPT FOR AN APOSTROPHY) OR A SPACE,
"RTN","BMXTRS",28,0)
;-----> THEN CHANGE CHARACTER TO LOWERCASE:
"RTN","BMXTRS",29,0)
I ($E(X,I)?1U)&(($E(X,I-1)'?1P)!($E(X,I-1)="'")) D Q
"RTN","BMXTRS",30,0)
.S BMXWORD=BMXWORD_$C($A($E(X,I))+32)
"RTN","BMXTRS",31,0)
;
"RTN","BMXTRS",32,0)
;-----> IF THE CHARACTER IS LOWERCASE AND PREVIOUS CHARACTER IS
"RTN","BMXTRS",33,0)
;-----> PUNCTUATION (BUT NOT AN APOSTROPHY) OR A SPACE, THEN CHANGE
"RTN","BMXTRS",34,0)
;-----> CHARACTER TO UPPERCASE:
"RTN","BMXTRS",35,0)
I $E(X,I)?1L,$E(X,I-1)?1P,$E(X,I-1)'="'" D Q
"RTN","BMXTRS",36,0)
.S BMXWORD=BMXWORD_$C($A($E(X,I))-32)
"RTN","BMXTRS",37,0)
;
"RTN","BMXTRS",38,0)
;-----> ADD CHARACTER TO BMXWORD STRING WITHOUT MODIFICATION.
"RTN","BMXTRS",39,0)
;-----> "\" PLACED BEFORE A LETTER FORCES IT TO BE UPPERCASE;
"RTN","BMXTRS",40,0)
;-----> HERE REMOVE ANY "\"'s.
"RTN","BMXTRS",41,0)
I $E(X,I)'="\" S BMXWORD=BMXWORD_$E(X,I)
"RTN","BMXTRS",42,0)
Q
"RTN","BMXUTL1")
0^108^B39816098
"RTN","BMXUTL1",1,0)
BMXUTL1 ; IHS/OIT/HMW - UTIL: PATIENT DEMOGRAPHICS ;
"RTN","BMXUTL1",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXUTL1",3,0)
;;Stolen from:* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
"RTN","BMXUTL1",4,0)
;; UTILITY: PATIENT DEMOGRAPHICS.
"RTN","BMXUTL1",5,0)
;
"RTN","BMXUTL1",6,0)
;
"RTN","BMXUTL1",7,0)
;----------
"RTN","BMXUTL1",8,0)
NAME(DFN,ORDER) ;EP
"RTN","BMXUTL1",9,0)
;---> Return text of Patient Name.
"RTN","BMXUTL1",10,0)
;---> Parameters:
"RTN","BMXUTL1",11,0)
; 1 - DFN (req) Patient's IEN (DFN).
"RTN","BMXUTL1",12,0)
; 2 - ORDER (opt) ""/0=Last,First 2=First Only
"RTN","BMXUTL1",13,0)
; 1=First Last 3=Last Only
"RTN","BMXUTL1",14,0)
;
"RTN","BMXUTL1",15,0)
Q:'$G(DFN) "NO PATIENT"
"RTN","BMXUTL1",16,0)
Q:'$D(^DPT(DFN,0)) "Unknown"
"RTN","BMXUTL1",17,0)
N X S X=$P(^DPT(DFN,0),U)
"RTN","BMXUTL1",18,0)
Q:'$G(ORDER) X
"RTN","BMXUTL1",19,0)
S X=$$FL(X)
"RTN","BMXUTL1",20,0)
Q:ORDER=1 X
"RTN","BMXUTL1",21,0)
Q:ORDER=2 $P(X," ")
"RTN","BMXUTL1",22,0)
Q:ORDER=3 $P(X," ",2)
"RTN","BMXUTL1",23,0)
Q "UNKNOWN ORDER"
"RTN","BMXUTL1",24,0)
;
"RTN","BMXUTL1",25,0)
;
"RTN","BMXUTL1",26,0)
;----------
"RTN","BMXUTL1",27,0)
FL(X) ;EP
"RTN","BMXUTL1",28,0)
;---> Switch First and Last Names.
"RTN","BMXUTL1",29,0)
Q $P($P(X,",",2)," ")_" "_$P(X,",")
"RTN","BMXUTL1",30,0)
;
"RTN","BMXUTL1",31,0)
;
"RTN","BMXUTL1",32,0)
;----------
"RTN","BMXUTL1",33,0)
DOB(DFN) ;EP
"RTN","BMXUTL1",34,0)
;---> Return Patient's Date of Birth in Fileman format.
"RTN","BMXUTL1",35,0)
;---> Parameters:
"RTN","BMXUTL1",36,0)
; 1 - DFN (req) Patient's IEN (DFN).
"RTN","BMXUTL1",37,0)
;
"RTN","BMXUTL1",38,0)
Q:'$G(DFN) "NO PATIENT"
"RTN","BMXUTL1",39,0)
Q:'$P($G(^DPT(DFN,0)),U,3) "NOT ENTERED"
"RTN","BMXUTL1",40,0)
Q $P(^DPT(DFN,0),U,3)
"RTN","BMXUTL1",41,0)
;
"RTN","BMXUTL1",42,0)
;
"RTN","BMXUTL1",43,0)
;----------
"RTN","BMXUTL1",44,0)
DOBF(DFN,BMXDT,BMXNOA) ;EP
"RTN","BMXUTL1",45,0)
;---> Date of Birth formatted "09-Sep-1994 (35 Months)"
"RTN","BMXUTL1",46,0)
;---> Parameters:
"RTN","BMXUTL1",47,0)
; 1 - DFN (req) Patient's IEN (DFN).
"RTN","BMXUTL1",48,0)
; 2 - BMXDT (opt) Date on which Age should be calculated.
"RTN","BMXUTL1",49,0)
; 3 - BMXNOA (opt) 1=No age (don't append age).
"RTN","BMXUTL1",50,0)
;
"RTN","BMXUTL1",51,0)
N X,Y
"RTN","BMXUTL1",52,0)
S X=$$DOB($G(DFN))
"RTN","BMXUTL1",53,0)
Q:'X X
"RTN","BMXUTL1",54,0)
S X=$$TXDT1^BMXUTL5(X)
"RTN","BMXUTL1",55,0)
Q:$G(BMXNOA) X
"RTN","BMXUTL1",56,0)
S Y=$$AGEF(DFN,$G(BMXDT))
"RTN","BMXUTL1",57,0)
S:Y["DECEASED" Y="DECEASED"
"RTN","BMXUTL1",58,0)
S X=X_" ("_Y_")"
"RTN","BMXUTL1",59,0)
Q X
"RTN","BMXUTL1",60,0)
;
"RTN","BMXUTL1",61,0)
;
"RTN","BMXUTL1",62,0)
;----------
"RTN","BMXUTL1",63,0)
AGE(DFN,BMXZ,BMXDT) ;EP
"RTN","BMXUTL1",64,0)
;---> Return Patient's Age.
"RTN","BMXUTL1",65,0)
;---> Parameters:
"RTN","BMXUTL1",66,0)
; 1 - DFN (req) IEN in PATIENT File.
"RTN","BMXUTL1",67,0)
; 2 - BMXZ (opt) BMXZ=1,2,3 1=years, 2=months, 3=days.
"RTN","BMXUTL1",68,0)
; 2 will be assumed if not passed.
"RTN","BMXUTL1",69,0)
; 3 - BMXDT (opt) Date on which Age should be calculated.
"RTN","BMXUTL1",70,0)
;
"RTN","BMXUTL1",71,0)
N BMXDOB,X,X1,X2 S:$G(BMXZ)="" BMXZ=2
"RTN","BMXUTL1",72,0)
Q:'$G(DFN) "NO PATIENT"
"RTN","BMXUTL1",73,0)
S BMXDOB=$$DOB(DFN)
"RTN","BMXUTL1",74,0)
Q:'BMXDOB "Unknown"
"RTN","BMXUTL1",75,0)
I '$G(BMXDT)&($$DECEASED(DFN)) D Q X
"RTN","BMXUTL1",76,0)
.S X="DECEASED: "_$$TXDT1^BMXUTL5(+^DPT(DFN,.35))
"RTN","BMXUTL1",77,0)
S:'$G(DT) DT=$$DT^XLFDT
"RTN","BMXUTL1",78,0)
S:'$G(BMXDT) BMXDT=DT
"RTN","BMXUTL1",79,0)
Q:BMXDT<BMXDOB "NOT BORN"
"RTN","BMXUTL1",80,0)
;
"RTN","BMXUTL1",81,0)
;---> Age in Years.
"RTN","BMXUTL1",82,0)
N BMXAGEY,BMXAGEM,BMXD1,BMXD2,BMXM1,BMXM2,BMXY1,BMXY2
"RTN","BMXUTL1",83,0)
S BMXM1=$E(BMXDOB,4,7),BMXM2=$E(BMXDT,4,7)
"RTN","BMXUTL1",84,0)
S BMXY1=$E(BMXDOB,1,3),BMXY2=$E(BMXDT,1,3)
"RTN","BMXUTL1",85,0)
S BMXAGEY=BMXY2-BMXY1 S:BMXM2<BMXM1 BMXAGEY=BMXAGEY-1
"RTN","BMXUTL1",86,0)
S:BMXAGEY<1 BMXAGEY="<1"
"RTN","BMXUTL1",87,0)
Q:BMXZ=1 BMXAGEY
"RTN","BMXUTL1",88,0)
;
"RTN","BMXUTL1",89,0)
;---> Age in Months.
"RTN","BMXUTL1",90,0)
S BMXD1=$E(BMXM1,3,4),BMXM1=$E(BMXM1,1,2)
"RTN","BMXUTL1",91,0)
S BMXD2=$E(BMXM2,3,4),BMXM2=$E(BMXM2,1,2)
"RTN","BMXUTL1",92,0)
S BMXAGEM=12*BMXAGEY
"RTN","BMXUTL1",93,0)
I BMXM2=BMXM1&(BMXD2<BMXD1) S BMXAGEM=BMXAGEM+12
"RTN","BMXUTL1",94,0)
I BMXM2>BMXM1 S BMXAGEM=BMXAGEM+BMXM2-BMXM1
"RTN","BMXUTL1",95,0)
I BMXM2<BMXM1 S BMXAGEM=BMXAGEM+BMXM2+(12-BMXM1)
"RTN","BMXUTL1",96,0)
S:BMXD2<BMXD1 BMXAGEM=BMXAGEM-1
"RTN","BMXUTL1",97,0)
Q:BMXZ=2 BMXAGEM
"RTN","BMXUTL1",98,0)
;
"RTN","BMXUTL1",99,0)
;---> Age in Days.
"RTN","BMXUTL1",100,0)
S X1=BMXDT,X2=BMXDOB
"RTN","BMXUTL1",101,0)
D ^%DTC
"RTN","BMXUTL1",102,0)
Q X
"RTN","BMXUTL1",103,0)
;
"RTN","BMXUTL1",104,0)
;
"RTN","BMXUTL1",105,0)
;----------
"RTN","BMXUTL1",106,0)
AGEF(DFN,BMXDT) ;EP
"RTN","BMXUTL1",107,0)
;---> Age formatted "35 Months" or "23 Years"
"RTN","BMXUTL1",108,0)
;---> Parameters:
"RTN","BMXUTL1",109,0)
; 1 - DFN (req) Patient's IEN (DFN).
"RTN","BMXUTL1",110,0)
; 2 - BMXDT (opt) Date on which Age should be calculated.
"RTN","BMXUTL1",111,0)
;
"RTN","BMXUTL1",112,0)
N Y
"RTN","BMXUTL1",113,0)
S Y=$$AGE(DFN,2,$G(BMXDT))
"RTN","BMXUTL1",114,0)
Q:Y["DECEASED" Y
"RTN","BMXUTL1",115,0)
Q:Y["NOT BORN" Y
"RTN","BMXUTL1",116,0)
;
"RTN","BMXUTL1",117,0)
;---> If over 60 months, return years.
"RTN","BMXUTL1",118,0)
Q:Y>60 $$AGE(DFN,1,$G(BMXDT))_" years"
"RTN","BMXUTL1",119,0)
;
"RTN","BMXUTL1",120,0)
;---> If under 1 month return days.
"RTN","BMXUTL1",121,0)
I Y<1 S Y=$$AGE(DFN,3,$G(BMXDT)) Q Y_$S(Y=1:" day",1:" days")
"RTN","BMXUTL1",122,0)
;
"RTN","BMXUTL1",123,0)
;---> Return months
"RTN","BMXUTL1",124,0)
Q Y_$S(Y=1:" month",1:" months")
"RTN","BMXUTL1",125,0)
;
"RTN","BMXUTL1",126,0)
;
"RTN","BMXUTL1",127,0)
;----------
"RTN","BMXUTL1",128,0)
DECEASED(DFN,BMXDT) ;EP
"RTN","BMXUTL1",129,0)
;---> Return 1 if patient is deceased, 0 if not deceased.
"RTN","BMXUTL1",130,0)
;---> Parameters:
"RTN","BMXUTL1",131,0)
; 1 - DFN (req) Patient's IEN (DFN).
"RTN","BMXUTL1",132,0)
; 2 - BMXDT (opt) If BMXDT=1 return Date of Death (Fileman format).
"RTN","BMXUTL1",133,0)
;
"RTN","BMXUTL1",134,0)
Q:'$G(DFN) 0
"RTN","BMXUTL1",135,0)
N X S X=+$G(^DPT(DFN,.35))
"RTN","BMXUTL1",136,0)
Q:'X 0
"RTN","BMXUTL1",137,0)
Q:'$G(BMXDT) 1
"RTN","BMXUTL1",138,0)
Q X
"RTN","BMXUTL1",139,0)
;
"RTN","BMXUTL1",140,0)
;
"RTN","BMXUTL1",141,0)
;----------
"RTN","BMXUTL1",142,0)
SEX(DFN,PRON) ;EP
"RTN","BMXUTL1",143,0)
;---> Return "F" is patient is female, "M" if male.
"RTN","BMXUTL1",144,0)
;---> Parameters:
"RTN","BMXUTL1",145,0)
; 1 - DFN (req) Patient's IEN (DFN).
"RTN","BMXUTL1",146,0)
; 2 - PRON (opt) Pronoun: 1=he/she, 2=him/her,3=his,her
"RTN","BMXUTL1",147,0)
;
"RTN","BMXUTL1",148,0)
Q:'$G(DFN) ""
"RTN","BMXUTL1",149,0)
Q:'$D(^DPT(DFN,0)) ""
"RTN","BMXUTL1",150,0)
N X S X=$P(^DPT(DFN,0),U,2)
"RTN","BMXUTL1",151,0)
Q:'$G(PRON) X
"RTN","BMXUTL1",152,0)
I PRON=1 Q $S(X="F":"she",1:"he")
"RTN","BMXUTL1",153,0)
I PRON=2 Q $S(X="F":"her",1:"him")
"RTN","BMXUTL1",154,0)
I PRON=3 Q $S(X="F":"her",1:"his")
"RTN","BMXUTL1",155,0)
Q X
"RTN","BMXUTL1",156,0)
;
"RTN","BMXUTL1",157,0)
;
"RTN","BMXUTL1",158,0)
;----------
"RTN","BMXUTL1",159,0)
SEXW(DFN) ;EP
"RTN","BMXUTL1",160,0)
;---> Return Patient sex: "Female"/"Male".
"RTN","BMXUTL1",161,0)
;---> Parameters:
"RTN","BMXUTL1",162,0)
; 1 - DFN (req) Patient's IEN (DFN).
"RTN","BMXUTL1",163,0)
;
"RTN","BMXUTL1",164,0)
Q:$$SEX(DFN)="M" "Male"
"RTN","BMXUTL1",165,0)
Q:$$SEX(DFN)="F" "Female"
"RTN","BMXUTL1",166,0)
Q "Unknown"
"RTN","BMXUTL1",167,0)
;
"RTN","BMXUTL1",168,0)
;
"RTN","BMXUTL1",169,0)
;----------
"RTN","BMXUTL1",170,0)
NAMAGE(DFN) ;EP
"RTN","BMXUTL1",171,0)
;---> Return Patient Name concatenated with age.
"RTN","BMXUTL1",172,0)
;---> Parameters:
"RTN","BMXUTL1",173,0)
; 1 - DFN (req) Patient's IEN (DFN).
"RTN","BMXUTL1",174,0)
;
"RTN","BMXUTL1",175,0)
Q:'$G(DFN) "NO PATIENT"
"RTN","BMXUTL1",176,0)
Q $$NAME(DFN)_" ("_$$AGE(DFN)_"y/o)"
"RTN","BMXUTL1",177,0)
;
"RTN","BMXUTL1",178,0)
;
"RTN","BMXUTL1",179,0)
;----------
"RTN","BMXUTL1",180,0)
SSN(DFN) ;EP
"RTN","BMXUTL1",181,0)
;---> Return Social Security Number (SSN).
"RTN","BMXUTL1",182,0)
;---> Parameters:
"RTN","BMXUTL1",183,0)
; 1 - DFN (req) Patient's IEN (DFN).
"RTN","BMXUTL1",184,0)
N X
"RTN","BMXUTL1",185,0)
Q:'$G(DFN) "NO PATIENT"
"RTN","BMXUTL1",186,0)
Q:'$D(^DPT(DFN,0)) "Unknown"
"RTN","BMXUTL1",187,0)
S X=$P(^DPT(DFN,0),U,9)
"RTN","BMXUTL1",188,0)
Q:X']"" "Unknown"
"RTN","BMXUTL1",189,0)
Q X
"RTN","BMXUTL1",190,0)
;
"RTN","BMXUTL1",191,0)
;
"RTN","BMXUTL1",192,0)
;----------
"RTN","BMXUTL1",193,0)
HRCN(DFN,DUZ2,AGD) ;EP
"RTN","BMXUTL1",194,0)
;---> Return IHS Health Record Number.
"RTN","BMXUTL1",195,0)
;---> Parameters:
"RTN","BMXUTL1",196,0)
; 1 - DFN (req) Patient's IEN (DFN).
"RTN","BMXUTL1",197,0)
; 2 - DUZ2 (opt) User's Site/Location IEN. If no DUZ2
"RTN","BMXUTL1",198,0)
; provided, function will look for DUZ(2).
"RTN","BMXUTL1",199,0)
; 3 - AGD (opt) If AGD=1 return HRCN with no dashes.
"RTN","BMXUTL1",200,0)
;
"RTN","BMXUTL1",201,0)
;
"RTN","BMXUTL1",202,0)
S:'$G(DUZ2) DUZ2=$G(DUZ(2))
"RTN","BMXUTL1",203,0)
Q:'$G(DFN)!('$G(DUZ2)) "Unknown1"
"RTN","BMXUTL1",204,0)
Q:'$D(^AUPNPAT(DFN,41,DUZ2,0)) "Unknown2"
"RTN","BMXUTL1",205,0)
Q:'+$P(^AUPNPAT(DFN,41,DUZ2,0),"^",2) "Unknown3"
"RTN","BMXUTL1",206,0)
N Y S Y=$P(^AUPNPAT(DFN,41,DUZ2,0),"^",2)
"RTN","BMXUTL1",207,0)
Q:$G(AGD) Y
"RTN","BMXUTL1",208,0)
Q:'+Y Y
"RTN","BMXUTL1",209,0)
I $L(Y)=7 D Q Y
"RTN","BMXUTL1",210,0)
.S Y=$TR("123-45-67",1234567,Y)
"RTN","BMXUTL1",211,0)
S Y=$E("00000",0,6-$L(Y))_Y
"RTN","BMXUTL1",212,0)
S Y=$TR("12-34-56",123456,Y)
"RTN","BMXUTL1",213,0)
Q Y
"RTN","BMXUTL1",214,0)
;
"RTN","BMXUTL1",215,0)
;
"RTN","BMXUTL1",216,0)
;----------
"RTN","BMXUTL1",217,0)
PHONE(AGDFN,AGOFF) ;EP
"RTN","BMXUTL1",218,0)
;---> Return patient's home phone number.
"RTN","BMXUTL1",219,0)
;---> Parameters:
"RTN","BMXUTL1",220,0)
; 1 - AGDFN (req) Patient's IEN (DFN).
"RTN","BMXUTL1",221,0)
; 2 - AGOFF (opt) =1 will return Patient's Office Phone.
"RTN","BMXUTL1",222,0)
;
"RTN","BMXUTL1",223,0)
Q:'$G(AGDFN) "Error: No DFN"
"RTN","BMXUTL1",224,0)
Q $P($G(^DPT(AGDFN,.13)),U,$S($G(AGOFF):2,1:1))
"RTN","BMXUTL1",225,0)
;
"RTN","BMXUTL1",226,0)
;
"RTN","BMXUTL1",227,0)
;----------
"RTN","BMXUTL1",228,0)
STREET(DFN) ;EP
"RTN","BMXUTL1",229,0)
;---> Return patient's street address.
"RTN","BMXUTL1",230,0)
;---> Parameters:
"RTN","BMXUTL1",231,0)
; 1 - DFN (req) Patient's IEN (DFN).
"RTN","BMXUTL1",232,0)
;
"RTN","BMXUTL1",233,0)
Q:'$G(DFN) "No Patient"
"RTN","BMXUTL1",234,0)
Q:'$D(^DPT(DFN,.11)) ""
"RTN","BMXUTL1",235,0)
Q:$P(^DPT(DFN,.11),U)="" ""
"RTN","BMXUTL1",236,0)
Q $P(^DPT(DFN,.11),U)
"RTN","BMXUTL1",237,0)
;
"RTN","BMXUTL1",238,0)
;
"RTN","BMXUTL1",239,0)
;----------
"RTN","BMXUTL1",240,0)
CITY(DFN) ;EP
"RTN","BMXUTL1",241,0)
;---> Return patient's city.
"RTN","BMXUTL1",242,0)
;---> Parameters:
"RTN","BMXUTL1",243,0)
; 1 - DFN (req) Patient's IEN (DFN).
"RTN","BMXUTL1",244,0)
;
"RTN","BMXUTL1",245,0)
Q:'$G(DFN) "No Patient"
"RTN","BMXUTL1",246,0)
Q:'$D(^DPT(DFN,.11)) ""
"RTN","BMXUTL1",247,0)
Q:$P(^DPT(DFN,.11),U,4)="" ""
"RTN","BMXUTL1",248,0)
Q $P(^DPT(DFN,.11),U,4)
"RTN","BMXUTL1",249,0)
;
"RTN","BMXUTL1",250,0)
;
"RTN","BMXUTL1",251,0)
;----------
"RTN","BMXUTL1",252,0)
STATE(DFN,NOTEXT) ;EP
"RTN","BMXUTL1",253,0)
;---> Return patient's state.
"RTN","BMXUTL1",254,0)
;---> Parameters:
"RTN","BMXUTL1",255,0)
; 1 - DFN (req) Patient's IEN (DFN).
"RTN","BMXUTL1",256,0)
; 2 - NOTEXT (opt) If NOTEXT=1 return only the State IEN.
"RTN","BMXUTL1",257,0)
; If NOTEXT=2 return IEN|Text.
"RTN","BMXUTL1",258,0)
;
"RTN","BMXUTL1",259,0)
Q:'$G(DFN) ""
"RTN","BMXUTL1",260,0)
N Y S Y=$P($G(^DPT(DFN,.11)),U,5)
"RTN","BMXUTL1",261,0)
Q:$G(NOTEXT)=1 Y
"RTN","BMXUTL1",262,0)
Q:$G(NOTEXT)=2 Y_"|"_$$GET^BMXG(1,Y)
"RTN","BMXUTL1",263,0)
Q $$GET^BMXG(1,Y)
"RTN","BMXUTL1",264,0)
;
"RTN","BMXUTL1",265,0)
;
"RTN","BMXUTL1",266,0)
;----------
"RTN","BMXUTL1",267,0)
ZIP(DFN) ;EP
"RTN","BMXUTL1",268,0)
;---> Return patient's zipcode.
"RTN","BMXUTL1",269,0)
;---> Parameters:
"RTN","BMXUTL1",270,0)
; 1 - DFN (req) Patient's IEN (DFN).
"RTN","BMXUTL1",271,0)
;
"RTN","BMXUTL1",272,0)
Q:'$G(DFN) "No Patient"
"RTN","BMXUTL1",273,0)
Q:'$D(^DPT(DFN,.11)) ""
"RTN","BMXUTL1",274,0)
Q:$P(^DPT(DFN,.11),U,6)="" ""
"RTN","BMXUTL1",275,0)
Q $P(^DPT(DFN,.11),U,6)
"RTN","BMXUTL1",276,0)
;
"RTN","BMXUTL1",277,0)
;
"RTN","BMXUTL1",278,0)
;----------
"RTN","BMXUTL1",279,0)
CTYSTZ(DFN) ;EP
"RTN","BMXUTL1",280,0)
;---> Return patient's city, state zip.
"RTN","BMXUTL1",281,0)
;---> Parameters:
"RTN","BMXUTL1",282,0)
; 1 - DFN (req) Patient's IEN (DFN).
"RTN","BMXUTL1",283,0)
;
"RTN","BMXUTL1",284,0)
Q:'$G(DFN) "No Patient"
"RTN","BMXUTL1",285,0)
Q $$CITY(DFN)_", "_$$STATE(DFN)_" "_$$ZIP(DFN)
"RTN","BMXUTL1",286,0)
;
"RTN","BMXUTL1",287,0)
;
"RTN","BMXUTL1",288,0)
CURCOM(DFN,NOTEXT) ;EP
"RTN","BMXUTL1",289,0)
;---> Return patient's Current Community IEN or Text.
"RTN","BMXUTL1",290,0)
;---> (Item 6 on page 1 of Registration).
"RTN","BMXUTL1",291,0)
;---> Parameters:
"RTN","BMXUTL1",292,0)
; 1 - DFN (req) Patient's IEN (DFN).
"RTN","BMXUTL1",293,0)
; 2 - NOTEXT (opt) If NOTEXT=1 return only the Current Comm IEN.
"RTN","BMXUTL1",294,0)
; If NOTEXT=2 return IEN|Text.
"RTN","BMXUTL1",295,0)
;
"RTN","BMXUTL1",296,0)
Q:'$G(DFN) "No Patient"
"RTN","BMXUTL1",297,0)
Q:'$D(^AUPNPAT(DFN,11)) "" ;"Unknown1"
"RTN","BMXUTL1",298,0)
;
"RTN","BMXUTL1",299,0)
N X,Y,Z
"RTN","BMXUTL1",300,0)
S X=^AUPNPAT(DFN,11)
"RTN","BMXUTL1",301,0)
;---> Set Y=Pointer (IEN in ^AUTTCOM, piece 17), Z=Text (piece 18).
"RTN","BMXUTL1",302,0)
S Y=$P(X,U,17),Z=$P(X,U,18)
"RTN","BMXUTL1",303,0)
;---> If both Pointer and Text are null, return "Unknown2".
"RTN","BMXUTL1",304,0)
Q:('Y&(Z="")) "" ;"Unknown2"
"RTN","BMXUTL1",305,0)
;
"RTN","BMXUTL1",306,0)
;---> If Y is null or a bad pointer, set Y="".
"RTN","BMXUTL1",307,0)
I Y<1!('$D(^AUTTCOM(+Y,0))) S Y=""
"RTN","BMXUTL1",308,0)
;
"RTN","BMXUTL1",309,0)
;---> If no valid pointer and if Text (pc 18) exists in the
"RTN","BMXUTL1",310,0)
;---> Community file, then set Y=IEN in ^AUTTCOM(.
"RTN","BMXUTL1",311,0)
I Y<1,$D(^AUTTCOM("B",Z)) S Y=$O(^AUTTCOM("B",Z,0))
"RTN","BMXUTL1",312,0)
;
"RTN","BMXUTL1",313,0)
Q:'$D(^AUTTCOM(+Y,0)) "" ;"Unknown3"
"RTN","BMXUTL1",314,0)
Q:$G(NOTEXT)=1 Y
"RTN","BMXUTL1",315,0)
Q:$G(NOTEXT)=2 Y_"|"_$$GET^BMXG(2,Y)
"RTN","BMXUTL1",316,0)
Q $$GET^BMXG(2,Y)
"RTN","BMXUTL1",317,0)
;
"RTN","BMXUTL1",318,0)
;
"RTN","BMXUTL1",319,0)
;----------
"RTN","BMXUTL1",320,0)
PERSON(X,ORDER) ;EP
"RTN","BMXUTL1",321,0)
;---> Return person's name from File #200.
"RTN","BMXUTL1",322,0)
;---> Parameters:
"RTN","BMXUTL1",323,0)
; 1 - X (req) Person's IEN in New Person File #200.
"RTN","BMXUTL1",324,0)
; 2 - ORDER (opt) ""/0=Last,First 1=First Last
"RTN","BMXUTL1",325,0)
;
"RTN","BMXUTL1",326,0)
Q:'X "Unknown"
"RTN","BMXUTL1",327,0)
Q:'$D(^VA(200,X,0)) "Unknown"
"RTN","BMXUTL1",328,0)
N Y S Y=$P(^VA(200,X,0),U)
"RTN","BMXUTL1",329,0)
Q:'$G(ORDER) Y
"RTN","BMXUTL1",330,0)
Q $$FL(Y)
"RTN","BMXUTL2")
0^109^B1806952
"RTN","BMXUTL2",1,0)
BMXUTL2 ; IHS/OIT/HMW - UTIL: PATIENT INFO ;
"RTN","BMXUTL2",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXUTL2",3,0)
;;Stolen from:* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
"RTN","BMXUTL2",4,0)
;; UTILITY: PATIENT FUNCTIONS: CONTRAS, INPATIENT, HIDOSE.
"RTN","BMXUTL2",5,0)
;
"RTN","BMXUTL2",6,0)
NEXTAPPT(BMXDFN) ;EP
"RTN","BMXUTL2",7,0)
;---> Return patient's next appointment from Scheduling Package.
"RTN","BMXUTL2",8,0)
;---> Parameters:
"RTN","BMXUTL2",9,0)
; 1 - BMXDFN (req) Patient's IEN (BMXDFN).
"RTN","BMXUTL2",10,0)
;
"RTN","BMXUTL2",11,0)
Q:'$G(BMXDFN) ""
"RTN","BMXUTL2",12,0)
Q:'$D(^DPT(BMXDFN)) ""
"RTN","BMXUTL2",13,0)
;
"RTN","BMXUTL2",14,0)
N BMXAPPT,BMXDT,BMXYES
"RTN","BMXUTL2",15,0)
S BMXDT=DT+.2400,BMXYES=0
"RTN","BMXUTL2",16,0)
F S BMXDT=$O(^DPT(BMXDFN,"S",BMXDT)) Q:'BMXDT!(BMXYES) D
"RTN","BMXUTL2",17,0)
.N BMXDATA,BMXOI,X
"RTN","BMXUTL2",18,0)
.S BMXDATA=$G(^DPT(BMXDFN,"S",BMXDT,0))
"RTN","BMXUTL2",19,0)
.Q:BMXDATA=""
"RTN","BMXUTL2",20,0)
.;
"RTN","BMXUTL2",21,0)
.;---> Quit if appointment is cancelled.
"RTN","BMXUTL2",22,0)
.Q:$P(BMXDATA,U,2)["C"
"RTN","BMXUTL2",23,0)
.;
"RTN","BMXUTL2",24,0)
.S X=0 F S X=$O(^SC(+BMXDATA,"S",BMXDT,1,X)) Q:'X D
"RTN","BMXUTL2",25,0)
..Q:+$G(^SC(+BMXDATA,"S",BMXDT,1,X,0))'=BMXDFN
"RTN","BMXUTL2",26,0)
..S BMXYES=BMXDT_U_+BMXDATA
"RTN","BMXUTL2",27,0)
;
"RTN","BMXUTL2",28,0)
Q:'BMXYES ""
"RTN","BMXUTL2",29,0)
;
"RTN","BMXUTL2",30,0)
S BMXAPPT=$$FMTE^XLFDT(+BMXYES,"1P")_" with "
"RTN","BMXUTL2",31,0)
S BMXAPPT=BMXAPPT_$P($G(^SC($P(BMXYES,U,2),0)),U)
"RTN","BMXUTL2",32,0)
Q BMXAPPT
"RTN","BMXUTL5")
0^110^B16165811
"RTN","BMXUTL5",1,0)
BMXUTL5 ; IHS/OIT/HMW - DATE FORMAT ;
"RTN","BMXUTL5",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXUTL5",3,0)
;;Stolen from:* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
"RTN","BMXUTL5",4,0)
;; UTILITY: SETVARS, CENTERT, COPYLET,
"RTN","BMXUTL5",5,0)
;; UPPERCASE XREFS, DATE FORMATS, PADS/SPACES.
"RTN","BMXUTL5",6,0)
;
"RTN","BMXUTL5",7,0)
;
"RTN","BMXUTL5",8,0)
;----------
"RTN","BMXUTL5",9,0)
SETVARS ;EP
"RTN","BMXUTL5",10,0)
;---> Set standard variables.
"RTN","BMXUTL5",11,0)
D ^XBKVAR
"RTN","BMXUTL5",12,0)
S:'$D(IOF) IOF="#"
"RTN","BMXUTL5",13,0)
Q
"RTN","BMXUTL5",14,0)
;
"RTN","BMXUTL5",15,0)
;
"RTN","BMXUTL5",16,0)
;----------
"RTN","BMXUTL5",17,0)
PHONFIX(X) ;EP
"RTN","BMXUTL5",18,0)
;---> Remove parentheses from Phone#.
"RTN","BMXUTL5",19,0)
;---> Parameters:
"RTN","BMXUTL5",20,0)
; 1 - X (req) Input Phone Number; returned without parentheses.
"RTN","BMXUTL5",21,0)
;
"RTN","BMXUTL5",22,0)
Q:$G(X)=""
"RTN","BMXUTL5",23,0)
S X=$TR(X,"(","")
"RTN","BMXUTL5",24,0)
S X=$TR(X,")","-")
"RTN","BMXUTL5",25,0)
S X=$TR(X,"/","-")
"RTN","BMXUTL5",26,0)
S:X["- " X=$P(X,"- ")_"-"_$P(X,"- ",2)
"RTN","BMXUTL5",27,0)
S:$E(X,4)=" " $E(X,4)="-"
"RTN","BMXUTL5",28,0)
S:X["--" X=$P(X,"--")_"-"_$P(X,"--",2)
"RTN","BMXUTL5",29,0)
S:X?7N X=$E(X,1,3)_"-"_$E(X,4,7)
"RTN","BMXUTL5",30,0)
Q
"RTN","BMXUTL5",31,0)
;
"RTN","BMXUTL5",32,0)
;
"RTN","BMXUTL5",33,0)
;----------
"RTN","BMXUTL5",34,0)
CENTERT(TEXT,X) ;EP
"RTN","BMXUTL5",35,0)
;---> Pad TEXT with leading spaces to center in 80 columns.
"RTN","BMXUTL5",36,0)
;---> Parameters:
"RTN","BMXUTL5",37,0)
; 1 - TEXT (req) Text to be centered.
"RTN","BMXUTL5",38,0)
; 2 - X (opt) Columns to adjust to the right.
"RTN","BMXUTL5",39,0)
;
"RTN","BMXUTL5",40,0)
S:$G(TEXT)="" TEXT="* NO TEXT SUPPLIED *"
"RTN","BMXUTL5",41,0)
S:'$G(X) X=39
"RTN","BMXUTL5",42,0)
N I
"RTN","BMXUTL5",43,0)
F I=1:1:(X-($L(TEXT)/2)) S TEXT=" "_TEXT
"RTN","BMXUTL5",44,0)
Q
"RTN","BMXUTL5",45,0)
;
"RTN","BMXUTL5",46,0)
;
"RTN","BMXUTL5",47,0)
;----------
"RTN","BMXUTL5",48,0)
UPPER(X) ;EP
"RTN","BMXUTL5",49,0)
;---> Translate X to all uppercase.
"RTN","BMXUTL5",50,0)
;---> Parameters:
"RTN","BMXUTL5",51,0)
; 1 - X (req) Value to be translated into all uppercase.
"RTN","BMXUTL5",52,0)
;
"RTN","BMXUTL5",53,0)
S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
"RTN","BMXUTL5",54,0)
Q X
"RTN","BMXUTL5",55,0)
;
"RTN","BMXUTL5",56,0)
;
"RTN","BMXUTL5",57,0)
;----------
"RTN","BMXUTL5",58,0)
UPXREF(X,AGGBL) ;EP
"RTN","BMXUTL5",59,0)
;---> Set uppercase xref for X. Called from M xrefs on mixed case
"RTN","BMXUTL5",60,0)
;---> fields where an all uppercase lookup is needed.
"RTN","BMXUTL5",61,0)
;---> Parameters:
"RTN","BMXUTL5",62,0)
; 1 - X (req) The value that should be xrefed in uppercase.
"RTN","BMXUTL5",63,0)
; 2 - AGGBL (req) The global root of the file.
"RTN","BMXUTL5",64,0)
;
"RTN","BMXUTL5",65,0)
;---> Variables:
"RTN","BMXUTL5",66,0)
; 1 - DA (req) IEN of the entry being xrefed.
"RTN","BMXUTL5",67,0)
;
"RTN","BMXUTL5",68,0)
Q:'$D(AGGBL) Q:$G(X)="" Q:'$G(DA)
"RTN","BMXUTL5",69,0)
S @(AGGBL_"""U"",$E($$UPPER(X),1,30),DA)")=""
"RTN","BMXUTL5",70,0)
Q
"RTN","BMXUTL5",71,0)
;
"RTN","BMXUTL5",72,0)
;
"RTN","BMXUTL5",73,0)
;----------
"RTN","BMXUTL5",74,0)
KUPXREF(X,AGGBL) ;EP
"RTN","BMXUTL5",75,0)
;---> Kill uppercase xref for X. Called from M xrefs on mixed case
"RTN","BMXUTL5",76,0)
;---> fields where an all uppercase lookup is needed.
"RTN","BMXUTL5",77,0)
;---> Parameters:
"RTN","BMXUTL5",78,0)
; 1 - X (req) The value that should be xrefed in uppercase.
"RTN","BMXUTL5",79,0)
; 2 - AGGBL (req) The global root of the file.
"RTN","BMXUTL5",80,0)
;
"RTN","BMXUTL5",81,0)
;---> Variables:
"RTN","BMXUTL5",82,0)
; 1 - DA (req) IEN of the entry being xrefed.
"RTN","BMXUTL5",83,0)
;
"RTN","BMXUTL5",84,0)
Q:'$D(AGGBL) Q:$G(X)="" Q:'$G(DA)
"RTN","BMXUTL5",85,0)
K @(AGGBL_"""U"",$E($$UPPER(X),1,30),DA)")
"RTN","BMXUTL5",86,0)
Q
"RTN","BMXUTL5",87,0)
;
"RTN","BMXUTL5",88,0)
;
"RTN","BMXUTL5",89,0)
;----------
"RTN","BMXUTL5",90,0)
SLDT2(DATE) ;EP
"RTN","BMXUTL5",91,0)
;---> CONVERT FILEMAN INTERNAL DATE TO "SLASH" FORMAT: MM/DD/YYYY.
"RTN","BMXUTL5",92,0)
;---> DATE=DATE IN FILEMAN FORMAT.
"RTN","BMXUTL5",93,0)
Q:'$G(DATE) "NO DATE"
"RTN","BMXUTL5",94,0)
S DATE=$P(DATE,".")
"RTN","BMXUTL5",95,0)
Q:$L(DATE)'=7 DATE
"RTN","BMXUTL5",96,0)
Q:'$E(DATE,4,5) $E(DATE,1,3)+1700
"RTN","BMXUTL5",97,0)
Q:'$E(DATE,6,7) $E(DATE,4,5)_"/"_$E(DATE,2,3)
"RTN","BMXUTL5",98,0)
Q $E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_($E(DATE,1,3)+1700)
"RTN","BMXUTL5",99,0)
;
"RTN","BMXUTL5",100,0)
;
"RTN","BMXUTL5",101,0)
;----------
"RTN","BMXUTL5",102,0)
SLDT1(DATE) ;EP
"RTN","BMXUTL5",103,0)
;---> CONVERT FILEMAN INTERNAL DATE TO "SLASH" FORMAT:
"RTN","BMXUTL5",104,0)
;---> MM/DD/YYYY @TIME
"RTN","BMXUTL5",105,0)
N Y
"RTN","BMXUTL5",106,0)
Q:'$D(DATE) "NO DATE"
"RTN","BMXUTL5",107,0)
S Y=DATE,DATE=$P(DATE,".")
"RTN","BMXUTL5",108,0)
Q:'DATE "NO DATE"
"RTN","BMXUTL5",109,0)
Q:$L(DATE)'=7 DATE
"RTN","BMXUTL5",110,0)
Q:'$E(DATE,4,5) $E(DATE,1,3)+1700
"RTN","BMXUTL5",111,0)
Q:'$E(DATE,6,7) $E(DATE,4,5)_"/"_$E(DATE,2,3)
"RTN","BMXUTL5",112,0)
D DD^%DT S:Y["@" Y=" @ "_$P($P(Y,"@",2),":",1,2)
"RTN","BMXUTL5",113,0)
Q $E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_($E(DATE,1,3)+1700)_Y
"RTN","BMXUTL5",114,0)
;
"RTN","BMXUTL5",115,0)
;
"RTN","BMXUTL5",116,0)
;----------
"RTN","BMXUTL5",117,0)
NOSLDT(DATE) ;EP
"RTN","BMXUTL5",118,0)
;---> CONVERT FILEMAN INTERNAL DATE TO "NO SLASH" FORMAT: MMDDYYYY.
"RTN","BMXUTL5",119,0)
;---> DATE=DATE IN FILEMAN FORMAT.
"RTN","BMXUTL5",120,0)
Q:'$G(DATE) "NO DATE"
"RTN","BMXUTL5",121,0)
S DATE=$P(DATE,".")
"RTN","BMXUTL5",122,0)
Q:$L(DATE)'=7 DATE
"RTN","BMXUTL5",123,0)
Q $E(DATE,4,5)_$E(DATE,6,7)_($E(DATE,1,3)+1700)
"RTN","BMXUTL5",124,0)
;
"RTN","BMXUTL5",125,0)
;
"RTN","BMXUTL5",126,0)
;----------
"RTN","BMXUTL5",127,0)
IMMSDT(DATE) ;EP
"RTN","BMXUTL5",128,0)
;---> Convert Immserve Date (format MMDDYYYY) TO FILEMAN
"RTN","BMXUTL5",129,0)
;---> Internal format.
"RTN","BMXUTL5",130,0)
;---> NOTE: This code is copied into routine ^AGPATUP1 for speed.
"RTN","BMXUTL5",131,0)
;---> Any changes here should also be made to the call in ^AGPATUP1.
"RTN","BMXUTL5",132,0)
Q:'$G(DATE) "NO DATE"
"RTN","BMXUTL5",133,0)
Q ($E(DATE,5,9)-1700)_$E(DATE,1,2)_$E(DATE,3,4)
"RTN","BMXUTL5",134,0)
;
"RTN","BMXUTL5",135,0)
;
"RTN","BMXUTL5",136,0)
;----------
"RTN","BMXUTL5",137,0)
TXDT1(DATE,TIME) ;EP
"RTN","BMXUTL5",138,0)
;---> Return external date in format: DD-Mmm-YYYY@HH:MM, from Fileman
"RTN","BMXUTL5",139,0)
;---> internal YYYMMDD.HHMM
"RTN","BMXUTL5",140,0)
;---> Parameters:
"RTN","BMXUTL5",141,0)
; 1 - DATE (req) Internal Fileman date.
"RTN","BMXUTL5",142,0)
; 2 - TIME (opt)
"RTN","BMXUTL5",143,0)
;
"RTN","BMXUTL5",144,0)
Q:'$G(DATE) "NO DATE"
"RTN","BMXUTL5",145,0)
N X,Y,Z
"RTN","BMXUTL5",146,0)
S X="Jan^Feb^Mar^Apr^May^Jun^Jul^Aug^Sep^Oct^Nov^Dec"
"RTN","BMXUTL5",147,0)
S Y=$E(DATE,6,7)_"-"_$P(X,U,$E(DATE,4,5))_"-"_($E(DATE,1,3)+1700)
"RTN","BMXUTL5",148,0)
S:'$E(DATE,6,7) Y=$E(Y,4,99)
"RTN","BMXUTL5",149,0)
S:'$E(DATE,4,5) Y=$E(DATE,1,3)+1700
"RTN","BMXUTL5",150,0)
Q:'$G(TIME) Y
"RTN","BMXUTL5",151,0)
S Z=$P(DATE,".",2)
"RTN","BMXUTL5",152,0)
Q:'Z Y
"RTN","BMXUTL5",153,0)
Q Y_" @"_$E(Z,1,2)_":"_$$PAD($E(Z,3,4),2,"0")
"RTN","BMXUTL5",154,0)
;
"RTN","BMXUTL5",155,0)
;
"RTN","BMXUTL5",156,0)
;----------
"RTN","BMXUTL5",157,0)
TXDT(DATE) ;EP
"RTN","BMXUTL5",158,0)
;---> CONVERT FILEMAN INTERNAL DATE TO "TEXT" FORMAT: MMM DD,YYYY.
"RTN","BMXUTL5",159,0)
N Y
"RTN","BMXUTL5",160,0)
Q:'$D(DATE) "NO DATE"
"RTN","BMXUTL5",161,0)
S Y=DATE D DD^%DT
"RTN","BMXUTL5",162,0)
I Y[", " S Y=$P(Y,", ")_","_$P(Y,", ",2)
"RTN","BMXUTL5",163,0)
I Y["@" S Y=$P(Y,"@")_" "_$P($P(Y,"@",2),":",1,2)
"RTN","BMXUTL5",164,0)
Q Y
"RTN","BMXUTL5",165,0)
;
"RTN","BMXUTL5",166,0)
;
"RTN","BMXUTL5",167,0)
;----------
"RTN","BMXUTL5",168,0)
NOW() ;EP
"RTN","BMXUTL5",169,0)
;---> Return Current Date and Time in external format.
"RTN","BMXUTL5",170,0)
N %H,X,Y,Z
"RTN","BMXUTL5",171,0)
S %H=$H
"RTN","BMXUTL5",172,0)
D YX^%DTC
"RTN","BMXUTL5",173,0)
I Y["@" S Y=$P($P(Y,"@",2),":",1,2)
"RTN","BMXUTL5",174,0)
S Z=$$TXDT1(X)
"RTN","BMXUTL5",175,0)
S:Y]"" Z=Z_" @"_Y
"RTN","BMXUTL5",176,0)
Q Z
"RTN","BMXUTL5",177,0)
;
"RTN","BMXUTL5",178,0)
;
"RTN","BMXUTL5",179,0)
;----------
"RTN","BMXUTL5",180,0)
PAD(D,L,C) ;EP
"RTN","BMXUTL5",181,0)
;---> Pad the length of data to a total of L characters
"RTN","BMXUTL5",182,0)
;---> by adding spaces to the end of the data.
"RTN","BMXUTL5",183,0)
; Example: S X=$$PAD("MIKE",7) X="MIKE " (Added 3 spaces.)
"RTN","BMXUTL5",184,0)
;---> Parameters:
"RTN","BMXUTL5",185,0)
; 1 - D (req) Data to be padded.
"RTN","BMXUTL5",186,0)
; 2 - L (req) Total length of resulting data.
"RTN","BMXUTL5",187,0)
; 3 - C (opt) Character to pad with (default=space).
"RTN","BMXUTL5",188,0)
;
"RTN","BMXUTL5",189,0)
Q:'$D(D) ""
"RTN","BMXUTL5",190,0)
S:'$G(L) L=$L(D)
"RTN","BMXUTL5",191,0)
S:$G(C)="" C=" "
"RTN","BMXUTL5",192,0)
Q $E(D_$$REPEAT^XLFSTR(C,L),1,L)
"RTN","BMXUTL5",193,0)
;
"RTN","BMXUTL5",194,0)
;
"RTN","BMXUTL5",195,0)
;----------
"RTN","BMXUTL5",196,0)
SP(N,C) ;EP
"RTN","BMXUTL5",197,0)
;---> Return N spaces or other character.
"RTN","BMXUTL5",198,0)
; Example: S X=$$SP(5)_X Pads the front of X with 5 spaces.
"RTN","BMXUTL5",199,0)
;---> Parameters:
"RTN","BMXUTL5",200,0)
; 1 - N (req) Number of spaces to be returned as extrinsic var.
"RTN","BMXUTL5",201,0)
; 2 - C (opt) Character to pad with (default=space).
"RTN","BMXUTL5",202,0)
;
"RTN","BMXUTL5",203,0)
Q:$G(N)<1 ""
"RTN","BMXUTL5",204,0)
S:$G(C)="" C=" "
"RTN","BMXUTL5",205,0)
Q $$PAD(C,N,C)
"RTN","BMXUTL5",206,0)
;
"RTN","BMXUTL5",207,0)
;
"RTN","BMXUTL5",208,0)
;----------
"RTN","BMXUTL5",209,0)
STRIP(X) ;EP
"RTN","BMXUTL5",210,0)
;---> Strip any punctuation characters from the beginning of X,
"RTN","BMXUTL5",211,0)
;---> including spaces.
"RTN","BMXUTL5",212,0)
;---> Parameters:
"RTN","BMXUTL5",213,0)
; 1 - X (req) String of characters.
"RTN","BMXUTL5",214,0)
;
"RTN","BMXUTL5",215,0)
Q:$G(X)="" ""
"RTN","BMXUTL5",216,0)
F Q:$E(X)'?1P S X=$E(X,2,99)
"RTN","BMXUTL5",217,0)
Q X
"RTN","BMXUTL6")
0^111^B582471
"RTN","BMXUTL6",1,0)
BMXUTL6 ; IHS/OIT/HMW - BMXNET INSTALLATION CALLS ;
"RTN","BMXUTL6",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXUTL6",3,0)
;
"RTN","BMXUTL6",4,0)
;
"RTN","BMXUTL6",5,0)
POST ;EP - Called from BMX Installation postinit
"RTN","BMXUTL6",6,0)
;
"RTN","BMXUTL6",7,0)
;Add BMX AV CODE to XUS SIGNON broker option
"RTN","BMXUTL6",8,0)
N BMXFDA,BMXIEN,BMXMSG,BMXIENS,BMXMENN,BMXAVI
"RTN","BMXUTL6",9,0)
S BMXAVI=$O(^XWB(8994,"B","BMX AV CODE",0))
"RTN","BMXUTL6",10,0)
Q:'+BMXAVI
"RTN","BMXUTL6",11,0)
S BMXIENS=$O(^DIC(19,"B","XUS SIGNON",0))
"RTN","BMXUTL6",12,0)
Q:'+BMXIENS
"RTN","BMXUTL6",13,0)
;
"RTN","BMXUTL6",14,0)
S BMXIENS="?+2,"_BMXIENS_","
"RTN","BMXUTL6",15,0)
S BMXFDA(19.05,BMXIENS,.01)=BMXAVI
"RTN","BMXUTL6",16,0)
K BMXIEN,BMXMSG
"RTN","BMXUTL6",17,0)
S DIC(0)=""
"RTN","BMXUTL6",18,0)
D UPDATE^DIE("","BMXFDA","BMXIEN","BMXMSG")
"RTN","BMXUTL6",19,0)
Q
"RTN","BMXUTL6",20,0)
;
"RTN","BMXUTL6",21,0)
;
"RTN","BMXUTL6",22,0)
;
"RTN","BMXUTL6",23,0)
;Create BMXNET,APPLICATION user and set attributes
"RTN","BMXUTL6",24,0)
;
"RTN","BMXUTL6",25,0)
;N BMXFDA,BMXIEN,BMXMSG,BMXIENS,BMXMENN
"RTN","BMXUTL6",26,0)
;S BMXIENS = "?+1,"
"RTN","BMXUTL6",27,0)
;S BMXFDA(200,BMXIENS,.01)="BMXNET,APPLICATION"
"RTN","BMXUTL6",28,0)
;S BMXFDA(200,BMXIENS,2)="1_(a>yr}:3x3ja9\8vbH"
"RTN","BMXUTL6",29,0)
;S BMXFDA(200,BMXIENS,11)="$;HOSs|:3w25lLD}Be="
"RTN","BMXUTL6",30,0)
;S BMXFDA(200,BMXIENS,11.2)="88888,88888"
"RTN","BMXUTL6",31,0)
;S BMXMENN=$O(^DIC(19,"B","BMXRPC",0))
"RTN","BMXUTL6",32,0)
;I +BMXMENN S BMXFDA(200.03,"?+2,?+1,",.01)=BMXMENN
"RTN","BMXUTL6",33,0)
;K BMXIEN,BMXMSG
"RTN","BMXUTL6",34,0)
;S DIC(0)=""
"RTN","BMXUTL6",35,0)
;D UPDATE^DIE("","BMXFDA","BMXIEN","BMXMSG")
"RTN","BMXUTL6",36,0)
Q
"RTN","BMXUTL7")
0^117^B65930
"RTN","BMXUTL7",1,0)
BMXUTL7 ; IHS/OIT/HMW - BMXNET INSTALLATION CALLS ; 7/25/11 9:52am
"RTN","BMXUTL7",2,0)
;;2.31;BMX;;Jul 25, 2011;Build 16
"RTN","BMXUTL7",3,0)
;
"RTN","BMXUTL7",4,0)
;
"RTN","BMXUTL7",5,0)
ENV ;EP Environment Check
"RTN","BMXUTL7",6,0)
I $G(XPDENV)=1 D
"RTN","BMXUTL7",7,0)
. S XPDDIQ("XPZ1")=0
"RTN","BMXUTL7",8,0)
. S XPDDIQ("XPZ2")=0
"SEC","^DIC",90093.1,90093.1,0,"AUDIT")
@
"SEC","^DIC",90093.1,90093.1,0,"DD")
@
"SEC","^DIC",90093.1,90093.1,0,"DEL")
@
"SEC","^DIC",90093.1,90093.1,0,"LAYGO")
@
"SEC","^DIC",90093.1,90093.1,0,"RD")
@
"SEC","^DIC",90093.1,90093.1,0,"WR")
@
"SEC","^DIC",90093.2,90093.2,0,"AUDIT")
@
"SEC","^DIC",90093.2,90093.2,0,"DD")
@
"SEC","^DIC",90093.2,90093.2,0,"DEL")
@
"SEC","^DIC",90093.2,90093.2,0,"LAYGO")
@
"SEC","^DIC",90093.2,90093.2,0,"RD")
@
"SEC","^DIC",90093.2,90093.2,0,"WR")
@
"SEC","^DIC",90093.5,90093.5,0,"AUDIT")
@
"SEC","^DIC",90093.5,90093.5,0,"DD")
@
"SEC","^DIC",90093.5,90093.5,0,"DEL")
#
"SEC","^DIC",90093.5,90093.5,0,"LAYGO")
#
"SEC","^DIC",90093.5,90093.5,0,"RD")
#
"SEC","^DIC",90093.5,90093.5,0,"WR")
#
"SEC","^DIC",90093.9,90093.9,0,"AUDIT")
@
"SEC","^DIC",90093.9,90093.9,0,"DD")
@
"SEC","^DIC",90093.9,90093.9,0,"DEL")
#
"SEC","^DIC",90093.9,90093.9,0,"LAYGO")
#
"SEC","^DIC",90093.9,90093.9,0,"RD")
#
"SEC","^DIC",90093.9,90093.9,0,"WR")
#
"SEC","^DIC",90093.98,90093.98,0,"AUDIT")
@
"SEC","^DIC",90093.98,90093.98,0,"DD")
@
"SEC","^DIC",90093.98,90093.98,0,"DEL")
@
"SEC","^DIC",90093.98,90093.98,0,"LAYGO")
@
"SEC","^DIC",90093.98,90093.98,0,"RD")
@
"SEC","^DIC",90093.98,90093.98,0,"WR")
@
"SEC","^DIC",90093.99,90093.99,0,"AUDIT")
@
"SEC","^DIC",90093.99,90093.99,0,"DD")
@
"SEC","^DIC",90093.99,90093.99,0,"DEL")
@
"SEC","^DIC",90093.99,90093.99,0,"LAYGO")
@
"SEC","^DIC",90093.99,90093.99,0,"RD")
@
"SEC","^DIC",90093.99,90093.99,0,"WR")
@
"VER")
8.0^22.0
"^DD",90093.1,90093.1,0)
FIELD^^.03^3
"^DD",90093.1,90093.1,0,"DT")
3031229
"^DD",90093.1,90093.1,0,"IX","B",90093.1,.01)
"^DD",90093.1,90093.1,0,"NM","BMX USER")
"^DD",90093.1,90093.1,0,"VRPK")
BMX
"^DD",90093.1,90093.1,.01,0)
WINIDENT^RF^^0;1^K:$L(X)>30!($L(X)<3)!'(X'?1P.E) X
"^DD",90093.1,90093.1,.01,1,0)
^.1
"^DD",90093.1,90093.1,.01,1,1,0)
90093.1^B
"^DD",90093.1,90093.1,.01,1,1,1)
S ^BMXUSER("B",$E(X,1,30),DA)=""
"^DD",90093.1,90093.1,.01,1,1,2)
K ^BMXUSER("B",$E(X,1,30),DA)
"^DD",90093.1,90093.1,.01,3)
Answer must be 3-30 characters in length.
"^DD",90093.1,90093.1,.01,"DT")
3031229
"^DD",90093.1,90093.1,.02,0)
USER^P200'^VA(200,^0;2^Q
"^DD",90093.1,90093.1,.02,3)
Enter the User
"^DD",90093.1,90093.1,.02,"DT")
3031229
"^DD",90093.1,90093.1,.03,0)
V ENCRYPTED^F^^0;3^K:$L(X)>30!($L(X)<1) X
"^DD",90093.1,90093.1,.03,3)
Answer must be 1-30 characters in length.
"^DD",90093.1,90093.1,.03,"DT")
3030909
"^DD",90093.2,90093.2,0)
FIELD^^.03^3
"^DD",90093.2,90093.2,0,"DT")
3040226
"^DD",90093.2,90093.2,0,"IX","B",90093.2,.01)
"^DD",90093.2,90093.2,0,"NM","BMX APPLICATION")
"^DD",90093.2,90093.2,0,"VRPK")
BMX
"^DD",90093.2,90093.2,.01,0)
MAJOR VERSION^RF^^0;1^K:$L(X)>30!($L(X)<1)!'(X'?1P.E) X
"^DD",90093.2,90093.2,.01,1,0)
^.1
"^DD",90093.2,90093.2,.01,1,1,0)
90093.2^B
"^DD",90093.2,90093.2,.01,1,1,1)
S ^BMXAPPL("B",$E(X,1,30),DA)=""
"^DD",90093.2,90093.2,.01,1,1,2)
K ^BMXAPPL("B",$E(X,1,30),DA)
"^DD",90093.2,90093.2,.01,3)
Answer must be 1-30 characters in length.
"^DD",90093.2,90093.2,.01,"DT")
3040226
"^DD",90093.2,90093.2,.02,0)
MINOR VERSION^RF^^0;2^K:$L(X)>30!($L(X)<1)!'(X'?1P.E) X
"^DD",90093.2,90093.2,.02,3)
Answer must be 1-30 characters in length.
"^DD",90093.2,90093.2,.02,"DT")
3040226
"^DD",90093.2,90093.2,.03,0)
BUILD^D^^0;3^S %DT="ETXR" D ^%DT S X=Y K:Y<1 X
"^DD",90093.2,90093.2,.03,"DT")
3040226
"^DD",90093.5,90093.5,0)
FIELD^^.04^4
"^DD",90093.5,90093.5,0,"DT")
3040919
"^DD",90093.5,90093.5,0,"IX","B",90093.5,.01)
"^DD",90093.5,90093.5,0,"NM","BMXNET MONITOR")
"^DD",90093.5,90093.5,0,"VRPK")
BMX
"^DD",90093.5,90093.5,.01,0)
PORT^RNJ5,0^^0;1^K:+X'=X!(X>99999)!(X<1000)!(X?.E1"."1N.N) X
"^DD",90093.5,90093.5,.01,1,0)
^.1
"^DD",90093.5,90093.5,.01,1,1,0)
90093.5^B
"^DD",90093.5,90093.5,.01,1,1,1)
S ^BMXMON("B",$E(X,1,30),DA)=""
"^DD",90093.5,90093.5,.01,1,1,2)
K ^BMXMON("B",$E(X,1,30),DA)
"^DD",90093.5,90093.5,.01,3)
Type a Number between 1000 and 99999, 0 Decimal Digits
"^DD",90093.5,90093.5,.01,"DT")
3040919
"^DD",90093.5,90093.5,.02,0)
ENABLED^S^1:YES;0:NO;^0;2^Q
"^DD",90093.5,90093.5,.02,3)
ANSWER YES IF PORT IS ENABLED
"^DD",90093.5,90093.5,.02,21,0)
^^1^1^3040919^
"^DD",90093.5,90093.5,.02,21,1,0)
ANSWER YES IF PORT IS ENABLED
"^DD",90093.5,90093.5,.02,"DT")
3040919
"^DD",90093.5,90093.5,.03,0)
INTEGRATED SECURITY^S^1:YES;0:NO;^0;3^Q
"^DD",90093.5,90093.5,.03,3)
ANSWER YES IF INTEGRATED SECURITY ENABLED
"^DD",90093.5,90093.5,.03,21,0)
^^1^1^3040919^
"^DD",90093.5,90093.5,.03,21,1,0)
ANSWER YES IF INTEGRATED SECURITY ENABLED
"^DD",90093.5,90093.5,.03,"DT")
3040919
"^DD",90093.5,90093.5,.04,0)
SESSION NAMESPACE^F^^0;4^K:$L(X)>30!($L(X)<3) X
"^DD",90093.5,90093.5,.04,3)
Sessions will be spawned in this namespace.
"^DD",90093.5,90093.5,.04,21,0)
^^1^1^3040919^
"^DD",90093.5,90093.5,.04,21,1,0)
Sessions will be spawned in this namespace.
"^DD",90093.5,90093.5,.04,"DT")
3040919
"^DD",90093.9,90093.9,0)
FIELD^^1100^9
"^DD",90093.9,90093.9,0,"DT")
3051207
"^DD",90093.9,90093.9,0,"IX","AUSRP",90093.9,.08)
"^DD",90093.9,90093.9,0,"IX","B",90093.9,.01)
"^DD",90093.9,90093.9,0,"NM","BMX GUI REPORT")
"^DD",90093.9,90093.9,0,"VRPK")
BMX
"^DD",90093.9,90093.9,.01,0)
NAME^RF^^0;1^K:$L(X)>30!($L(X)<3)!'(X'?1P.E) X
"^DD",90093.9,90093.9,.01,1,0)
^.1
"^DD",90093.9,90093.9,.01,1,1,0)
90093.9^B
"^DD",90093.9,90093.9,.01,1,1,1)
S ^BMXGUIR("B",$E(X,1,30),DA)=""
"^DD",90093.9,90093.9,.01,1,1,2)
K ^BMXGUIR("B",$E(X,1,30),DA)
"^DD",90093.9,90093.9,.01,3)
Answer must be 3-30 characters in length.
"^DD",90093.9,90093.9,.01,"DT")
3041004
"^DD",90093.9,90093.9,.02,0)
USER WHO REQUESTED REPORT^P200'^VA(200,^0;2^Q
"^DD",90093.9,90093.9,.02,"DT")
3041004
"^DD",90093.9,90093.9,.03,0)
START TIME^D^^0;3^S %DT="ET" D ^%DT S X=Y K:Y<1 X
"^DD",90093.9,90093.9,.03,1,0)
^.1^^0
"^DD",90093.9,90093.9,.03,"DT")
3050920
"^DD",90093.9,90093.9,.04,0)
END TIME^D^^0;4^S %DT="ET" D ^%DT S X=Y K:Y<1 X
"^DD",90093.9,90093.9,.04,"DT")
3041008
"^DD",90093.9,90093.9,.05,0)
OUTPUT TYPE^S^1:Individual Reports;2:EPI File;3:Cumulative Reports;4:Individual and Cumulative Reports;^0;5^Q
"^DD",90093.9,90093.9,.05,"DT")
3041011
"^DD",90093.9,90093.9,.06,0)
OPTION NAME^F^^0;6^K:$L(X)>60!($L(X)<1) X
"^DD",90093.9,90093.9,.06,3)
Answer must be 1-60 characters in length.
"^DD",90093.9,90093.9,.06,"DT")
3051021
"^DD",90093.9,90093.9,.07,0)
REPORT STATUS^S^R:RUNNING;Q:QUEUED;C:COMPLETED;^0;7^Q
"^DD",90093.9,90093.9,.07,"DT")
3050915
"^DD",90093.9,90093.9,.08,0)
PACKAGE^P9.4'^DIC(9.4,^0;8^Q
"^DD",90093.9,90093.9,.08,1,0)
^.1
"^DD",90093.9,90093.9,.08,1,1,0)
90093.9^AUSRP^MUMPS
"^DD",90093.9,90093.9,.08,1,1,1)
S ^BMXGUIR("AUSRP",$P(^BMXGUIR(DA,0),"^",2),X,(9999999.9999-$P(^BMXGUIR(DA,0),"^",3)),DA)=""
"^DD",90093.9,90093.9,.08,1,1,2)
K ^BMXGUIR("AUSRP",$P(^BMXGUIR(DA,0),"^",2),X,(9999999.9999-$P(^BMXGUIR(DA,0),"^",3)),DA)
"^DD",90093.9,90093.9,.08,1,1,"DT")
3051207
"^DD",90093.9,90093.9,.08,"DT")
3051207
"^DD",90093.9,90093.9,1100,0)
OUTPUT^90093.911^^11;0
"^DD",90093.9,90093.911,0)
OUTPUT SUB-FIELD^^.01^1
"^DD",90093.9,90093.911,0,"NM","OUTPUT")
"^DD",90093.9,90093.911,0,"UP")
90093.9
"^DD",90093.9,90093.911,.01,0)
OUTPUT^W^^0;1^Q
"^DD",90093.9,90093.911,.01,"DT")
3041004
"^DD",90093.98,90093.98,0)
FIELD^^1^4
"^DD",90093.98,90093.98,0,"DT")
3050622
"^DD",90093.98,90093.98,0,"IX","B",90093.98,.01)
"^DD",90093.98,90093.98,0,"NM","BMX ADO LOG")
"^DD",90093.98,90093.98,0,"VRPK")
BMX
"^DD",90093.98,90093.98,.01,0)
TRANSACTION TIMESTAMP^RD^^0;1^S %DT="ESTXR" D ^%DT S X=Y K:Y<1 X
"^DD",90093.98,90093.98,.01,1,0)
^.1
"^DD",90093.98,90093.98,.01,1,1,0)
90093.98^B
"^DD",90093.98,90093.98,.01,1,1,1)
S ^BMXADOL("B",$E(X,1,30),DA)=""
"^DD",90093.98,90093.98,.01,1,1,2)
K ^BMXADOL("B",$E(X,1,30),DA)
"^DD",90093.98,90093.98,.01,3)
"^DD",90093.98,90093.98,.01,"DT")
3050622
"^DD",90093.98,90093.98,.02,0)
FILE NUMBER^F^^0;2^K:$L(X)>20!($L(X)<1) X
"^DD",90093.98,90093.98,.02,3)
Answer must be 1-20 characters in length.
"^DD",90093.98,90093.98,.02,"DT")
3050622
"^DD",90093.98,90093.98,.03,0)
DAS^F^^0;3^K:$L(X)>30!($L(X)<1) X
"^DD",90093.98,90093.98,.03,3)
Answer must be 1-30 characters in length.
"^DD",90093.98,90093.98,.03,"DT")
3050622
"^DD",90093.98,90093.98,1,0)
DATA^90093.981^^1;0
"^DD",90093.98,90093.981,0)
DATA SUB-FIELD^^.01^1
"^DD",90093.98,90093.981,0,"DT")
3050622
"^DD",90093.98,90093.981,0,"NM","DATA")
"^DD",90093.98,90093.981,0,"UP")
90093.98
"^DD",90093.98,90093.981,.01,0)
DATA^W^^0;1^Q
"^DD",90093.98,90093.981,.01,"DT")
3050622
"^DD",90093.99,90093.99,0)
FIELD^^2^5
"^DD",90093.99,90093.99,0,"DT")
3040908
"^DD",90093.99,90093.99,0,"IX","B",90093.99,.01)
"^DD",90093.99,90093.99,0,"NM","BMX ADO SCHEMA")
"^DD",90093.99,90093.99,0,"PT",19707.44,.03)
"^DD",90093.99,90093.99,0,"PT",19707.46,.02)
"^DD",90093.99,90093.99,0,"PT",19707.48,.01)
"^DD",90093.99,90093.99,0,"PT",91707.49,.01)
"^DD",90093.99,90093.99,0,"VRPK")
BMX
"^DD",90093.99,90093.99,.01,0)
SCHEMA NAME^RF^^0;1^K:$L(X)>30!(X?.N)!($L(X)<3)!'(X'?1P.E) X
"^DD",90093.99,90093.99,.01,1,0)
^.1
"^DD",90093.99,90093.99,.01,1,1,0)
90093.99^B
"^DD",90093.99,90093.99,.01,1,1,1)
S ^BMXADO("B",$E(X,1,30),DA)=""
"^DD",90093.99,90093.99,.01,1,1,2)
K ^BMXADO("B",$E(X,1,30),DA)
"^DD",90093.99,90093.99,.01,3)
NAME MUST BE 3-30 CHARACTERS, NOT NUMERIC OR STARTING WITH PUNCTUATION
"^DD",90093.99,90093.99,.02,0)
FILE OR SUBFILE NUMBER^NJ22,9^^0;2^K:+X'=X!(X>999999999999)!(X<0)!(X?.E1"."10N.N) X
"^DD",90093.99,90093.99,.02,3)
Type a Number between 0 and 999999999999, 9 Decimal Digits
"^DD",90093.99,90093.99,.02,"DT")
3040414
"^DD",90093.99,90093.99,.03,0)
DATASET IS READ ONLY^S^1:YES;0:NO;^0;3^Q
"^DD",90093.99,90093.99,.03,"DT")
3040420
"^DD",90093.99,90093.99,1,0)
FIELD NUMBER^90093.991^^1;0
"^DD",90093.99,90093.99,2,0)
VIEW^90093.992^^2;0
"^DD",90093.99,90093.991,0)
FIELD NUMBER SUB-FIELD^^3^12
"^DD",90093.99,90093.991,0,"DT")
3040707
"^DD",90093.99,90093.991,0,"IX","B",90093.991,.01)
"^DD",90093.99,90093.991,0,"NM","FIELD NUMBER")
"^DD",90093.99,90093.991,0,"UP")
90093.99
"^DD",90093.99,90093.991,.01,0)
FIELD NUMBER^MF^^0;1^K:$L(X)>30!($L(X)<1) X
"^DD",90093.99,90093.991,.01,1,0)
^.1
"^DD",90093.99,90093.991,.01,1,1,0)
90093.991^B
"^DD",90093.99,90093.991,.01,1,1,1)
S ^BMXADO(DA(1),1,"B",$E(X,1,30),DA)=""
"^DD",90093.99,90093.991,.01,1,1,2)
K ^BMXADO(DA(1),1,"B",$E(X,1,30),DA)
"^DD",90093.99,90093.991,.01,3)
Answer must be 1-30 characters in length.
"^DD",90093.99,90093.991,.01,"DT")
3040528
"^DD",90093.99,90093.991,.02,0)
DATA TYPE^S^T:TEXT;D:DATE;I:INTEGER;N:NUMBER;^0;2^Q
"^DD",90093.99,90093.991,.02,"DT")
3040413
"^DD",90093.99,90093.991,.03,0)
FIELD LENGTH^F^^0;3^K:$L(X)>5!($L(X)<1) X
"^DD",90093.99,90093.991,.03,3)
Answer must be 1-5 characters in length.
"^DD",90093.99,90093.991,.03,"DT")
3040413
"^DD",90093.99,90093.991,.04,0)
COLUMN HEADER^F^^0;4^K:$L(X)>30!($L(X)<1) X
"^DD",90093.99,90093.991,.04,3)
Answer must be 1-30 characters in length.
"^DD",90093.99,90093.991,.04,"DT")
3040413
"^DD",90093.99,90093.991,.05,0)
READ ONLY^S^1:YES;0:NO;^0;5^Q
"^DD",90093.99,90093.991,.05,"DT")
3040413
"^DD",90093.99,90093.991,.06,0)
KEY FIELD^S^1:YES;0:NO;^0;6^Q
"^DD",90093.99,90093.991,.06,"DT")
3040413
"^DD",90093.99,90093.991,.07,0)
NULL ALLOWED^S^1:YES;0:NO;^0;7^Q
"^DD",90093.99,90093.991,.07,"DT")
3040413
"^DD",90093.99,90093.991,.08,0)
IEN AUTOMATICALLY INCLUDED^S^1:YES;0:NO;^0;8^Q
"^DD",90093.99,90093.991,.08,21,0)
^^6^6^3040528^
"^DD",90093.99,90093.991,.08,21,1,0)
IF THIS IS 'YES', AN 'UPDATE' FIELD WILL AUTOMATTICALLY BE ADDED TO
"^DD",90093.99,90093.991,.08,21,2,0)
THE SCHEMA. THE FIELD'S VALUE IS 'WRITE ONLY', IE IF THE USER SEES AND
"^DD",90093.99,90093.991,.08,21,3,0)
SELECTS A RESOLVED POINTER VALUE, THIS FIELD'S VALUE WILL BE USED TO
"^DD",90093.99,90093.991,.08,21,4,0)
UPDATE RPMS. THE UPDATE FIELD'S VALUE WILL ALWAYS BE `IEN. THE EBCU
"^DD",90093.99,90093.991,.08,21,5,0)
WILL AUTOMATICALLY USE THIS VALUE RATHER THAN THE RESOLVED POINTER
"^DD",90093.99,90093.991,.08,21,6,0)
VALUE TO UPDATE FILEMAN.
"^DD",90093.99,90093.991,.08,"DT")
3040528
"^DD",90093.99,90093.991,.09,0)
ALWAYS GET INTERNAL VALUE^S^1:YES;0:NO;^0;9^Q
"^DD",90093.99,90093.991,.09,"DT")
3040528
"^DD",90093.99,90093.991,1,0)
AUTO IDENTIFIER EXTR FUNCT^F^^1;E1,240^K:$L(X)>19!($L(X)<3) X
"^DD",90093.99,90093.991,1,3)
Answer must be 3-19 characters in length.
"^DD",90093.99,90093.991,1,21,0)
^^3^3^3040528^
"^DD",90093.99,90093.991,1,21,1,0)
IF THIS EXTRINSIC FUNCTION IS DEFINED (EG TAG^ROUTINE), THEN A DISPLAY ONLY
"^DD",90093.99,90093.991,1,21,2,0)
FIELD WILL BE INCLUDED IN THE SCHEMA THAT CONTAINS IDENTIFIERS (OR OTHER
"^DD",90093.99,90093.991,1,21,3,0)
INFO) GENERATED BY THE EXTRINSIC FUNCTION - ID=$$TAG^ROUTINE(DA)
"^DD",90093.99,90093.991,1,"DT")
3040528
"^DD",90093.99,90093.991,2,0)
SPECIAL UPDATE EP^F^^2;E1,245^K:$L(X)>19!($L(X)<3) X
"^DD",90093.99,90093.991,2,3)
Answer must be 3-19 characters in length.
"^DD",90093.99,90093.991,2,21,0)
^^2^2^3040528^
"^DD",90093.99,90093.991,2,21,1,0)
IF THE EP EXISTS(EG TAG^ROUTINE), THIS SPECIAL CODE WILL BE USED TO
"^DD",90093.99,90093.991,2,21,2,0)
UPDATE FILEMAN AND THE EBCU'S STD UPDATE MECHANISM WILL BE BYPASSED.
"^DD",90093.99,90093.991,2,"DT")
3040528
"^DD",90093.99,90093.991,3,0)
EXTR FUNCT FOR TRIGGERED VALUE^F^^3;E1,245^K:$L(X)>240!($L(X)<1) X
"^DD",90093.99,90093.991,3,3)
Answer must be 1-240 characters in length.
"^DD",90093.99,90093.991,3,"DT")
3040707
"^DD",90093.99,90093.992,0)
VIEW SUB-FIELD^^3^4
"^DD",90093.99,90093.992,0,"DT")
3040414
"^DD",90093.99,90093.992,0,"IX","B",90093.992,.01)
"^DD",90093.99,90093.992,0,"NM","VIEW")
"^DD",90093.99,90093.992,0,"UP")
90093.99
"^DD",90093.99,90093.992,.01,0)
VIEW^MF^^0;1^K:$L(X)>30!($L(X)<1) X
"^DD",90093.99,90093.992,.01,1,0)
^.1
"^DD",90093.99,90093.992,.01,1,1,0)
90093.992^B
"^DD",90093.99,90093.992,.01,1,1,1)
S ^BMXADO(DA(1),2,"B",$E(X,1,30),DA)=""
"^DD",90093.99,90093.992,.01,1,1,2)
K ^BMXADO(DA(1),2,"B",$E(X,1,30),DA)
"^DD",90093.99,90093.992,.01,3)
Answer must be 1-30 characters in length.
"^DD",90093.99,90093.992,.01,21,0)
^^1^1^3040413^
"^DD",90093.99,90093.992,.01,21,1,0)
Entry points for clooecting data as well as headers
"^DD",90093.99,90093.992,.01,"DT")
3040413
"^DD",90093.99,90093.992,1,0)
ENTRY POINT^F^^1;E1,240^K:$L(X)>20!($L(X)<1) X
"^DD",90093.99,90093.992,1,3)
Answer must be 1-20 characters in length.
"^DD",90093.99,90093.992,1,"DT")
3040413
"^DD",90093.99,90093.992,2,0)
PARAMETER^90093.9922^^2;0
"^DD",90093.99,90093.992,3,0)
DESCRIPTION^90093.9923^^3;0
"^DD",90093.99,90093.9922,0)
PARAMETER SUB-FIELD^^.02^2
"^DD",90093.99,90093.9922,0,"DT")
3040413
"^DD",90093.99,90093.9922,0,"IX","B",90093.9922,.01)
"^DD",90093.99,90093.9922,0,"NM","PARAMETER")
"^DD",90093.99,90093.9922,0,"UP")
90093.992
"^DD",90093.99,90093.9922,.01,0)
PARAMETER^MF^^0;1^K:$L(X)>30!($L(X)<1) X
"^DD",90093.99,90093.9922,.01,1,0)
^.1
"^DD",90093.99,90093.9922,.01,1,1,0)
90093.9922^B
"^DD",90093.99,90093.9922,.01,1,1,1)
S ^BMXADO(DA(2),2,DA(1),2,"B",$E(X,1,30),DA)=""
"^DD",90093.99,90093.9922,.01,1,1,2)
K ^BMXADO(DA(2),2,DA(1),2,"B",$E(X,1,30),DA)
"^DD",90093.99,90093.9922,.01,3)
Answer must be 1-30 characters in length.
"^DD",90093.99,90093.9922,.01,"DT")
3040413
"^DD",90093.99,90093.9922,.02,0)
BRIEF DESCRIPTION^F^^0;2^K:$L(X)>200!($L(X)<1) X
"^DD",90093.99,90093.9922,.02,3)
Answer must be 1-200 characters in length.
"^DD",90093.99,90093.9922,.02,"DT")
3040413
"^DD",90093.99,90093.9923,0)
DESCRIPTION SUB-FIELD^^.01^1
"^DD",90093.99,90093.9923,0,"DT")
3040414
"^DD",90093.99,90093.9923,0,"NM","DESCRIPTION")
"^DD",90093.99,90093.9923,0,"UP")
90093.992
"^DD",90093.99,90093.9923,.01,0)
DESCRIPTION^W^^0;1^Q
"^DD",90093.99,90093.9923,.01,"DT")
3040414
"^DIC",90093.1,90093.1,0)
BMX USER^90093.1
"^DIC",90093.1,90093.1,0,"GL")
^BMXUSER(
"^DIC",90093.1,"B","BMX USER",90093.1)
"^DIC",90093.2,90093.2,0)
BMX APPLICATION^90093.2
"^DIC",90093.2,90093.2,0,"GL")
^BMXAPPL(
"^DIC",90093.2,"B","BMX APPLICATION",90093.2)
"^DIC",90093.5,90093.5,0)
BMXNET MONITOR^90093.5
"^DIC",90093.5,90093.5,0,"GL")
^BMXMON(
"^DIC",90093.5,"B","BMXNET MONITOR",90093.5)
"^DIC",90093.9,90093.9,0)
BMX GUI REPORT^90093.9
"^DIC",90093.9,90093.9,0,"GL")
^BMXGUIR(
"^DIC",90093.9,"B","BMX GUI REPORT",90093.9)
"^DIC",90093.98,90093.98,0)
BMX ADO LOG^90093.98D
"^DIC",90093.98,90093.98,0,"GL")
^BMXADOL(
"^DIC",90093.98,"B","BMX ADO LOG",90093.98)
"^DIC",90093.99,90093.99,0)
BMX ADO SCHEMA^90093.99
"^DIC",90093.99,90093.99,0,"GL")
^BMXADO(
"^DIC",90093.99,"B","BMX ADO SCHEMA",90093.99)
**END**
**END**
Reference in New Issue View Git Blame Copy Permalink