diff --git a/k/BMX_0220_WV.k b/k/BMX_0220_WV.k
deleted file mode 100644
index f6b454c..0000000
--- a/k/BMX_0220_WV.k
+++ /dev/null
@@ -1,23670 +0,0 @@
-KIDS Distribution saved on Sep 07, 2010@11:25:01
-BMX.net Utilties for WV v2.2
-**KIDS**:BMX 2.2^
-
-**INSTALL NAME**
-BMX 2.2
-"BLD",7651,0)
-BMX 2.2^BMXNET RPMS .NET UTILITIES^0^3100907^n
-"BLD",7651,1,0)
-^^14^14^3100907^
-"BLD",7651,1,1,0)
-BMXNet .NET Connectivity utilities for RPMS.
-"BLD",7651,1,2,0)
-Version 2.0 kids build to support BMXNet20.dll
-"BLD",7651,1,3,0)
- 
-"BLD",7651,1,4,0)
-Version 2.1 adds support to GT.M.
-"BLD",7651,1,5,0)
- 
-"BLD",7651,1,6,0)
-Version 2.2 adds a few bug fixes:
-"BLD",7651,1,7,0)
- - Process Name is now set in BMXMON
-"BLD",7651,1,8,0)
- - Timeout is now correct:
-"BLD",7651,1,9,0)
-   - 10 seconds for 1st connection
-"BLD",7651,1,10,0)
-   - 180 seconds for continuation
-"BLD",7651,1,11,0)
-   - Kernel Broker Timeout for regular use
-"BLD",7651,1,12,0)
- - Divisions are now presented to the user if the user has more than one 
-"BLD",7651,1,13,0)
-division in his/her profile.
-"BLD",7651,1,14,0)
-Version 2.2 requires BMXNet22.dll
-"BLD",7651,4,0)
-^9.64PA^90093.9^6
-"BLD",7651,4,90093.1,0)
-90093.1
-"BLD",7651,4,90093.1,222)
-y^y^f^^^^n
-"BLD",7651,4,90093.2,0)
-90093.2
-"BLD",7651,4,90093.2,222)
-y^y^f^^n^^y^o^n
-"BLD",7651,4,90093.5,0)
-90093.5
-"BLD",7651,4,90093.5,222)
-y^y^f^^^^n
-"BLD",7651,4,90093.9,0)
-90093.9
-"BLD",7651,4,90093.9,222)
-y^y^f^^^^n
-"BLD",7651,4,90093.98,0)
-90093.98
-"BLD",7651,4,90093.98,222)
-y^y^f^^^^n
-"BLD",7651,4,90093.99,0)
-90093.99
-"BLD",7651,4,90093.99,222)
-y^y^f^^n^^y^a^n
-"BLD",7651,4,"B",90093.1,90093.1)
-
-"BLD",7651,4,"B",90093.2,90093.2)
-
-"BLD",7651,4,"B",90093.5,90093.5)
-
-"BLD",7651,4,"B",90093.9,90093.9)
-
-"BLD",7651,4,"B",90093.98,90093.98)
-
-"BLD",7651,4,"B",90093.99,90093.99)
-
-"BLD",7651,6.3)
-9
-"BLD",7651,"ABPKG")
-n
-"BLD",7651,"INIT")
-
-"BLD",7651,"KRN",0)
-^9.67PA^8989.52^19
-"BLD",7651,"KRN",.4,0)
-.4
-"BLD",7651,"KRN",.4,"NM",0)
-^9.68A^^
-"BLD",7651,"KRN",.401,0)
-.401
-"BLD",7651,"KRN",.402,0)
-.402
-"BLD",7651,"KRN",.402,"NM",0)
-^9.68A^1^1
-"BLD",7651,"KRN",.402,"NM",1,0)
-BMX MONITOR EDIT    FILE #90093.5^90093.5^0
-"BLD",7651,"KRN",.402,"NM","B","BMX MONITOR EDIT    FILE #90093.5",1)
-
-"BLD",7651,"KRN",.403,0)
-.403
-"BLD",7651,"KRN",.5,0)
-.5
-"BLD",7651,"KRN",.84,0)
-.84
-"BLD",7651,"KRN",3.6,0)
-3.6
-"BLD",7651,"KRN",3.8,0)
-3.8
-"BLD",7651,"KRN",9.2,0)
-9.2
-"BLD",7651,"KRN",9.8,0)
-9.8
-"BLD",7651,"KRN",9.8,"NM",0)
-^9.68A^117^59
-"BLD",7651,"KRN",9.8,"NM",45,0)
-BMXADOV1^^0^B68620559
-"BLD",7651,"KRN",9.8,"NM",58,0)
-BMXMON^^0^B125616041
-"BLD",7651,"KRN",9.8,"NM",59,0)
-BMXADE1^^0^B11418056
-"BLD",7651,"KRN",9.8,"NM",60,0)
-BMXADE2^^0^B13063702
-"BLD",7651,"KRN",9.8,"NM",61,0)
-BMXADO^^0^B32349097
-"BLD",7651,"KRN",9.8,"NM",62,0)
-BMXADO2^^0^B10227201
-"BLD",7651,"KRN",9.8,"NM",63,0)
-BMXADOF^^0^B90964967
-"BLD",7651,"KRN",9.8,"NM",64,0)
-BMXADOF1^^0^B12833341
-"BLD",7651,"KRN",9.8,"NM",65,0)
-BMXADOF2^^0^B7123769
-"BLD",7651,"KRN",9.8,"NM",66,0)
-BMXADOFD^^0^B8876207
-"BLD",7651,"KRN",9.8,"NM",67,0)
-BMXADOFS^^0^B38538227
-"BLD",7651,"KRN",9.8,"NM",68,0)
-BMXADOI^^0^B6267463
-"BLD",7651,"KRN",9.8,"NM",69,0)
-BMXADOS^^0^B75110422
-"BLD",7651,"KRN",9.8,"NM",70,0)
-BMXADOS1^^0^B9622665
-"BLD",7651,"KRN",9.8,"NM",71,0)
-BMXADOV^^0^B22947698
-"BLD",7651,"KRN",9.8,"NM",72,0)
-BMXADOV2^^0^B19908593
-"BLD",7651,"KRN",9.8,"NM",73,0)
-BMXADOVJ^^0^B8677686
-"BLD",7651,"KRN",9.8,"NM",74,0)
-BMXADOX^^0^B208011638
-"BLD",7651,"KRN",9.8,"NM",75,0)
-BMXADOX1^^0^B84889528
-"BLD",7651,"KRN",9.8,"NM",76,0)
-BMXADOX2^^0^B11989229
-"BLD",7651,"KRN",9.8,"NM",77,0)
-BMXADOXX^^0^B166011930
-"BLD",7651,"KRN",9.8,"NM",78,0)
-BMXADOXY^^0^B61093377
-"BLD",7651,"KRN",9.8,"NM",79,0)
-BMXFIND^^0^B45092715
-"BLD",7651,"KRN",9.8,"NM",80,0)
-BMXG^^0^B2718298
-"BLD",7651,"KRN",9.8,"NM",81,0)
-BMXGETS^^0^B15016739
-"BLD",7651,"KRN",9.8,"NM",82,0)
-BMXMBRK^^0^B32854296
-"BLD",7651,"KRN",9.8,"NM",83,0)
-BMXMBRK2^^0^B17554247
-"BLD",7651,"KRN",9.8,"NM",84,0)
-BMXMEVN^^0^B41862703
-"BLD",7651,"KRN",9.8,"NM",85,0)
-BMXMSEC^^0^B8709977
-"BLD",7651,"KRN",9.8,"NM",86,0)
-BMXPRS^^0^B8898368
-"BLD",7651,"KRN",9.8,"NM",87,0)
-BMXRPC^^0^B21470311
-"BLD",7651,"KRN",9.8,"NM",88,0)
-BMXRPC1^^0^B52168951
-"BLD",7651,"KRN",9.8,"NM",89,0)
-BMXRPC2^^0^B11504982
-"BLD",7651,"KRN",9.8,"NM",90,0)
-BMXRPC3^^0^B39843476
-"BLD",7651,"KRN",9.8,"NM",91,0)
-BMXRPC4^^0^B28124037
-"BLD",7651,"KRN",9.8,"NM",92,0)
-BMXRPC5^^0^B15030574
-"BLD",7651,"KRN",9.8,"NM",93,0)
-BMXRPC6^^0^B14693179
-"BLD",7651,"KRN",9.8,"NM",94,0)
-BMXRPC7^^0^B40496291
-"BLD",7651,"KRN",9.8,"NM",95,0)
-BMXRPC8^^0^B5993639
-"BLD",7651,"KRN",9.8,"NM",96,0)
-BMXRPC9^^0^B45877662
-"BLD",7651,"KRN",9.8,"NM",97,0)
-BMXSQL^^0^B109951806
-"BLD",7651,"KRN",9.8,"NM",98,0)
-BMXSQL1^^0^B112955506
-"BLD",7651,"KRN",9.8,"NM",99,0)
-BMXSQL2^^0^B9590811
-"BLD",7651,"KRN",9.8,"NM",100,0)
-BMXSQL3^^0^B190410807
-"BLD",7651,"KRN",9.8,"NM",101,0)
-BMXSQL4^^0^B3594616
-"BLD",7651,"KRN",9.8,"NM",102,0)
-BMXSQL5^^0^B51902207
-"BLD",7651,"KRN",9.8,"NM",103,0)
-BMXSQL6^^0^B130304448
-"BLD",7651,"KRN",9.8,"NM",104,0)
-BMXSQL7^^0^B65321243
-"BLD",7651,"KRN",9.8,"NM",105,0)
-BMXSQL91^^0^B25109398
-"BLD",7651,"KRN",9.8,"NM",106,0)
-BMXTABLE^^0^B130270
-"BLD",7651,"KRN",9.8,"NM",107,0)
-BMXTRS^^0^B1202427
-"BLD",7651,"KRN",9.8,"NM",108,0)
-BMXUTL1^^0^B39816098
-"BLD",7651,"KRN",9.8,"NM",109,0)
-BMXUTL2^^0^B1806952
-"BLD",7651,"KRN",9.8,"NM",110,0)
-BMXUTL5^^0^B16165811
-"BLD",7651,"KRN",9.8,"NM",111,0)
-BMXUTL6^^0^B582471
-"BLD",7651,"KRN",9.8,"NM",114,0)
-BMXE01^^0^B6931626
-"BLD",7651,"KRN",9.8,"NM",115,0)
-BMXNTEG^^0^B7300059
-"BLD",7651,"KRN",9.8,"NM",116,0)
-BMXPO^^0^B4666839
-"BLD",7651,"KRN",9.8,"NM",117,0)
-BMXUTL7^^0^B65930
-"BLD",7651,"KRN",9.8,"NM","B","BMXADE1",59)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXADE2",60)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXADO",61)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXADO2",62)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXADOF",63)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXADOF1",64)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXADOF2",65)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXADOFD",66)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXADOFS",67)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXADOI",68)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXADOS",69)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXADOS1",70)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXADOV",71)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXADOV1",45)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXADOV2",72)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXADOVJ",73)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXADOX",74)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXADOX1",75)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXADOX2",76)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXADOXX",77)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXADOXY",78)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXE01",114)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXFIND",79)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXG",80)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXGETS",81)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXMBRK",82)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXMBRK2",83)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXMEVN",84)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXMON",58)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXMSEC",85)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXNTEG",115)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXPO",116)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXPRS",86)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXRPC",87)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXRPC1",88)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXRPC2",89)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXRPC3",90)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXRPC4",91)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXRPC5",92)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXRPC6",93)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXRPC7",94)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXRPC8",95)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXRPC9",96)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXSQL",97)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXSQL1",98)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXSQL2",99)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXSQL3",100)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXSQL4",101)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXSQL5",102)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXSQL6",103)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXSQL7",104)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXSQL91",105)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXTABLE",106)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXTRS",107)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXUTL1",108)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXUTL2",109)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXUTL5",110)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXUTL6",111)
-
-"BLD",7651,"KRN",9.8,"NM","B","BMXUTL7",117)
-
-"BLD",7651,"KRN",19,0)
-19
-"BLD",7651,"KRN",19,"NM",0)
-^9.68A^5^5
-"BLD",7651,"KRN",19,"NM",1,0)
-BMX MONITOR EDIT^^0
-"BLD",7651,"KRN",19,"NM",2,0)
-BMX MONITOR START^^0
-"BLD",7651,"KRN",19,"NM",3,0)
-BMX MONITOR STOP^^0
-"BLD",7651,"KRN",19,"NM",4,0)
-BMXMENU^^0
-"BLD",7651,"KRN",19,"NM",5,0)
-BMXRPC^^0
-"BLD",7651,"KRN",19,"NM","B","BMX MONITOR EDIT",1)
-
-"BLD",7651,"KRN",19,"NM","B","BMX MONITOR START",2)
-
-"BLD",7651,"KRN",19,"NM","B","BMX MONITOR STOP",3)
-
-"BLD",7651,"KRN",19,"NM","B","BMXMENU",4)
-
-"BLD",7651,"KRN",19,"NM","B","BMXRPC",5)
-
-"BLD",7651,"KRN",19.1,0)
-19.1
-"BLD",7651,"KRN",19.1,"NM",0)
-^9.68A^1^1
-"BLD",7651,"KRN",19.1,"NM",1,0)
-BMXZMENU^^0
-"BLD",7651,"KRN",19.1,"NM","B","BMXZMENU",1)
-
-"BLD",7651,"KRN",101,0)
-101
-"BLD",7651,"KRN",101,"NM",0)
-^9.68A^^
-"BLD",7651,"KRN",409.61,0)
-409.61
-"BLD",7651,"KRN",409.61,"NM",0)
-^9.68A^^
-"BLD",7651,"KRN",771,0)
-771
-"BLD",7651,"KRN",870,0)
-870
-"BLD",7651,"KRN",8989.51,0)
-8989.51
-"BLD",7651,"KRN",8989.51,"NM",0)
-^9.68A^^
-"BLD",7651,"KRN",8989.52,0)
-8989.52
-"BLD",7651,"KRN",8994,0)
-8994
-"BLD",7651,"KRN",8994,"NM",0)
-^9.68A^45^45
-"BLD",7651,"KRN",8994,"NM",1,0)
-BMX ADO SS^^0
-"BLD",7651,"KRN",8994,"NM",2,0)
-BMX ASYNC GET^^0
-"BLD",7651,"KRN",8994,"NM",3,0)
-BMX ASYNC QUEUE^^0
-"BLD",7651,"KRN",8994,"NM",4,0)
-BMX AV CODE^^0
-"BLD",7651,"KRN",8994,"NM",5,0)
-BMX DEMO^^0
-"BLD",7651,"KRN",8994,"NM",6,0)
-BMX DENTAL REPORT 1^^0
-"BLD",7651,"KRN",8994,"NM",7,0)
-BMX DENTAL REPORT 2^^0
-"BLD",7651,"KRN",8994,"NM",8,0)
-BMX EVENT POLL^^0
-"BLD",7651,"KRN",8994,"NM",9,0)
-BMX EVENT RAISE^^0
-"BLD",7651,"KRN",8994,"NM",10,0)
-BMX EVENT REGISTER^^0
-"BLD",7651,"KRN",8994,"NM",11,0)
-BMX EVENT UNREGISTER^^0
-"BLD",7651,"KRN",8994,"NM",12,0)
-BMX FIELD LIST^^0
-"BLD",7651,"KRN",8994,"NM",13,0)
-BMX FIND^^0
-"BLD",7651,"KRN",8994,"NM",14,0)
-BMX GET VARIABLE VALUE^^0
-"BLD",7651,"KRN",8994,"NM",15,0)
-BMX HEALTH SUMMARY^^0
-"BLD",7651,"KRN",8994,"NM",16,0)
-BMX IM HERE^^0
-"BLD",7651,"KRN",8994,"NM",17,0)
-BMX LOCK^^0
-"BLD",7651,"KRN",8994,"NM",18,0)
-BMX LOOKUP^^0
-"BLD",7651,"KRN",8994,"NM",19,0)
-BMX MULT LIST^^0
-"BLD",7651,"KRN",8994,"NM",20,0)
-BMX NTUSER^^0
-"BLD",7651,"KRN",8994,"NM",21,0)
-BMX PATIENT DEMOG DATA GET^^0
-"BLD",7651,"KRN",8994,"NM",22,0)
-BMX PDATA CHART^^0
-"BLD",7651,"KRN",8994,"NM",23,0)
-BMX SCHEMA ONLY^^0
-"BLD",7651,"KRN",8994,"NM",24,0)
-BMX SECURITY KEY^^0
-"BLD",7651,"KRN",8994,"NM",25,0)
-BMX SIGNATURE^^0
-"BLD",7651,"KRN",8994,"NM",26,0)
-BMX SQL^^0
-"BLD",7651,"KRN",8994,"NM",27,0)
-BMX SQL COLINFO^^0
-"BLD",7651,"KRN",8994,"NM",28,0)
-BMX TABLE^^0
-"BLD",7651,"KRN",8994,"NM",29,0)
-BMX TEST^^0
-"BLD",7651,"KRN",8994,"NM",30,0)
-BMX TIMER TEST^^0
-"BLD",7651,"KRN",8994,"NM",31,0)
-BMX TLIST^^0
-"BLD",7651,"KRN",8994,"NM",32,0)
-BMX UPDATE^^0
-"BLD",7651,"KRN",8994,"NM",33,0)
-BMX USER^^0
-"BLD",7651,"KRN",8994,"NM",34,0)
-BMX VERSION INFO^^0
-"BLD",7651,"KRN",8994,"NM",35,0)
-BMXGetFac^^0
-"BLD",7651,"KRN",8994,"NM",36,0)
-BMXGetFacRS^^0
-"BLD",7651,"KRN",8994,"NM",37,0)
-BMXNRC^^0
-"BLD",7651,"KRN",8994,"NM",38,0)
-BMXNetGetCodes^^0
-"BLD",7651,"KRN",8994,"NM",39,0)
-BMXNetSetUser^^0
-"BLD",7651,"KRN",8994,"NM",40,0)
-BMXPatientInfoRS^^0
-"BLD",7651,"KRN",8994,"NM",41,0)
-BMXPatientLookupRS^^0
-"BLD",7651,"KRN",8994,"NM",42,0)
-BMXProviderLookupRS^^0
-"BLD",7651,"KRN",8994,"NM",43,0)
-BMXSetFac^^0
-"BLD",7651,"KRN",8994,"NM",44,0)
-BMXUserKeyRS^^0
-"BLD",7651,"KRN",8994,"NM",45,0)
-BMX UTF-8^^0
-"BLD",7651,"KRN",8994,"NM","B","BMX ADO SS",1)
-
-"BLD",7651,"KRN",8994,"NM","B","BMX ASYNC GET",2)
-
-"BLD",7651,"KRN",8994,"NM","B","BMX ASYNC QUEUE",3)
-
-"BLD",7651,"KRN",8994,"NM","B","BMX AV CODE",4)
-
-"BLD",7651,"KRN",8994,"NM","B","BMX DEMO",5)
-
-"BLD",7651,"KRN",8994,"NM","B","BMX DENTAL REPORT 1",6)
-
-"BLD",7651,"KRN",8994,"NM","B","BMX DENTAL REPORT 2",7)
-
-"BLD",7651,"KRN",8994,"NM","B","BMX EVENT POLL",8)
-
-"BLD",7651,"KRN",8994,"NM","B","BMX EVENT RAISE",9)
-
-"BLD",7651,"KRN",8994,"NM","B","BMX EVENT REGISTER",10)
-
-"BLD",7651,"KRN",8994,"NM","B","BMX EVENT UNREGISTER",11)
-
-"BLD",7651,"KRN",8994,"NM","B","BMX FIELD LIST",12)
-
-"BLD",7651,"KRN",8994,"NM","B","BMX FIND",13)
-
-"BLD",7651,"KRN",8994,"NM","B","BMX GET VARIABLE VALUE",14)
-
-"BLD",7651,"KRN",8994,"NM","B","BMX HEALTH SUMMARY",15)
-
-"BLD",7651,"KRN",8994,"NM","B","BMX IM HERE",16)
-
-"BLD",7651,"KRN",8994,"NM","B","BMX LOCK",17)
-
-"BLD",7651,"KRN",8994,"NM","B","BMX LOOKUP",18)
-
-"BLD",7651,"KRN",8994,"NM","B","BMX MULT LIST",19)
-
-"BLD",7651,"KRN",8994,"NM","B","BMX NTUSER",20)
-
-"BLD",7651,"KRN",8994,"NM","B","BMX PATIENT DEMOG DATA GET",21)
-
-"BLD",7651,"KRN",8994,"NM","B","BMX PDATA CHART",22)
-
-"BLD",7651,"KRN",8994,"NM","B","BMX SCHEMA ONLY",23)
-
-"BLD",7651,"KRN",8994,"NM","B","BMX SECURITY KEY",24)
-
-"BLD",7651,"KRN",8994,"NM","B","BMX SIGNATURE",25)
-
-"BLD",7651,"KRN",8994,"NM","B","BMX SQL",26)
-
-"BLD",7651,"KRN",8994,"NM","B","BMX SQL COLINFO",27)
-
-"BLD",7651,"KRN",8994,"NM","B","BMX TABLE",28)
-
-"BLD",7651,"KRN",8994,"NM","B","BMX TEST",29)
-
-"BLD",7651,"KRN",8994,"NM","B","BMX TIMER TEST",30)
-
-"BLD",7651,"KRN",8994,"NM","B","BMX TLIST",31)
-
-"BLD",7651,"KRN",8994,"NM","B","BMX UPDATE",32)
-
-"BLD",7651,"KRN",8994,"NM","B","BMX USER",33)
-
-"BLD",7651,"KRN",8994,"NM","B","BMX UTF-8",45)
-
-"BLD",7651,"KRN",8994,"NM","B","BMX VERSION INFO",34)
-
-"BLD",7651,"KRN",8994,"NM","B","BMXGetFac",35)
-
-"BLD",7651,"KRN",8994,"NM","B","BMXGetFacRS",36)
-
-"BLD",7651,"KRN",8994,"NM","B","BMXNRC",37)
-
-"BLD",7651,"KRN",8994,"NM","B","BMXNetGetCodes",38)
-
-"BLD",7651,"KRN",8994,"NM","B","BMXNetSetUser",39)
-
-"BLD",7651,"KRN",8994,"NM","B","BMXPatientInfoRS",40)
-
-"BLD",7651,"KRN",8994,"NM","B","BMXPatientLookupRS",41)
-
-"BLD",7651,"KRN",8994,"NM","B","BMXProviderLookupRS",42)
-
-"BLD",7651,"KRN",8994,"NM","B","BMXSetFac",43)
-
-"BLD",7651,"KRN",8994,"NM","B","BMXUserKeyRS",44)
-
-"BLD",7651,"KRN","B",.4,.4)
-
-"BLD",7651,"KRN","B",.401,.401)
-
-"BLD",7651,"KRN","B",.402,.402)
-
-"BLD",7651,"KRN","B",.403,.403)
-
-"BLD",7651,"KRN","B",.5,.5)
-
-"BLD",7651,"KRN","B",.84,.84)
-
-"BLD",7651,"KRN","B",3.6,3.6)
-
-"BLD",7651,"KRN","B",3.8,3.8)
-
-"BLD",7651,"KRN","B",9.2,9.2)
-
-"BLD",7651,"KRN","B",9.8,9.8)
-
-"BLD",7651,"KRN","B",19,19)
-
-"BLD",7651,"KRN","B",19.1,19.1)
-
-"BLD",7651,"KRN","B",101,101)
-
-"BLD",7651,"KRN","B",409.61,409.61)
-
-"BLD",7651,"KRN","B",771,771)
-
-"BLD",7651,"KRN","B",870,870)
-
-"BLD",7651,"KRN","B",8989.51,8989.51)
-
-"BLD",7651,"KRN","B",8989.52,8989.52)
-
-"BLD",7651,"KRN","B",8994,8994)
-
-"BLD",7651,"PRE")
-BMXE01
-"BLD",7651,"QUES",0)
-^9.62^^
-"BLD",7651,"REQB",0)
-^9.611^^
-"DATA",90093.2,1,0)
-2^2^3100907.0936
-"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.2^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.2^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.2^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.2^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.2^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.2^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)
-61603,724
-"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,2502,-1)
-0^45
-"KRN",8994,2502,0)
-BMX UTF-8^UTF8^BMXRPC^1^P
-"KRN",8994,2502,1,0)
-^^4^4^3100907^
-"KRN",8994,2502,1,1,0)
-This RPC returns a single value of 1 if database supports UTF-8; 0 if 
-"KRN",8994,2502,1,2,0)
-not. Only works on GT.M.
-"KRN",8994,2502,1,3,0)
- 
-"KRN",8994,2502,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.2^3100907
-"PKG",210,22,1,1,0)
-^^14^14^3100907
-"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,"DEV")
-IHS/ITSC/HWHITT
-"PKG",210,"VERSION")
-2.2
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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^B75110422
-"RTN","BMXADOS",1,0)
-BMXADOS ; IHS/CIHA/GIS - UPDATE THE BMX ADO SCHEMA FILE ;
-"RTN","BMXADOS",2,0)
- ;;2.2;BMX;;Sep 07, 2010;Build 9
-"RTN","BMXADOS",3,0)
- ; ENABLES NAVIGATION TO SUBFILES PRIOR TO UPDATING THE SCHEMA FILE ENTRY
-"RTN","BMXADOS",4,0)
- ; 
-"RTN","BMXADOS",5,0)
- ; 
-"RTN","BMXADOS",6,0)
- ; 
-"RTN","BMXADOS",7,0)
-UPDATE ; UPDATE THE SCHEMA FILE
-"RTN","BMXADOS",8,0)
- N DIC,X,Y,%,STOP,FIEN,FNAME,SNAME,SIEN
-"RTN","BMXADOS",9,0)
-UDIC S DIC("A")="Enter schema name: " ; EP FROM VENPCCTU
-"RTN","BMXADOS",10,0)
- S DIC(0)="AEQLM",DIC="^BMXADO("
-"RTN","BMXADOS",11,0)
- D ^DIC I Y=-1 G FIN
-"RTN","BMXADOS",12,0)
-SCHEMA S SNAME=$P(Y,U,2),SIEN=+Y
-"RTN","BMXADOS",13,0)
- S FIEN=$$FILE(SIEN) I 'FIEN G FIN
-"RTN","BMXADOS",14,0)
- I FIEN'=$P($G(^BMXADO(SIEN,0)),U,2) S DIE=DIC,DA=SIEN,DR=".02////^S X=FIEN" D ^DIE
-"RTN","BMXADOS",15,0)
- F  D FLD(FIEN,SIEN) I $G(STOP) Q  ; GET FIELD INFO
-"RTN","BMXADOS",16,0)
-FIN D ^XBFMK
-"RTN","BMXADOS",17,0)
- Q
-"RTN","BMXADOS",18,0)
- ; 
-"RTN","BMXADOS",19,0)
-FLD(FIEN,SIEN) ; GET THE FIELD
-"RTN","BMXADOS",20,0)
- N DIC,X,Y,DIE,DA,DR,FLDIEN,FLDNAME,FLDTYPE,FDEF,TRANS
-"RTN","BMXADOS",21,0)
- N %,%Y,HDR,DTYPE,LEN,FARR,I,TOT,PAUSE,PFLAG,IFLAG,IMSG,STG,READ
-"RTN","BMXADOS",22,0)
- D FLIST(.FARR,FIEN,0)
-"RTN","BMXADOS",23,0)
- S TOT=$O(FARR(9999),-1) I 'TOT S STOP=1 Q
-"RTN","BMXADOS",24,0)
- W !,"Select a field from this "_$S($D(^DD(FIEN,0,"UP")):"sub-",1:"")_"file: "
-"RTN","BMXADOS",25,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",26,0)
- I $G(PAUSE)=U S STOP=1 Q
-"RTN","BMXADOS",27,0)
- I $G(PAUSE) S Y=PAUSE G FLD1
-"RTN","BMXADOS",28,0)
- S DIR(0)="NO^1:"_TOT_":",DIR("A")="Select a field from the list" K DA D ^DIR K DIR
-"RTN","BMXADOS",29,0)
- I 'Y S STOP=1 Q
-"RTN","BMXADOS",30,0)
-FLD1 S %=FARR(+Y)
-"RTN","BMXADOS",31,0)
- S FLDIEN=+$P(%,"  [",2),FLDNAME=$P(%,"  [")
-"RTN","BMXADOS",32,0)
- I $$FDEL(SIEN,FLDIEN) Q  ; FIELD DELETED
-"RTN","BMXADOS",33,0)
- S X=$$FDEF(FIEN,FLDIEN) I '$L(X)  W " ??" Q
-"RTN","BMXADOS",34,0)
- S DTYPE=$E(X),LEN=+$E(X,2,6)
-"RTN","BMXADOS",35,0)
- S DIR(0)="F^1:30",DIR("A")="Column header",DIR("B")=FLDNAME D ^DIR K DIR
-"RTN","BMXADOS",36,0)
- S HDR=Y,TRANS=0
-"RTN","BMXADOS",37,0)
- S %=$P($G(^DD(FIEN,FLDIEN,0)),U,2) ; CHECK FM DD TO SEE IF FIELD IS REQUIRED
-"RTN","BMXADOS",38,0)
- I %["R" W !,"FileMan requires a non-null value for this field" S %=2
-"RTN","BMXADOS",39,0)
- E  W !,"Is null allowed" S %=$S(FLDIEN=.01:2,1:1) D YN^DICN I %Y?1."^" Q
-"RTN","BMXADOS",40,0)
- I %=2 S TRANS=1 ; NON NULL VALUE REQUIRED TO COMPLETE THE TRANSACTION OR THERE WILL BE ROLLBACK
-"RTN","BMXADOS",41,0)
- I $G(PFLAG) D  ; IF POINTER, ASK IF USER WANTS TO AUTOMATICALLY INSERT THE LOOKUP VALUE FIELD IN THE SCHEMA
-"RTN","BMXADOS",42,0)
- . W !,"This field is a pointer value (IEN)."
-"RTN","BMXADOS",43,0)
- . W !,"Want to automatically insert the lookup value in the schema"
-"RTN","BMXADOS",44,0)
- . S %=2 D YN^DICN W ! I %=1 S PFLAG=2
-"RTN","BMXADOS",45,0)
- . Q
-"RTN","BMXADOS",46,0)
-IFLG I $G(IFLAG) D  ; NON-POINTER .01 FIELD.  ASK IF USER WANTS TO REFERENCE IDENTIFIER EP
-"RTN","BMXADOS",47,0)
- . W !,"Want to display identifiers with this field"
-"RTN","BMXADOS",48,0)
- . S %=2 D YN^DICN W ! I %'=1 Q
-"RTN","BMXADOS",49,0)
- . S IMSG="Respond with a valid entry point in the format 'TAG^ROUTINE'."
-"RTN","BMXADOS",50,0)
- . W !,"Entry Point to generate Identifiers: " R Y:$G(DTIME,60) E  Q
-"RTN","BMXADOS",51,0)
- . I Y?1."^" Q
-"RTN","BMXADOS",52,0)
- . I Y?1."?" W !,IMSG S IFLAG(0)="!" Q
-"RTN","BMXADOS",53,0)
- . I Y'?1U.7UN1"^"1U.7UN S IFLAG(0)="!" W "  ??"
-"RTN","BMXADOS",54,0)
- . I $L(Y)>2 S IFLAG(0)=Y,IFLAG=2
-"RTN","BMXADOS",55,0)
- . Q
-"RTN","BMXADOS",56,0)
- I $G(IFLAG(0))="!" W !,IMSG K IPFLAG(0),IMSG W !!! G IFLG
-"RTN","BMXADOS",57,0)
- S DA(1)=SIEN,DIC="^BMXADO("_DA(1)_",1,"
-"RTN","BMXADOS",58,0)
- S DIC("P")=90093.991,DIC(0)="L",X=FLDIEN
-"RTN","BMXADOS",59,0)
- I '$D(^BMXADO(SIEN,1,0)) S ^BMXADO(SIEN,1,0)="^90093.991^^"
-"RTN","BMXADOS",60,0)
- D ^DIC I Y=-1 Q
-"RTN","BMXADOS",61,0)
- S READ=($P($G(^DD(FIEN,FLDIEN,0)),U,2)["C") ; COMPUTED FIELDS ARE READ ONLY!
-"RTN","BMXADOS",62,0)
- S DIE=DIC,DA=+Y
-"RTN","BMXADOS",63,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",64,0)
- D ^DIE
-"RTN","BMXADOS",65,0)
- I $G(IFLAG)=2 D ID
-"RTN","BMXADOS",66,0)
- I $G(PFLAG)'=2 Q
-"RTN","BMXADOS",67,0)
-LKUP ; AUTOMATICALLY ADD A LOOKUP FIELD TO THE SCHEMA
-"RTN","BMXADOS",68,0)
- S X=FLDIEN_"IEN"
-"RTN","BMXADOS",69,0)
- D ^DIC I Y=-1 Q
-"RTN","BMXADOS",70,0)
- W !,"The LOOKUP field '"_X_"' has been added to the schema",!
-"RTN","BMXADOS",71,0)
- S HDR=HDR_"_IEN",DTYPE="I",LEN="00009"
-"RTN","BMXADOS",72,0)
- S DIE=DIC,DA=+Y
-"RTN","BMXADOS",73,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",74,0)
- D ^DIE
-"RTN","BMXADOS",75,0)
- Q
-"RTN","BMXADOS",76,0)
- ; 
-"RTN","BMXADOS",77,0)
-ID ; AUTOMATICALLY ADD AN IDENTIFIER REFERENCE
-"RTN","BMXADOS",78,0)
- N X,Y,DIE,DR,DA,REF
-"RTN","BMXADOS",79,0)
- S X=".01ID",DA(1)=SIEN
-"RTN","BMXADOS",80,0)
- S REF=IFLAG(0) I '$L(REF) Q
-"RTN","BMXADOS",81,0)
- D ^DIC I Y=-1 Q
-"RTN","BMXADOS",82,0)
- W !,"The identifier field '"_X_"' has been added to the schema",!
-"RTN","BMXADOS",83,0)
- S HDR=HDR_"_ID",DTYPE="T",LEN="00017"
-"RTN","BMXADOS",84,0)
- S DIE=DIC,DA=+Y
-"RTN","BMXADOS",85,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",86,0)
- D ^DIE
-"RTN","BMXADOS",87,0)
- Q
-"RTN","BMXADOS",88,0)
- ; 
-"RTN","BMXADOS",89,0)
-FDEL(SIEN,FIELD) ; DELETE AN EXISTING ENTRY FROM THE 'FIELD' MULTIPLE.  RETURN '1' IF THE RECORD WAS DELETED
-"RTN","BMXADOS",90,0)
- N FIEN,DA,DIK
-"RTN","BMXADOS",91,0)
- S FIEN=$O(^BMXADO(SIEN,1,"B",FIELD,0)) I 'FIEN Q 0  ; THIS IS A NEW ENTRY
-"RTN","BMXADOS",92,0)
- W !,"This field already is attached to the schema.  Want to delete it"
-"RTN","BMXADOS",93,0)
- S %=2 D YN^DICN
-"RTN","BMXADOS",94,0)
- I %'=1 Q 0
-"RTN","BMXADOS",95,0)
- S DA(1)=SIEN,DIK="^BMXADO("_DA(1)_",1,",DA=FIEN
-"RTN","BMXADOS",96,0)
- D ^DIK
-"RTN","BMXADOS",97,0)
- S FIEN=$O(^BMXADO(SIEN,1,"B",(FIELD_"IEN"),0))
-"RTN","BMXADOS",98,0)
- I FIEN S DA=FIEN D ^DIK ; DELETE LOOKUP VALUE FIELD AS WELL
-"RTN","BMXADOS",99,0)
- W " Done!",!
-"RTN","BMXADOS",100,0)
- Q 1
-"RTN","BMXADOS",101,0)
- ; 
-"RTN","BMXADOS",102,0)
-FDEF(FILE,FIELD) ;EP - GIVEN A FILEMAN FILE AND FIELD, RETURN THE DATA DEFINITION IN ADO FORMAT
-"RTN","BMXADOS",103,0)
- N %,X,Y,Z,STG,I,DTYPE,FNAME,LEN,DNAME
-"RTN","BMXADOS",104,0)
- I '$D(^DD(+$G(FILE),+$G(FIELD),0)) Q ""
-"RTN","BMXADOS",105,0)
- S STG=$G(^DD(FILE,FIELD,0)) I '$L(STG) Q "" ; GET DATA DEF STRING
-"RTN","BMXADOS",106,0)
-DTYPE S %="DNSFWCPVM",X=$P(STG,U,2),DTYPE="" ; GET DATA TYPE
-"RTN","BMXADOS",107,0)
- F I=1:1:$L(%) S Y=$E(%,I) I X[Y S DTYPE=Y Q
-"RTN","BMXADOS",108,0)
- I DTYPE="" Q ""
-"RTN","BMXADOS",109,0)
-FNAME S DNAME=$P(STG,U) I '$L(DNAME) Q "" ; FIELD NAME
-"RTN","BMXADOS",110,0)
-DDA ; ADO FORMAT
-"RTN","BMXADOS",111,0)
- I DTYPE="D" D  Q "D"_LEN_DNAME
-"RTN","BMXADOS",112,0)
- . S LEN="00021"
-"RTN","BMXADOS",113,0)
- . I STG["S %DT=" S %=$P(STG,"S %DT=",2),%=$P(%,$C(34))
-"RTN","BMXADOS",114,0)
- . I $G(FLDIEN)=.01 S IFLAG=1
-"RTN","BMXADOS",115,0)
- . I %["S" S LEN="00019" Q
-"RTN","BMXADOS",116,0)
- . I %["T" S LEN="00018" Q
-"RTN","BMXADOS",117,0)
- . Q
-"RTN","BMXADOS",118,0)
- I DTYPE="N",STG["1N.N" D  Q:'LEN "" Q "I"_LEN_DNAME ; INTEGER
-"RTN","BMXADOS",119,0)
- . S %=+$P(STG,"K:+X'=X!(X>",2)
-"RTN","BMXADOS",120,0)
- . S Y=$L(%)
-"RTN","BMXADOS",121,0)
- . S LEN=$E("00000",1,5-$L(Y))_Y
-"RTN","BMXADOS",122,0)
- . Q
-"RTN","BMXADOS",123,0)
- I DTYPE="N" D  Q:'LEN ""  Q "N"_LEN_DNAME ; NUMBER (COULD HAVE A DECIMAL VALUE)
-"RTN","BMXADOS",124,0)
- . S %=+$P(STG,"!(X?.E1"".""",2)
-"RTN","BMXADOS",125,0)
- . S X=+$P(STG,"K:+X'=X!(X>",2)
-"RTN","BMXADOS",126,0)
- . S Y=%+($L(+X))
-"RTN","BMXADOS",127,0)
- . S LEN=$E("00000",1,5-$L(Y))_Y
-"RTN","BMXADOS",128,0)
- . Q
-"RTN","BMXADOS",129,0)
- I DTYPE="F" D  Q:'LEN "" Q "T"_LEN_DNAME
-"RTN","BMXADOS",130,0)
- . S Y=+$P(STG,"K:$L(X)>",2)
-"RTN","BMXADOS",131,0)
- . S LEN=$E("00000",1,5-$L(Y))_Y
-"RTN","BMXADOS",132,0)
- . I 'LEN S LEN="00030"
-"RTN","BMXADOS",133,0)
- . I $G(FLDIEN)=.01 S IFLAG=1
-"RTN","BMXADOS",134,0)
- . Q
-"RTN","BMXADOS",135,0)
- I DTYPE="S" D  Q:'LEN "" Q "T"_LEN_DNAME
-"RTN","BMXADOS",136,0)
- . S X=$P(STG,U,3),Y=0
-"RTN","BMXADOS",137,0)
- . F I=1:1:$L(X,":") S Z=$P(X,":",2),Z=$P(Z,";"),%=$L(Z) I %>Y S Y=%
-"RTN","BMXADOS",138,0)
- . S LEN=$E("00000",1,5-$L(Y))_Y
-"RTN","BMXADOS",139,0)
- . Q
-"RTN","BMXADOS",140,0)
- I DTYPE="P" S PFLAG=1 Q "T00030"_DNAME
-"RTN","BMXADOS",141,0)
- I DTYPE="W" Q "T05000"_DNAME
-"RTN","BMXADOS",142,0)
- I DTYPE="V" Q ""
-"RTN","BMXADOS",143,0)
- Q "T00250"_DNAME
-"RTN","BMXADOS",144,0)
- ; 
-"RTN","BMXADOS",145,0)
-FILE(SIEN) ; GET THE FILE OR SUBFILE NUMBER
-"RTN","BMXADOS",146,0)
- N FNO,FIEN,DIC,X,Y,%,FILE,NSTG,GBL,FNAME,SUB,FARR,TOT,I
-"RTN","BMXADOS",147,0)
- S (FILE,FNO)=$P(^BMXADO(SIEN,0),U,2)
-"RTN","BMXADOS",148,0)
-OLD I FNO D  I $G(FIEN) Q FIEN
-"RTN","BMXADOS",149,0)
- . S NSTG=$O(^DD(FNO,0,"NM",""))
-"RTN","BMXADOS",150,0)
- . F  S FNO=$G(^DD(FNO,0,"UP")) Q:'FNO  S NSTG=$O(^DD(FNO,0,"NM",""))_"/"_NSTG
-"RTN","BMXADOS",151,0)
-OLD1 . W !,$S(NSTG["/":"Sub-",1:""),"File #",FILE," (",NSTG,") is linked to this schema."
-"RTN","BMXADOS",152,0)
- . W !,"Want to keep it" S %=1
-"RTN","BMXADOS",153,0)
- . D YN^DICN I %'=2 W:%=1 " OK" S FIEN=FILE Q
-"RTN","BMXADOS",154,0)
- . W !!,"If you change or delete this file number,",!,"all the information in this schema will be deleted."
-"RTN","BMXADOS",155,0)
- . W !,"Are you sure you want to do this" S %=2 D YN^DICN
-"RTN","BMXADOS",156,0)
- . I %'=1 W !! G OLD1
-"RTN","BMXADOS",157,0)
- . S GBL="^BMXADO("_SIEN_")"
-"RTN","BMXADOS",158,0)
- . K @GBL@(1),@GBL@(2)
-"RTN","BMXADOS",159,0)
- . S $P(@GBL@(0),U,2)=""
-"RTN","BMXADOS",160,0)
- . W !,"This schema definition has been deleted.  You may redefine it now"
-"RTN","BMXADOS",161,0)
- . Q
-"RTN","BMXADOS",162,0)
-NEW S DIC=1,DIC(0)="AEQM" D ^DIC I Y=-1 Q ""
-"RTN","BMXADOS",163,0)
- S FNO=+Y,FNAME=$P(Y,U,2)
-"RTN","BMXADOS",164,0)
-NEW1 D SC(.FARR,FNO,1)
-"RTN","BMXADOS",165,0)
- S TOT=$O(FARR(999999),-1) I 'TOT Q FNO ; NO SUBFILES FOUND
-"RTN","BMXADOS",166,0)
- W !!,"The ",FNAME," file contains the following sub-file" I TOT>1 W "s"
-"RTN","BMXADOS",167,0)
- W !
-"RTN","BMXADOS",168,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",169,0)
- I $G(PAUSE)=U Q ""
-"RTN","BMXADOS",170,0)
- I $G(PAUSE) S Y=PAUSE G NEW2
-"RTN","BMXADOS",171,0)
- W !!,"Is the schema linked to a sub-file in this list"
-"RTN","BMXADOS",172,0)
- S %=2 D YN^DICN I %=2 Q FNO
-"RTN","BMXADOS",173,0)
- S DIR(0)="NO^1:"_TOT_":",DIR("A")="Select a sub-file from the list" K DA D ^DIR K DIR
-"RTN","BMXADOS",174,0)
- I 'Y Q ""
-"RTN","BMXADOS",175,0)
-NEW2 Q +$P(FARR(+Y),"  (",2)
-"RTN","BMXADOS",176,0)
- ; 
-"RTN","BMXADOS",177,0)
-PAUSE(I) ; SCROLL CHECK
-"RTN","BMXADOS",178,0)
- N %
-"RTN","BMXADOS",179,0)
- W !
-"RTN","BMXADOS",180,0)
- I (I#20) Q ""
-"RTN","BMXADOS",181,0)
- W "Select a number from the list (1-",(I-1),") or press <ENTER> to continue: "
-"RTN","BMXADOS",182,0)
- R %:$G(DTIME,60) E  Q ""
-"RTN","BMXADOS",183,0)
- I %?1."^" Q U
-"RTN","BMXADOS",184,0)
- I $L(%),$D(FARR(I)) Q %
-"RTN","BMXADOS",185,0)
- I $L(%) W " ??" H 2
-"RTN","BMXADOS",186,0)
- W $C(13),?79,$C(13)
-"RTN","BMXADOS",187,0)
- Q ""
-"RTN","BMXADOS",188,0)
- ; 
-"RTN","BMXADOS",189,0)
-SC(OUT,FILE,MODE) ;EP - SUB CRAWLER.  GIVEN A FILE NUMBER RETURN ALL OF ITS DESCENDANT FILES IN AN ARRAY
-"RTN","BMXADOS",190,0)
- I '$D(^DD(FILE,"SB")) Q  ; NO DESCENDANTS
-"RTN","BMXADOS",191,0)
- N TOT,FNO,FNAME,FIEN,LEVEL,NODE,SARR,STG,X,%,UP,ARR
-"RTN","BMXADOS",192,0)
- S FIEN=FILE,TOT=0
-"RTN","BMXADOS",193,0)
- D PASS1
-"RTN","BMXADOS",194,0)
- I '$O(ARR(0)) Q
-"RTN","BMXADOS",195,0)
-SC2 ; SECOND PASS. BUILD THE INTERMEDIATE ARRAY
-"RTN","BMXADOS",196,0)
- S FNO=0 F  S FNO=$O(ARR(FNO)) Q:'FNO  D
-"RTN","BMXADOS",197,0)
- . I $P($G(^DD(FNO,.01,0)),U,2)["W" K ARR(FNO) Q  ; WORD PROCESSING FIELDS DO NOT COUNT
-"RTN","BMXADOS",198,0)
- . S STG=FNO,UP=FNO
-"RTN","BMXADOS",199,0)
- . F  S UP=$G(^DD(UP,0,"UP")) Q:'UP  S STG=UP_","_STG ; BUILD DESCENDANT STRING
-"RTN","BMXADOS",200,0)
- . I $G(MODE) S STG=$$ASTG(STG)
-"RTN","BMXADOS",201,0)
- . S STG=$P(STG,",",2,99) ; DONT NEED TOP LEVEL FILE
-"RTN","BMXADOS",202,0)
- . I '$L(STG) Q  ; SOMETHING IS SCREWED UP
-"RTN","BMXADOS",203,0)
- . S LEVEL=$L(STG,",")
-"RTN","BMXADOS",204,0)
- . S FNAME=$O(^DD(FNO,0,"NM",""))
-"RTN","BMXADOS",205,0)
- . S X="SARR("_STG_")"
-"RTN","BMXADOS",206,0)
- . S @X=FNAME_U_LEVEL_U_FNO
-"RTN","BMXADOS",207,0)
- . K ARR(FNO)
-"RTN","BMXADOS",208,0)
- . Q
-"RTN","BMXADOS",209,0)
-SC3 ; 3RD PASS.  BUILD OUTPUT ARAY
-"RTN","BMXADOS",210,0)
- S NODE="SARR"
-"RTN","BMXADOS",211,0)
- F  S NODE=$Q(@NODE) Q:NODE=""  D
-"RTN","BMXADOS",212,0)
- . S X=@NODE
-"RTN","BMXADOS",213,0)
- . S TOT=TOT+1
-"RTN","BMXADOS",214,0)
- . S FNAME=$P(X,U)
-"RTN","BMXADOS",215,0)
- . S LEVEL=$P(X,U,2)
-"RTN","BMXADOS",216,0)
- . S FNO=$P(X,U,3)
-"RTN","BMXADOS",217,0)
- . S OUT(TOT)=$E("          ",1,LEVEL)_FNAME_"  ("_FNO_")"
-"RTN","BMXADOS",218,0)
- . Q
-"RTN","BMXADOS",219,0)
- Q
-"RTN","BMXADOS",220,0)
- ;
-"RTN","BMXADOS",221,0)
-PASS1 ; PASS 1.  BUILD THE ARRAY OF ALL SUBFILES
-"RTN","BMXADOS",222,0)
- N FNO S FNO=0
-"RTN","BMXADOS",223,0)
- F  S FNO=$O(^DD(FIEN,"SB",FNO)) Q:'FNO  D
-"RTN","BMXADOS",224,0)
- . S ARR(FNO)=""
-"RTN","BMXADOS",225,0)
- . I '$D(^DD(FNO,"SB")) Q
-"RTN","BMXADOS",226,0)
- . N FIEN S FIEN=FNO
-"RTN","BMXADOS",227,0)
- . D PASS1 ; RECURSION!!
-"RTN","BMXADOS",228,0)
- . Q
-"RTN","BMXADOS",229,0)
- Q
-"RTN","BMXADOS",230,0)
- ; 
-"RTN","BMXADOS",231,0)
-ASTG(STG) ; CONVERT STRING FROM FILE NUMBERS TO FILE NAMES
-"RTN","BMXADOS",232,0)
- N PCE,LEV,FNO,NAME
-"RTN","BMXADOS",233,0)
- S LEV=$L(STG,",")
-"RTN","BMXADOS",234,0)
- F PCE=1:1:LEV S FNO=+$P(STG,",",PCE) D  I '$L(STG) Q ""
-"RTN","BMXADOS",235,0)
- . S NAME=$O(^DD(FNO,0,"NM",""))
-"RTN","BMXADOS",236,0)
- . I $E(NAME)="*" S NAME=$E(NAME,2,99)
-"RTN","BMXADOS",237,0)
- . I '$L(NAME) S STG="" Q
-"RTN","BMXADOS",238,0)
- . S $P(STG,",",PCE)=""""_NAME_""""
-"RTN","BMXADOS",239,0)
- . Q
-"RTN","BMXADOS",240,0)
- Q STG
-"RTN","BMXADOS",241,0)
- ;
-"RTN","BMXADOS",242,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",243,0)
- ; ONLY NON MULTIPLES AND WORD PROCESSING FIELDS ARE LISTED
-"RTN","BMXADOS",244,0)
- N FLD,TOT,NAME,ARR,SS,%,WP
-"RTN","BMXADOS",245,0)
- S FLD=0,TOT=0
-"RTN","BMXADOS",246,0)
-F1 F  S FLD=$O(^DD(FILE,FLD)) Q:'FLD  D  ; PASS 1
-"RTN","BMXADOS",247,0)
- . S STG=$G(^DD(FILE,FLD,0)) I '$L(STG) Q
-"RTN","BMXADOS",248,0)
- . S %=$P(STG,U,2)
-"RTN","BMXADOS",249,0)
- . I %,$P($G(^DD(%,.01,0)),U,2)'["W" Q  ; EXCLUDE ALL MULTIPLE FIELDS EXCEPT WORD PROCESSING FIELDS
-"RTN","BMXADOS",250,0)
- . S WP=0 I % S WP=1
-"RTN","BMXADOS",251,0)
- . S NAME=$P(STG,U)
-"RTN","BMXADOS",252,0)
- . S SS=FLD
-"RTN","BMXADOS",253,0)
- . I $G(MODE)=1 S %=NAME S:$E(%)="*" %=$E(%,2,99) S SS=%
-"RTN","BMXADOS",254,0)
- . S ARR(SS)=FLD_U_NAME_U_WP
-"RTN","BMXADOS",255,0)
- . Q
-"RTN","BMXADOS",256,0)
-F2 S SS=""
-"RTN","BMXADOS",257,0)
- F  S SS=$O(ARR(SS)) Q:SS=""  D
-"RTN","BMXADOS",258,0)
- . S TOT=TOT+1
-"RTN","BMXADOS",259,0)
- . S %=ARR(SS)
-"RTN","BMXADOS",260,0)
- . S OUT(TOT)=$P(%,U,2)_"  ["_+%_"]"_$S($P(%,U,3):"  (word processing)",1:"")
-"RTN","BMXADOS",261,0)
- . K ARR(SS)
-"RTN","BMXADOS",262,0)
- . Q
-"RTN","BMXADOS",263,0)
- Q
-"RTN","BMXADOS",264,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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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^B68620559
-"RTN","BMXADOV1",1,0)
-BMXADOV1 ; IHS/CIHA/GIS - RPC CALL: GENERATE DATA FOR AN ADO DATASET ;
-"RTN","BMXADOV1",2,0)
- ;;2.2;BMX;;Sep 07, 2010;Build 9
-"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)
- ; 
-"RTN","BMXADOV1",8,0)
- ;
-"RTN","BMXADOV1",9,0)
-DATA(IENS,DA,XCNT) ;EP - ADD DATA NODES TO ARRAY
-"RTN","BMXADOV1",10,0)
- ; ASSUMES THAT VSTG VARIABLES AND THE OUT ARRAY ARE PRESENT
-"RTN","BMXADOV1",11,0)
- I '$G(DA) Q
-"RTN","BMXADOV1",12,0)
- I '$L(IENS) Q
-"RTN","BMXADOV1",13,0)
- S $P(IENS,C)=DA
-"RTN","BMXADOV1",14,0)
- N STG,X,Y,%,FLD,STOP,VAL,CNT,FIEN,LINE,IFLAG,IDEP,TFLD,TNO,TEF
-"RTN","BMXADOV1",15,0)
- S STG=DA
-"RTN","BMXADOV1",16,0)
- I $G(DAS),$E(DAS,$L(DAS))="," S STG=$TR(DAS,",",U)_STG ; FIX FOR SUBFILE
-"RTN","BMXADOV1",17,0)
- S CNT=$L(IENS,",") ; START AFTER THE .001 FIELD
-"RTN","BMXADOV1",18,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",19,0)
- I $G(XCNT) S CNT=XCNT ; USED WITH JOINS
-"RTN","BMXADOV1",20,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",21,0)
- . K IFLAG,IDEP
-"RTN","BMXADOV1",22,0)
- . S FIEN=+@OUT@(CNT) I '$D(^DD(FIEN,0)) S STOP=1 Q
-"RTN","BMXADOV1",23,0)
- . S FLD=$P(@OUT@(CNT),B,2)
-"RTN","BMXADOV1",24,0)
- . I FLD=".01ID" D  Q  ; PROCESS THE IDENTIFIER FIELD
-"RTN","BMXADOV1",25,0)
- .. I '$G(SIEN) Q
-"RTN","BMXADOV1",26,0)
- .. S %=$O(^BMXADO(SIEN,1,"B",".01ID",0)) I '% Q
-"RTN","BMXADOV1",27,0)
- .. S IDEP=$G(^BMXADO(SIEN,1,%,1)) I '$L(IDEP) Q
-"RTN","BMXADOV1",28,0)
- .. X ("S VAL=$$"_IDEP_"("_+STG_")") ; PASS THE DA TO THE IDENTIFIER EXTRINSIC FUNCTION, RETURN IDENTIFIERS
-"RTN","BMXADOV1",29,0)
- .. S VAL=$TR(VAL,"^",""),VAL=$TR(VAL,B,"")
-"RTN","BMXADOV1",30,0)
- .. S STG=STG_U_VAL
-"RTN","BMXADOV1",31,0)
- .. Q
-"RTN","BMXADOV1",32,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",33,0)
- . K TFLD
-"RTN","BMXADOV1",34,0)
- . I FLD["TRIGGER" S TFLD=FLD,FLD=+FLD,IFLAG=1
-"RTN","BMXADOV1",35,0)
- . I FLD["IEN" S FLD=+FLD,IFLAG=1 ; LOOKUP VALUE FIELD (IEN)
-"RTN","BMXADOV1",36,0)
- . I '$D(^DD(FIEN,FLD,0)),FLD'=.001 S STOP=1 Q
-"RTN","BMXADOV1",37,0)
- . I $D(TFLD),FLD=.001 S VAL=+IENS
-"RTN","BMXADOV1",38,0)
- . E  S VAL=$$GET1^DIQ(FIEN,IENS,FLD,$S($G(IFLAG):"I",$G(TFLAG):"I",1:$G(FMT)))
-"RTN","BMXADOV1",39,0)
- . I $G(TFLD) D  S STG=STG_U_VAL Q  ; GENERATE A TRIGGERED VALUE FOR THIS FIELD
-"RTN","BMXADOV1",40,0)
- .. S TNO=$O(^BMXADO(SIEN,1,"B",TFLD,0)) I 'TNO S VAL="" Q
-"RTN","BMXADOV1",41,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",42,0)
- .. X ("S VAL=$$"_TEF_"(VAL)")
-"RTN","BMXADOV1",43,0)
- .. Q
-"RTN","BMXADOV1",44,0)
- . I FLD=.01,VAL="" S STOP=1 Q  ; INVALID FILEMAN ENTRY!  SKIP IT
-"RTN","BMXADOV1",45,0)
- . S VAL=$TR(VAL,"^",""),VAL=$TR(VAL,B,"")
-"RTN","BMXADOV1",46,0)
- . S STG=STG_U_VAL
-"RTN","BMXADOV1",47,0)
- . Q
-"RTN","BMXADOV1",48,0)
- I $G(STOP) Q  ; DON'T ADD NODE IF DD INFO IS INVALID
-"RTN","BMXADOV1",49,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",50,0)
- . S TOT=TOT+1
-"RTN","BMXADOV1",51,0)
- . I '$L(STG) S LINE=LINE_$C(30),NUM=NUM+1 ; END OF RECORD, RECORD TOTAL IS UPDATED
-"RTN","BMXADOV1",52,0)
- . S @OUT@(TOT)=LINE ; NODE IS ADDED
-"RTN","BMXADOV1",53,0)
- . Q
-"RTN","BMXADOV1",54,0)
- Q
-"RTN","BMXADOV1",55,0)
- ; 
-"RTN","BMXADOV1",56,0)
-NUMIT(DA) ; EP-ITERATE BY NUMBER
-"RTN","BMXADOV1",57,0)
- N XIT,LDA
-"RTN","BMXADOV1",58,0)
- I IENS S DA=+IENS ; RE-ENTRY FROM SEED
-"RTN","BMXADOV1",59,0)
- I '$G(DA),$G(START) S DA=START-1
-"RTN","BMXADOV1",60,0)
- I '$G(DA) S DA=0
-"RTN","BMXADOV1",61,0)
- S LDA=""
-"RTN","BMXADOV1",62,0)
- F  S DA=$O(@CREF@(DA)) D  I $G(XIT) Q
-"RTN","BMXADOV1",63,0)
- . I 'DA S XIT=1,LDA="" Q  ; NO MORE IENS - THE END OF THE LINE
-"RTN","BMXADOV1",64,0)
- . D DATA(IENS,DA,+$G(XCNT))
-"RTN","BMXADOV1",65,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",66,0)
- . I NUM=MAX S LDA=DA,XIT=1 Q  ; REACHED THE MAX TRANSACTION LIMIT - GET MORE NEXT TIME
-"RTN","BMXADOV1",67,0)
- . Q
-"RTN","BMXADOV1",68,0)
- I LDA,'$O(@CREF@(LDA)) S LDA="" ; END OF THE LINE SO SET LDA TO NULL
-"RTN","BMXADOV1",69,0)
- Q LDA
-"RTN","BMXADOV1",70,0)
- ; 
-"RTN","BMXADOV1",71,0)
-LOOK(LIEN) ; EP-ITERATE BY A SINGLE STANDARD INDEX THAT IS A POINTER VALUE
-"RTN","BMXADOV1",72,0)
- N XIT,LDA
-"RTN","BMXADOV1",73,0)
- S DA=+IENS
-"RTN","BMXADOV1",74,0)
- F  S DA=$O(@CREF@(IX,LIEN,DA)) D  I $G(XIT) Q
-"RTN","BMXADOV1",75,0)
- . I 'DA S XIT=1,LDA="" Q  ; NO MORE IENS - THE END OF THE LINE
-"RTN","BMXADOV1",76,0)
- . D DATA(IENS,DA,$G(XCNT))
-"RTN","BMXADOV1",77,0)
- . I NUM=MAX S LDA=DA,XIT=1 Q  ; REACHED THE MAX TRANSACTION LIMIT - GET MORE NEXT TIME
-"RTN","BMXADOV1",78,0)
- . Q
-"RTN","BMXADOV1",79,0)
- I '$O(@CREF@(IX,LIEN,DA)) Q ""
-"RTN","BMXADOV1",80,0)
- Q LDA
-"RTN","BMXADOV1",81,0)
- ;
-"RTN","BMXADOV1",82,0)
-LOOK1() ; EP-ITERATE USING A STANDARD INDEX
-"RTN","BMXADOV1",83,0)
- N XIT,LDA,VAL,DA,%
-"RTN","BMXADOV1",84,0)
- S DA=+IENS I 'DA G SCRATCH ; CHECK FOR RE-RENTRY
-"RTN","BMXADOV1",85,0)
-REENTER ; RE-ENTER STD ITERATION USING DA AS THE SEED
-"RTN","BMXADOV1",86,0)
- S %=$$IXVAL(FIEN,IX,DAS) I '$L(%) Q "" ; GET STARTUP INFO
-"RTN","BMXADOV1",87,0)
-LR S VAL=$P(%,B,3)
-"RTN","BMXADOV1",88,0)
- I VAL="" Q "" ; NO VAL FOUND FOR INITIAL ITERATION, SO QUIT
-"RTN","BMXADOV1",89,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",90,0)
- I $G(XIT) Q:'$O(@CREF@(IX,VAL,LDA)) "" Q LDA ; IF NO MORE AFTER MAX, SET LDA = NULL
-"RTN","BMXADOV1",91,0)
- G LOOK1R ; SEED IS DEFINED
-"RTN","BMXADOV1",92,0)
-SCRATCH S VAL="" ; STD LOOKUP STARTING FROM SCRATCH
-"RTN","BMXADOV1",93,0)
- I $L(START) S VAL=$O(@CREF@(IX,START),-1) ; GET SEED FOR ITERATION
-"RTN","BMXADOV1",94,0)
-LOOK1R F  S VAL=$O(@CREF@(IX,VAL)) D  I $G(XIT) Q  ; EP - RE-ENTRY POINT IF SEED IS DEFINED
-"RTN","BMXADOV1",95,0)
- . I VAL="" S LDA="",XIT=1 Q  ; END OF THE LINE
-"RTN","BMXADOV1",96,0)
- . I STOP=+STOP,VAL=+VAL,VAL>STOP S LDA="",XIT=1 Q
-"RTN","BMXADOV1",97,0)
- . I $L(STOP),VAL]STOP S LDA="",XIT=1 Q  ; LOOKUP LIMITS
-"RTN","BMXADOV1",98,0)
- . S DA=0
-"RTN","BMXADOV1",99,0)
- . F  S DA=$O(@CREF@(IX,VAL,DA)) Q:'DA  D  I $G(XIT) Q
-"RTN","BMXADOV1",100,0)
- .. D DATA(IENS,DA,+$G(XCNT))
-"RTN","BMXADOV1",101,0)
- .. I NUM=MAX S LDA=DA,XIT=1 D  ; TRANSACTION LIMIT ; CHECK FOR MORE
-"RTN","BMXADOV1",102,0)
- ... I $O(@CREF@(IX,VAL,DA)) Q
-"RTN","BMXADOV1",103,0)
- ... S %=$O(@CREF@(IX,VAL)) I %="" S LDA="" Q
-"RTN","BMXADOV1",104,0)
- ... I $L(STOP),%]STOP S LDA="" Q
-"RTN","BMXADOV1",105,0)
- ... I '$O(@CREF@(IX,%,0)) S LDA="" Q
-"RTN","BMXADOV1",106,0)
- ... Q
-"RTN","BMXADOV1",107,0)
- .. Q
-"RTN","BMXADOV1",108,0)
- . Q
-"RTN","BMXADOV1",109,0)
- Q LDA
-"RTN","BMXADOV1",110,0)
- ;
-"RTN","BMXADOV1",111,0)
-LOOK2(LFILE) ; EP-TEXT POINTER LOOKUP
-"RTN","BMXADOV1",112,0)
- ; CHANGE THE GLOBAL REFERENCE FOR THE LOOKUP TO THE POINTED-TO FILE BEFORE PROCEEDING
-"RTN","BMXADOV1",113,0)
- N XIT,LDA,OREF,CREF,VAL,DA
-"RTN","BMXADOV1",114,0)
- S OREF=$$ROOT^DILFD(LFILE,IENS) I '$L(OREF) Q ""
-"RTN","BMXADOV1",115,0)
- S CREF=$$CREF^DILF(OREF) I '$L(CREF) Q ""
-"RTN","BMXADOV1",116,0)
- S DA=+IENS
-"RTN","BMXADOV1",117,0)
- I '$G(DA) G SCRATCH ; START FROM SCRATCH
-"RTN","BMXADOV1",118,0)
- S %=$$IXVAL(LFILE,IX,DAS) I '$L(%) Q ""
-"RTN","BMXADOV1",119,0)
- G LR ; RE-ENTER
-"RTN","BMXADOV1",120,0)
- ;
-"RTN","BMXADOV1",121,0)
-IXVAL(FIEN,IX,DAS) ; GIVEN A FILE IEN, INDEX NAME, AND DAS STRING, RETURN THE VALUE USED IN THE INDEX
-"RTN","BMXADOV1",122,0)
- N DA,FLD,IENS,OREF,CREF,XREF,VAL,UP,LEV,L
-"RTN","BMXADOV1",123,0)
- I '$D(^DD(+$G(FIEN),0)) Q "" ; MISSING OR INVALID FILE NUMBER
-"RTN","BMXADOV1",124,0)
- I '$L($G(IX)) Q "" ; NO INDEX SPECIFIED
-"RTN","BMXADOV1",125,0)
- S UP=FIEN F LEV=1:1 S UP=$G(^DD(UP,0,"UP")) Q:'UP
-"RTN","BMXADOV1",126,0)
- I LEV'=$L(DAS,C) Q "" ; DAS LEVELS MUST MATCH FILE OR SUBFILE LEVEL
-"RTN","BMXADOV1",127,0)
- S IENS=$$IENS^BMXADOV($G(DAS)) I IENS=U Q ""
-"RTN","BMXADOV1",128,0)
- S OREF=$$ROOT^DILFD(FIEN,IENS) I '$L(OREF) Q ""
-"RTN","BMXADOV1",129,0)
- S CREF=$$CREF^DILF(OREF) I '$L(CREF) Q ""
-"RTN","BMXADOV1",130,0)
- I '$D(@CREF@(IX)) Q CREF_"||" ; NO INDEX VALUES TO CHECK
-"RTN","BMXADOV1",131,0)
- S XREF=OREF_IX_")"
-"RTN","BMXADOV1",132,0)
- S DA=+IENS I 'DA Q CREF_"||"
-"RTN","BMXADOV1",133,0)
- I '$D(@CREF@(DA)) Q CREF_"||" ; NO ENTRY EXISTS
-"RTN","BMXADOV1",134,0)
- I IX="AA" G AA
-"RTN","BMXADOV1",135,0)
- S FLD=+$$IXFLD^BMXADOV(FIEN,IX) I 'FLD Q "" ; INVALID DD
-"RTN","BMXADOV1",136,0)
- S VAL=$$GET1^DIQ(FIEN,IENS,FLD,"I") I VAL="" Q "" ; VALUE IS NULL - NOTHING TO INDEX
-"RTN","BMXADOV1",137,0)
- I '$D(@CREF@(IX,VAL,DA)) Q "" ; INVALID INDEX
-"RTN","BMXADOV1",138,0)
- Q XREF_B_DA_B_VAL
-"RTN","BMXADOV1",139,0)
- ;
-"RTN","BMXADOV1",140,0)
-AA() ;EP - VISIT/V-FILE ITERATION USING THE 'AA' INDEX
-"RTN","BMXADOV1",141,0)
- N LDA,XIT,AAINFO,DA,%,X,Y,DFN,TYPE,ORD,ISTART,ISTOP,IDT,AAREF,%DT,DIC
-"RTN","BMXADOV1",142,0)
- S X=OREF_"""AA"")",%=$Q(@X) I %="" Q ""
-"RTN","BMXADOV1",143,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",144,0)
- I $E(TYPE)="`" S TYPE=$E(TYPE,2,99) I 'TYPE Q "" ; REMOVE ` FROM TYPE IEN
-"RTN","BMXADOV1",145,0)
- I $L(TYPE),'TYPE D  I TYPE'>0 Q "" ; QUIT IF INVALID TYPE
-"RTN","BMXADOV1",146,0)
- . S %=$P($G(^DD(FIEN,.01,0)),U,2)
-"RTN","BMXADOV1",147,0)
- . S DIC=+$P(%,"P",2) I '$D(^DD(DIC,.01,0)) Q
-"RTN","BMXADOV1",148,0)
- . S X=TYPE,DIC(0)="M" D ^DIC I Y=-1 Q
-"RTN","BMXADOV1",149,0)
- . S TYPE=+Y
-"RTN","BMXADOV1",150,0)
- . Q
-"RTN","BMXADOV1",151,0)
- S DFN=+PARAM
-"RTN","BMXADOV1",152,0)
- I '$D(^DPT(DFN,0)) Q "" ; PATIENT DFN MUST BE DEFINED
-"RTN","BMXADOV1",153,0)
- I 'TYPE S AAREF=OREF_"""AA"","_DFN_")"
-"RTN","BMXADOV1",154,0)
- E  S AAREF=OREF_"""AA"","_DFN_","_TYPE_")"
-"RTN","BMXADOV1",155,0)
- I '$D(@AAREF) Q "" ; IF NOTHING UNDER AA INDEX, DON'T BOTHER LOOKING
-"RTN","BMXADOV1",156,0)
- S ISTART=9999999 I START S X=START,%DT="P" D ^%DT S ISTART=9999999-Y
-"RTN","BMXADOV1",157,0)
- S ISTOP=0 I STOP S X=STOP,%DT="P" D ^%DT S ISTOP=9999999-Y
-"RTN","BMXADOV1",158,0)
- S ORD=-1 I $P(PARAM,B,$L(PARAM,B))="R" S ORD=1 ; SORT IN CHRONOLOGICAL OR REVERSE CHRONOLOGICAL ORDER
-"RTN","BMXADOV1",159,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",160,0)
- S IDT=0,LDA=""
-"RTN","BMXADOV1",161,0)
- I ISTOP S IDT=ISTOP-.0000001
-"RTN","BMXADOV1",162,0)
- S DA=+IENS
-"RTN","BMXADOV1",163,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",164,0)
- F  S IDT=$O(@AAREF@(IDT),ORD) Q:'IDT  D  I $G(XIT) Q
-"RTN","BMXADOV1",165,0)
- . I ORD=1,IDT>ISTART S LDA="",XIT=1 Q
-"RTN","BMXADOV1",166,0)
- . I ORD=-1,IDT<ISTART S LDA="",XIT=1 Q
-"RTN","BMXADOV1",167,0)
- . S DA=0
-"RTN","BMXADOV1",168,0)
- . F  S DA=$O(@AAREF@(IDT,DA)) Q:'DA  D  I $G(XIT) Q
-"RTN","BMXADOV1",169,0)
- .. D DATA(IENS,DA,+$G(XCNT))
-"RTN","BMXADOV1",170,0)
- .. I NUM=MAX S LDA=DA,XIT=1 I '$$AAMORE S LDA="" ; TRANSACTION LIMIT
-"RTN","BMXADOV1",171,0)
- .. Q
-"RTN","BMXADOV1",172,0)
- . Q
-"RTN","BMXADOV1",173,0)
- Q LDA
-"RTN","BMXADOV1",174,0)
- ; 
-"RTN","BMXADOV1",175,0)
-AAR() ; SWEEP UP REMAINING IENS FOR CURRENT IDT AND RESET IDT FOR RE-ENTRY
-"RTN","BMXADOV1",176,0)
- N %,X,Y,XIT
-"RTN","BMXADOV1",177,0)
- S %=$$AAVAL(FIEN,DAS) I '$L(%) Q ""
-"RTN","BMXADOV1",178,0)
- S IDT=$P(%,B,5) I 'IDT Q ""
-"RTN","BMXADOV1",179,0)
- F  S DA=$O(@AAREF@(IDT,DA)) Q:'DA  D  I $G(XIT) Q
-"RTN","BMXADOV1",180,0)
- . D DATA(IENS,DA,+$G(XCNT))
-"RTN","BMXADOV1",181,0)
- . I NUM=MAX S LDA=DA,IDT="",XIT="" I '$$AAMORE S LDA=""
-"RTN","BMXADOV1",182,0)
- . Q
-"RTN","BMXADOV1",183,0)
- Q IDT
-"RTN","BMXADOV1",184,0)
- ; 
-"RTN","BMXADOV1",185,0)
-AAMORE() ; RETURN A '1' IF MORE ITERATION IS POSSIBLE
-"RTN","BMXADOV1",186,0)
- N X
-"RTN","BMXADOV1",187,0)
- I $O(@AAREF@(IDT,DA)) Q 1
-"RTN","BMXADOV1",188,0)
- S X=$O(@AAREF@(IDT),ORD) I 'X Q 0
-"RTN","BMXADOV1",189,0)
- I $O(@AAREF@(X,0)) Q 1
-"RTN","BMXADOV1",190,0)
- Q 0
-"RTN","BMXADOV1",191,0)
- ; 
-"RTN","BMXADOV1",192,0)
-AAVAL(FIEN,DAS) ; GIVEN A FILE AND DAS, RETURN INFO NECESSARY TO RE-CREATE THE 'AA' INDEX
-"RTN","BMXADOV1",193,0)
- N DATE,IDT,DFN,TYPE,VIEN,%,OREF,CREF,DA,IENS
-"RTN","BMXADOV1",194,0)
- I '$D(^DD(FIEN,.01,0)) Q ""
-"RTN","BMXADOV1",195,0)
- S IENS=$$IENS^BMXADOV($G(DAS)) I IENS=U Q ""
-"RTN","BMXADOV1",196,0)
- S OREF=$$ROOT^DILFD(FIEN,IENS) I '$L(OREF) Q ""
-"RTN","BMXADOV1",197,0)
- S CREF=$$CREF^DILF(OREF) I '$L(CREF) Q ""
-"RTN","BMXADOV1",198,0)
- S DA=+IENS I '$D(@CREF@(DA)) Q ""
-"RTN","BMXADOV1",199,0)
- I FIEN=9000010 S DFN=$P(@CREF@(DA,0),U,5),VIEN=DA
-"RTN","BMXADOV1",200,0)
- E  S DFN=$P(@CREF@(DA,0),U,2),VIEN=$P(@CREF@(DA,0),U,3)
-"RTN","BMXADOV1",201,0)
- I $D(^DPT(DFN,0)),$D(^AUPNVSIT(VIEN,0))
-"RTN","BMXADOV1",202,0)
- E  Q ""
-"RTN","BMXADOV1",203,0)
- S DATE=+$P($G(^AUPNVSIT(VIEN,0)),U) I 'DATE Q ""
-"RTN","BMXADOV1",204,0)
- S IDT=(9999999-(DATE\1))
-"RTN","BMXADOV1",205,0)
- S %=$P(DATE,".",2) I % S IDT=+(IDT_"."_%) I 'IDT Q ""
-"RTN","BMXADOV1",206,0)
- S X=OREF_"""AA"")",%=$Q(@X) I %="" Q ""
-"RTN","BMXADOV1",207,0)
- S TYPE="" I $L(%,C)=5 S TYPE=$P(@CREF@(DA,0),U)
-"RTN","BMXADOV1",208,0)
- Q X_B_DA_B_DFN_B_TYPE_B_IDT
-"RTN","BMXADOV1",209,0)
- ; 
-"RTN","BMXADOV1",210,0)
-AAP() ;EP - ITERATOR FOR PROBLEM FILE: AA INDEX
-"RTN","BMXADOV1",211,0)
- I '$D(^AUPNPROB("AA",+$G(START))) Q ""
-"RTN","BMXADOV1",212,0)
- N LOC,PNUM,DFN,IEN
-"RTN","BMXADOV1",213,0)
- S LOC=0,DFN=START
-"RTN","BMXADOV1",214,0)
- F  S LOC=$O(^AUPNPROB("AA",DFN,LOC)) Q:'LOC  D
-"RTN","BMXADOV1",215,0)
- . S PNUM=""
-"RTN","BMXADOV1",216,0)
- . F  S PNUM=$O(^AUPNPROB("AA",DFN,LOC,PNUM)) Q:PNUM=""  D
-"RTN","BMXADOV1",217,0)
- .. S IEN=0
-"RTN","BMXADOV1",218,0)
- .. F  S IEN=$O(^AUPNPROB("AA",DFN,LOC,PNUM,IEN)) Q:'IEN  D DATA(",",IEN,+$G(XCNT))
-"RTN","BMXADOV1",219,0)
- .. Q
-"RTN","BMXADOV1",220,0)
- .Q
-"RTN","BMXADOV1",221,0)
- Q ""
-"RTN","BMXADOV1",222,0)
- ; 
-"RTN","BMXADOV1",223,0)
-TESTID(DA) ; TEST IDENTIFIERS
-"RTN","BMXADOV1",224,0)
- N %,Y,SEX
-"RTN","BMXADOV1",225,0)
- S %=$G(^DIZ(2160010,+$G(DA),0)) I '$L(%) Q ""
-"RTN","BMXADOV1",226,0)
- S SEX=$P(%,U,2) I '$L(SEX) S SEX="??"
-"RTN","BMXADOV1",227,0)
- S Y=$P(%,U,3) X ^DD("DD")
-"RTN","BMXADOV1",228,0)
- Q (SEX_"   "_Y)
-"RTN","BMXADOV1",229,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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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^B125616041
-"RTN","BMXMON",1,0)
-BMXMON ; IHS/OIT/HMW - BMXNet MONITOR ; 7/20/2009 ; 9/7/10 7:47am
-"RTN","BMXMON",2,0)
- ;;2.2;BMX;;Sep 07, 2010;Build 9
-"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/2009: 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)
- ;
-"RTN","BMXMON",14,0)
-STRT(BMXPORT,NS,IS,VB) ;EP
-"RTN","BMXMON",15,0)
- ;Interactive monitor start
-"RTN","BMXMON",16,0)
- ;Optional NS = namespace.  If undefined, start in current ns
-"RTN","BMXMON",17,0)
- ;Optional IS = Integrated Security.  Default is 1
-"RTN","BMXMON",18,0)
- ;Optional VB = Verbose. Default is 1
-"RTN","BMXMON",19,0)
- ;
-"RTN","BMXMON",20,0)
- N Y,BMXNS,BMXWIN
-"RTN","BMXMON",21,0)
- ;
-"RTN","BMXMON",22,0)
- ;Verbose
-"RTN","BMXMON",23,0)
- S BMXVB=$G(VB,1)
-"RTN","BMXMON",24,0)
- ;
-"RTN","BMXMON",25,0)
- ;Check if port already running
-"RTN","BMXMON",26,0)
- I '$$SEMAPHOR(BMXPORT,"LOCK") W:BMXVB "BMXNet Monitor on port "_BMXPORT_" appears to be running already.",! Q
-"RTN","BMXMON",27,0)
- S %=$$SEMAPHOR(BMXPORT,"UNLOCK")
-"RTN","BMXMON",28,0)
- ;
-"RTN","BMXMON",29,0)
- D MARKER(BMXPORT,1) ;record problem marker
-"RTN","BMXMON",30,0)
- ; -- start the monitor
-"RTN","BMXMON",31,0)
- ;
-"RTN","BMXMON",32,0)
- ;Namespace
-"RTN","BMXMON",33,0)
- X ^%ZOSF("UCI")
-"RTN","BMXMON",34,0)
- S BMXNS=$G(NS,$P(Y,","))
-"RTN","BMXMON",35,0)
- ;
-"RTN","BMXMON",36,0)
- ;Integrated security
-"RTN","BMXMON",37,0)
- S BMXWIN=$G(IS,1)
-"RTN","BMXMON",38,0)
- ;
-"RTN","BMXMON",39,0)
- ;J DEBUG^%Serenji("MON^BMXMON("_BMXPORT_","_BMXNS_","_BMXWIN_")")
-"RTN","BMXMON",40,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",41,0)
- F %=1:1:5 D  Q:%=0
-"RTN","BMXMON",42,0)
- . W:BMXVB "Checking if BMXNet Monitor has started...",!
-"RTN","BMXMON",43,0)
- . H 1
-"RTN","BMXMON",44,0)
- . S:'$$MARKER(BMXPORT,0) %=0
-"RTN","BMXMON",45,0)
- I $$MARKER(BMXPORT,0) D
-"RTN","BMXMON",46,0)
- . W:BMXVB !,"BMXNet Monitor could not be started!",!
-"RTN","BMXMON",47,0)
- . W:BMXVB "Check if port "_BMXPORT_" is busy on this CPU.",!
-"RTN","BMXMON",48,0)
- . D MARKER(BMXPORT,-1) ;clear marker
-"RTN","BMXMON",49,0)
- E  W:BMXVB "BMXNet Monitor started successfully."
-"RTN","BMXMON",50,0)
- ;
-"RTN","BMXMON",51,0)
- Q
-"RTN","BMXMON",52,0)
- ;
-"RTN","BMXMON",53,0)
-RESTART ;EP
-"RTN","BMXMON",54,0)
- ;Stop and Start all monitors in BMX MONITOR file
-"RTN","BMXMON",55,0)
- ;Called by option BMX MONITOR START
-"RTN","BMXMON",56,0)
- ;
-"RTN","BMXMON",57,0)
- D STOPALL
-"RTN","BMXMON",58,0)
- D STRTALL
-"RTN","BMXMON",59,0)
- Q
-"RTN","BMXMON",60,0)
- ;
-"RTN","BMXMON",61,0)
-STRTALL ;EP
-"RTN","BMXMON",62,0)
- ;Start all monitors in BMX MONITOR file
-"RTN","BMXMON",63,0)
- ;
-"RTN","BMXMON",64,0)
- N BMXIEN
-"RTN","BMXMON",65,0)
- S BMXIEN=0 F  S BMXIEN=$O(^BMXMON(BMXIEN)) Q:'+BMXIEN  D
-"RTN","BMXMON",66,0)
- . S BMXNOD=$G(^BMXMON(BMXIEN,0))
-"RTN","BMXMON",67,0)
- . Q:'+BMXNOD
-"RTN","BMXMON",68,0)
- . Q:'+$P(BMXNOD,U,2)
-"RTN","BMXMON",69,0)
- . S BMXWIN=$P(BMXNOD,U,3)
-"RTN","BMXMON",70,0)
- . S BMXNS=$P(BMXNOD,U,4)
-"RTN","BMXMON",71,0)
- . D STRT($P(BMXNOD,U),BMXNS,BMXWIN,0)
-"RTN","BMXMON",72,0)
- . Q
-"RTN","BMXMON",73,0)
- Q
-"RTN","BMXMON",74,0)
- ;
-"RTN","BMXMON",75,0)
-STOPALL ;EP
-"RTN","BMXMON",76,0)
- ;Stop all monitors in BMXNET MONITOR file
-"RTN","BMXMON",77,0)
- ;
-"RTN","BMXMON",78,0)
- N BMXIEN,BMXPORT
-"RTN","BMXMON",79,0)
- S BMXIEN=0 F  S BMXIEN=$O(^BMXMON(BMXIEN)) Q:'+BMXIEN  D
-"RTN","BMXMON",80,0)
- . S BMXNOD=$G(^BMXMON(BMXIEN,0))
-"RTN","BMXMON",81,0)
- . Q:'+BMXNOD
-"RTN","BMXMON",82,0)
- . S BMXPORT=+BMXNOD
-"RTN","BMXMON",83,0)
- . D STOP(BMXPORT,0)
-"RTN","BMXMON",84,0)
- Q
-"RTN","BMXMON",85,0)
- ;
-"RTN","BMXMON",86,0)
-STOP(BMXPORT,VB) ;EP Stop monitor on BMXPORT
-"RTN","BMXMON",87,0)
- ;Open a channel to monitor on BMXPORT and send shutdown request
-"RTN","BMXMON",88,0)
- ;Optional VB = Verbose. Default is 1
-"RTN","BMXMON",89,0)
- ;
-"RTN","BMXMON",90,0)
- N IP,REF,X,DEV
-"RTN","BMXMON",91,0)
- S U="^" D HOME^%ZIS
-"RTN","BMXMON",92,0)
- ;
-"RTN","BMXMON",93,0)
- ;Verbose
-"RTN","BMXMON",94,0)
- S BMXVB=$G(VB,1)
-"RTN","BMXMON",95,0)
- ;
-"RTN","BMXMON",96,0)
- D:BMXVB EN^DDIOL("Stop BMXNet Monitor...")
-"RTN","BMXMON",97,0)
- X ^%ZOSF("UCI") S REF=Y
-"RTN","BMXMON",98,0)
- S IP="0.0.0.0" ;get server IP
-"RTN","BMXMON",99,0)
- IF $G(BMXPORT)="" S BMXPORT=9200
-"RTN","BMXMON",100,0)
- ; -- make sure the listener is running
-"RTN","BMXMON",101,0)
- I $$SEMAPHOR(BMXPORT,"LOCK") D  Q
-"RTN","BMXMON",102,0)
- . S %=$$SEMAPHOR(BMXPORT,"UNLOCK")
-"RTN","BMXMON",103,0)
- . D:BMXVB EN^DDIOL("BMXNet Monitor does not appear to be running.")
-"RTN","BMXMON",104,0)
- ; -- send the shutdown message to the TCP Listener process
-"RTN","BMXMON",105,0)
- D CALL^%ZISTCP("127.0.0.1",BMXPORT) I POP D  Q
-"RTN","BMXMON",106,0)
- . S %=$$SEMAPHOR(BMXPORT,"UNLOCK")
-"RTN","BMXMON",107,0)
- . D:BMXVB EN^DDIOL("BMXNet Monitor does not appear to be running.")
-"RTN","BMXMON",108,0)
- U IO
-"RTN","BMXMON",109,0)
- S X=$T(+2),X=$P(X,";;",2),X=$P(X,";")
-"RTN","BMXMON",110,0)
- IF X="" S X=0
-"RTN","BMXMON",111,0)
- S X=$C($L(X))_X
-"RTN","BMXMON",112,0)
- W "{BMX}00011TCPshutdown",!
-"RTN","BMXMON",113,0)
- R X#3:5
-"RTN","BMXMON",114,0)
- D CLOSE^%ZISTCP
-"RTN","BMXMON",115,0)
- I X="ack" D:BMXVB EN^DDIOL("BMXNet Monitor has been shutdown.")
-"RTN","BMXMON",116,0)
- E  D:BMXVB EN^DDIOL("Shutdown Failed!")
-"RTN","BMXMON",117,0)
- ;change process name
-"RTN","BMXMON",118,0)
- D CHPRN($J)
-"RTN","BMXMON",119,0)
- Q
-"RTN","BMXMON",120,0)
- ;
-"RTN","BMXMON",121,0)
-MON(BMXPORT,NS,IS) ;Monitor port for connection & shutdown requests
-"RTN","BMXMON",122,0)
- ;NS = Namespace to Start monitor
-"RTN","BMXMON",123,0)
- ;IS = 1: Enable integrated security
-"RTN","BMXMON",124,0)
- ;
-"RTN","BMXMON",125,0)
- N BMXDEV,BMXQUIT,BMXDTIME,BMXLEN,BMXACT,BMXWIN,BMXNS
-"RTN","BMXMON",126,0)
- S BMXQUIT=0,BMXDTIME=999999
-"RTN","BMXMON",127,0)
- ;
-"RTN","BMXMON",128,0)
- ;Set lock
-"RTN","BMXMON",129,0)
- Q:'$$SEMAPHOR(BMXPORT,"LOCK")
-"RTN","BMXMON",130,0)
- ;Clear problem marker
-"RTN","BMXMON",131,0)
- D MARKER(BMXPORT,-1)
-"RTN","BMXMON",132,0)
- ;H 1
-"RTN","BMXMON",133,0)
- ;
-"RTN","BMXMON",134,0)
- ;Namespace
-"RTN","BMXMON",135,0)
- X ^%ZOSF("UCI")
-"RTN","BMXMON",136,0)
- S BMXNS=$G(NS,$P(Y,","))
-"RTN","BMXMON",137,0)
- ;
-"RTN","BMXMON",138,0)
- ;Integrated security
-"RTN","BMXMON",139,0)
- S BMXWIN=$G(IS,1)
-"RTN","BMXMON",140,0)
- ;
-"RTN","BMXMON",141,0)
- ;Open server port; 
-"RTN","BMXMON",142,0)
- S BMXDEV="|TCP|"_BMXPORT
-"RTN","BMXMON",143,0)
- C BMXDEV ;IHS/OIT/HMW SAC Exemption Applied For
-"RTN","BMXMON",144,0)
- O BMXDEV:(:BMXPORT:"S"):5 I '$T Q  ;IHS/OIT/HMW SAC Exemption Applied For
-"RTN","BMXMON",145,0)
- ;
-"RTN","BMXMON",146,0)
- ;S BMXDTIME(1)=BMXDTIME ; TODO: Set timeouts
-"RTN","BMXMON",147,0)
- S BMXDTIME(1)=.5 ;HMW 20050120
-"RTN","BMXMON",148,0)
- U BMXDEV
-"RTN","BMXMON",149,0)
- F  D  Q:BMXQUIT
-"RTN","BMXMON",150,0)
- . R BMXACT#5:BMXDTIME ;Read first 5 chars from TCP buffer, timeout=BMXDTIME
-"RTN","BMXMON",151,0)
- . I BMXACT'="{BMX}" S BMXQUIT=1 Q
-"RTN","BMXMON",152,0)
- . R BMXACT#5:BMXDTIME ;Read next 5 chars - message length
-"RTN","BMXMON",153,0)
- . S BMXLEN=+BMXACT
-"RTN","BMXMON",154,0)
- . R BMXACT#BMXLEN:BMXDTIME
-"RTN","BMXMON",155,0)
- . I $P(BMXACT,"^")="TCPconnect" D  Q
-"RTN","BMXMON",156,0)
- . . ;IHS/OIT/HMW added validity check for namespace
-"RTN","BMXMON",157,0)
- . . N BMXNSJ,X,Y
-"RTN","BMXMON",158,0)
- . . S BMXNSJ=$P(BMXACT,"^",2) ;Namespace
-"RTN","BMXMON",159,0)
- . . S BMXNSJ=$P(BMXNSJ,",")
-"RTN","BMXMON",160,0)
- . . ;if passed in namespace is invalid, new job will start in listener namespace
-"RTN","BMXMON",161,0)
- . . I BMXNSJ]"" S X=BMXNSJ X ^%ZOSF("UCICHECK") S:Y=0 BMXNSJ=BMXNS
-"RTN","BMXMON",162,0)
- . . ;Job another MONITOR using concurrent connection
-"RTN","BMXMON",163,0)
- . . ;J DEBUG^%Serenji("SESSION^BMXMON("_BMXWIN_")"):(:5:BMXDEV:BMXDEV):5
-"RTN","BMXMON",164,0)
- . . ;J SESSION^BMXMON(BMXWIN)[$P(BMXNS,",")]:(:5:BMXDEV:BMXDEV):5 ;IHS/OIT/HMW SAC Exemption Applied For
-"RTN","BMXMON",165,0)
- . . J SESSION^BMXMON(BMXWIN)[BMXNSJ]:(:5:BMXDEV:BMXDEV):5 ;IHS/OIT/HMW SAC Exemption Applied For
-"RTN","BMXMON",166,0)
- . I $P(BMXACT,"^")="TCPshutdown" S BMXQUIT=1 W "ack",!
-"RTN","BMXMON",167,0)
- S %=$$SEMAPHOR(BMXPORT,"UNLOCK") ; destroy 'running flag'
-"RTN","BMXMON",168,0)
- Q
-"RTN","BMXMON",169,0)
- ;
-"RTN","BMXMON",170,0)
-XINETD ;PEP Directly from xinetd or inetd for GT.M
-"RTN","BMXMON",171,0)
- N BMXDEV
-"RTN","BMXMON",172,0)
- S U="^",$ETRAP="D ^%ZTER H" ;Set up the error trap
-"RTN","BMXMON",173,0)
- S $ZT="" ;Clear old trap
-"RTN","BMXMON",174,0)
- ; GT.M specific error and device code
-"RTN","BMXMON",175,0)
- S @("$ZINTERRUPT=""I $$JOBEXAM^ZU($ZPOSITION)""")
-"RTN","BMXMON",176,0)
- S BMXDEV=$P X "U BMXDEV:(nowrap:nodelimiter:ioerror=""TRAP"")"
-"RTN","BMXMON",177,0)
- S %="",@("%=$ZTRNLNM(""REMOTE_HOST"")") S:$L(%) IO("GTM-IP")=%
-"RTN","BMXMON",178,0)
- I %["::ffff:" S IO("GTM-IP")=$P(%,"::ffff:",2) ; IPv6 support
-"RTN","BMXMON",179,0)
- ; Read message type
-"RTN","BMXMON",180,0)
- N BMXACT,BMXDTIME
-"RTN","BMXMON",181,0)
- S BMXDTIME=10  ; change in 2.2 instead of 9999999 - initial conn timout
-"RTN","BMXMON",182,0)
- R BMXACT#5:BMXDTIME
-"RTN","BMXMON",183,0)
- Q:BMXACT'="{BMX}"  ; Not a BMX message - quit.
-"RTN","BMXMON",184,0)
- ; Fall through to below...
-"RTN","BMXMON",185,0)
-GTMLNX ;EP from XWBTCPM for GT.M
-"RTN","BMXMON",186,0)
- ; not implementing NS and integrated authentication
-"RTN","BMXMON",187,0)
- ; Vars: Read timeout, msg len, msg, windows auth, Namespace
-"RTN","BMXMON",188,0)
- N BMXDTIME,BMXLEN,BMXACT,BMXWIN,BMXNS
-"RTN","BMXMON",189,0)
- S BMXNSJ="",BMXWIN=0  ; No NS on GT.M, no Windows Authentication
-"RTN","BMXMON",190,0)
- S BMXDTIME(1)=.5,BMXDTIME=180  ; sign on timeout
-"RTN","BMXMON",191,0)
- R BMXACT#5:BMXDTIME ;Read next 5 chars - message length
-"RTN","BMXMON",192,0)
- S BMXLEN=+BMXACT
-"RTN","BMXMON",193,0)
- R BMXACT#BMXLEN:BMXDTIME
-"RTN","BMXMON",194,0)
- I $P(BMXACT,"^")="TCPconnect" G SESSRES
-"RTN","BMXMON",195,0)
- I $P(BMXACT,"^")="TCPshutdown" W "ack",! Q
-"RTN","BMXMON",196,0)
- Q  ; Should't hit this quit, but just in case
-"RTN","BMXMON",197,0)
- ;
-"RTN","BMXMON",198,0)
-SESSION(BMXWIN) ;EP
-"RTN","BMXMON",199,0)
- ;Start session monitor
-"RTN","BMXMON",200,0)
- ;BMXWIN = 1: Enable integrated security
-"RTN","BMXMON",201,0)
-SESSRES ;EP - reentry point from trap
-"RTN","BMXMON",202,0)
- ;IHS/OIT/HMW SAC Exemption Applied For
-"RTN","BMXMON",203,0)
- S BMXDTIME(1)=.5,BMXDTIME=$$BAT^XUPARAM  ; new in 2.2: Use kernel rpc timeout instead of 9999999
-"RTN","BMXMON",204,0)
-    D SETNM^%ZOSV("BMX:ip"_$P(IO("GTM-IP"),".",3,4)) ; new in 2.2: set proces name
-"RTN","BMXMON",205,0)
- N $ESTACK S $ETRAP="D ETRAP^BMXMON"
-"RTN","BMXMON",206,0)
- S DIQUIET=1,U="^" D DT^DICRW
-"RTN","BMXMON",207,0)
- D UNREGALL^BMXMEVN ;Unregister all events for this session
-"RTN","BMXMON",208,0)
- U $P D SESSMAIN
-"RTN","BMXMON",209,0)
- ;Turn off the error trap for the exit
-"RTN","BMXMON",210,0)
- S $ETRAP=""
-"RTN","BMXMON",211,0)
- I $G(DUZ) D LOGOUT^XUSRB
-"RTN","BMXMON",212,0)
- K BMXR,BMXARY
-"RTN","BMXMON",213,0)
- C $P ;IHS/OIT/HMW SAC Exemption Applied For
-"RTN","BMXMON",214,0)
- Q
-"RTN","BMXMON",215,0)
- ;
-"RTN","BMXMON",216,0)
-SESSMAIN ;
-"RTN","BMXMON",217,0)
- N BMXTBUF
-"RTN","BMXMON",218,0)
- D SETUP^BMXMSEC(.RET) ;Setup required system vars
-"RTN","BMXMON",219,0)
- S U="^"
-"RTN","BMXMON",220,0)
- U $P
-"RTN","BMXMON",221,0)
- F  D  Q:BMXTBUF="#BYE#"
-"RTN","BMXMON",222,0)
- . R BMXTBUF#11:BMXDTIME IF '$T D TIMEOUT S BMXTBUF="#BYE#" Q
-"RTN","BMXMON",223,0)
- . I BMXTBUF["XQKEY" S HWMP=1
-"RTN","BMXMON",224,0)
- . I BMXTBUF="#BYE#" Q
-"RTN","BMXMON",225,0)
- . S BMXHTYPE=$S($E(BMXTBUF,1,5)="{BMX}":1,1:0)  ;check HDR
-"RTN","BMXMON",226,0)
- . I 'BMXHTYPE S BMXTBUF="#BYE#" D SNDERR W BMXTBUF,$C(4),! Q
-"RTN","BMXMON",227,0)
- . S BMXTLEN=$E(BMXTBUF,6,10),L=$E(BMXTBUF,11,11)
-"RTN","BMXMON",228,0)
- . R BMXTBUF#4:BMXDTIME(1) S BMXTBUF=L_BMXTBUF
-"RTN","BMXMON",229,0)
- . S BMXPLEN=BMXTBUF
-"RTN","BMXMON",230,0)
- . R BMXTBUF#BMXPLEN:BMXDTIME(1)
-"RTN","BMXMON",231,0)
- . I $P(BMXTBUF,U)="TCPconnect" D  Q
-"RTN","BMXMON",232,0)
- . . D SNDERR W "accept",$C(4),!  ;Ack
-"RTN","BMXMON",233,0)
- . IF BMXHTYPE D
-"RTN","BMXMON",234,0)
- . . K BMXR,BMXARY
-"RTN","BMXMON",235,0)
- . . IF BMXTBUF="#BYE#" D SNDERR W "#BYE#",$C(4),! Q
-"RTN","BMXMON",236,0)
- . . S BMXTLEN=BMXTLEN-15
-"RTN","BMXMON",237,0)
- . . D CALLP^BMXMBRK(.BMXR,BMXTBUF)
-"RTN","BMXMON",238,0)
- . . S BMXPTYPE=$S('$D(BMXPTYPE):1,BMXPTYPE<1:1,BMXPTYPE>6:1,1:BMXPTYPE)
-"RTN","BMXMON",239,0)
- . IF BMXTBUF="#BYE#" Q
-"RTN","BMXMON",240,0)
- . U $P
-"RTN","BMXMON",241,0)
- . D SNDERR ;Clears SNDERR parameters
-"RTN","BMXMON",242,0)
- . D SND
-"RTN","BMXMON",243,0)
- . D WRITE($C(4)) W ! ;send eot and flush buffer
-"RTN","BMXMON",244,0)
- D UNREGALL^BMXMEVN ;Unregister all events for this session
-"RTN","BMXMON",245,0)
- Q  ;End Of Main
-"RTN","BMXMON",246,0)
- ;
-"RTN","BMXMON",247,0)
-SNDERR ;send error information
-"RTN","BMXMON",248,0)
- ;BMXSEC is the security packet, BMXERROR is application packet
-"RTN","BMXMON",249,0)
- N X
-"RTN","BMXMON",250,0)
- S X=$E($G(BMXSEC),1,255)
-"RTN","BMXMON",251,0)
- W $C($L(X))_X W !
-"RTN","BMXMON",252,0)
- S X=$E($G(BMXERROR),1,255)
-"RTN","BMXMON",253,0)
- W $C($L(X))_X W !
-"RTN","BMXMON",254,0)
- S BMXERROR="",BMXSEC="" ;clears parameters
-"RTN","BMXMON",255,0)
- Q
-"RTN","BMXMON",256,0)
- ;
-"RTN","BMXMON",257,0)
-WRITE(BMXSTR) ;Write a data string
-"RTN","BMXMON",258,0)
- ;
-"RTN","BMXMON",259,0)
- I $L(BMXSTR)<511 W ! W BMXSTR Q
-"RTN","BMXMON",260,0)
- ;Handle a long string
-"RTN","BMXMON",261,0)
- W ! ;Flush the buffer
-"RTN","BMXMON",262,0)
- F  Q:'$L(BMXSTR)  W $E(BMXSTR,1,510),! S BMXSTR=$E(BMXSTR,511,99999)
-"RTN","BMXMON",263,0)
- Q
-"RTN","BMXMON",264,0)
-SND ; -- send data for all, Let WRITE sort it out
-"RTN","BMXMON",265,0)
- N I,T
-"RTN","BMXMON",266,0)
- ;
-"RTN","BMXMON",267,0)
- ; -- error or abort occurred, send null
-"RTN","BMXMON",268,0)
- IF $L(BMXSEC)>0 D WRITE("") Q
-"RTN","BMXMON",269,0)
- ; -- single value
-"RTN","BMXMON",270,0)
- IF BMXPTYPE=1 S BMXR=$G(BMXR) D WRITE(BMXR) Q
-"RTN","BMXMON",271,0)
- ; -- table delimited by CR+LF
-"RTN","BMXMON",272,0)
- IF BMXPTYPE=2 D  Q
-"RTN","BMXMON",273,0)
- . S I="" F  S I=$O(BMXR(I)) Q:I=""  D WRITE(BMXR(I)),WRITE($C(13,10))
-"RTN","BMXMON",274,0)
- ; -- word processing
-"RTN","BMXMON",275,0)
- IF BMXPTYPE=3 D  Q
-"RTN","BMXMON",276,0)
- . S I="" F  S I=$O(BMXR(I)) Q:I=""  D WRITE(BMXR(I)) D:BMXWRAP WRITE($C(13,10))
-"RTN","BMXMON",277,0)
- ; -- global array
-"RTN","BMXMON",278,0)
- IF BMXPTYPE=4 D  Q
-"RTN","BMXMON",279,0)
- . S I=$G(BMXR) Q:I=""  S T=$E(I,1,$L(I)-1) D:$D(@I)>10 WRITE(@I)
-"RTN","BMXMON",280,0)
- . F  S I=$Q(@I) Q:I=""!(I'[T)  W ! W @I W:BMXWRAP&(@I'=$C(13,10)) $C(13,10)
-"RTN","BMXMON",281,0)
- . IF $D(@BMXR) K @BMXR
-"RTN","BMXMON",282,0)
- ; -- global instance
-"RTN","BMXMON",283,0)
- IF BMXPTYPE=5 S BMXR=$G(@BMXR) D WRITE(BMXR) Q
-"RTN","BMXMON",284,0)
- ; -- variable length records only good upto 255 char)
-"RTN","BMXMON",285,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",286,0)
- Q
-"RTN","BMXMON",287,0)
- ;
-"RTN","BMXMON",288,0)
-TIMEOUT ;Do this on MAIN  loop timeout
-"RTN","BMXMON",289,0)
- I $G(DUZ)>0 D SNDERR,WRITE("#BYE#"_$C(4)) Q
-"RTN","BMXMON",290,0)
- ;Sign-on timeout
-"RTN","BMXMON",291,0)
- S BMXR(0)=0,BMXR(1)=1,BMXR(2)="",BMXR(3)="TIME-OUT",BMXPTYPE=2
-"RTN","BMXMON",292,0)
- D SNDERR,SND,WRITE($C(4))
-"RTN","BMXMON",293,0)
- Q
-"RTN","BMXMON",294,0)
- ;
-"RTN","BMXMON",295,0)
-SEMAPHOR(BMXTSKT,BMXACT) ;Lock/Unlock BMXMON semaphore
-"RTN","BMXMON",296,0)
- N RESULT
-"RTN","BMXMON",297,0)
- S U="^",RESULT=1
-"RTN","BMXMON",298,0)
- D GETENV^%ZOSV ;get Y=UCI^VOL^NODE^BOXLOOKUP of current system
-"RTN","BMXMON",299,0)
- I BMXACT="LOCK" D
-"RTN","BMXMON",300,0)
- . L +^BMXMON("BMXMON",$P(Y,U,2),$P(Y,U),$P(Y,U,4),BMXTSKT):1
-"RTN","BMXMON",301,0)
- . S RESULT=$T
-"RTN","BMXMON",302,0)
- E  L -^BMXMON("BMXMON",$P(Y,U,2),$P(Y,U),$P(Y,U,4),BMXTSKT)
-"RTN","BMXMON",303,0)
- Q RESULT
-"RTN","BMXMON",304,0)
- ;
-"RTN","BMXMON",305,0)
-CHPRN(N) ;Change process name to N.
-"RTN","BMXMON",306,0)
- D SETNM^%ZOSV($E(N,1,15))
-"RTN","BMXMON",307,0)
- Q
-"RTN","BMXMON",308,0)
- ;
-"RTN","BMXMON",309,0)
-MARKER(BMXPORT,BMXMODE) ;Set/Test/Clear Problem Marker, BMXMODE=0 is a function
-"RTN","BMXMON",310,0)
- N IP,Y,%,REF X ^%ZOSF("UCI") S REF=Y,IP="0.0.0.0",%=0
-"RTN","BMXMON",311,0)
- L +^BMX(IP,REF,BMXPORT,"PROBLEM MARKER"):1
-"RTN","BMXMON",312,0)
- I BMXMODE=1 S ^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")=1
-"RTN","BMXMON",313,0)
- I BMXMODE=0 S:$D(^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")) %=1
-"RTN","BMXMON",314,0)
- I BMXMODE=-1 K ^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")
-"RTN","BMXMON",315,0)
- L -^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")
-"RTN","BMXMON",316,0)
- Q:BMXMODE=0 % Q
-"RTN","BMXMON",317,0)
- ;
-"RTN","BMXMON",318,0)
-ETRAP ; -- on trapped error, send error info to client
-"RTN","BMXMON",319,0)
- N BMXERC,BMXERR,BMXLGR
-"RTN","BMXMON",320,0)
- ;Change trapping during trap.
-"RTN","BMXMON",321,0)
- S $ETRAP="D ^%ZTER HALT"
-"RTN","BMXMON",322,0)
- S BMXERC=$$EC^%ZOSV
-"RTN","BMXMON",323,0)
- S BMXERR="M ERROR="_BMXERC_$C(13,10)_"LAST REF="
-"RTN","BMXMON",324,0)
- S BMXLGR=$$LGR^%ZOSV_$C(4)
-"RTN","BMXMON",325,0)
- S BMXERR=BMXERR_BMXLGR
-"RTN","BMXMON",326,0)
- D ^%ZTER ;%ZTER clears $ZE and $ECODE
-"RTN","BMXMON",327,0)
- I (BMXERC["READ")!(BMXERC["WRITE")!(BMXERC["SYSTEM-F") D:$G(DUZ) LOGOUT^XUSRB HALT
-"RTN","BMXMON",328,0)
- U $P
-"RTN","BMXMON",329,0)
- D SNDERR,WRITE(BMXERR) W !
-"RTN","BMXMON",330,0)
- S $ETRAP="Q:($ESTACK&'$QUIT)  Q:$ESTACK -9 S $ECODE="""" G SESSRES^BMXMON",$ECODE=",U99,"
-"RTN","BMXMON",331,0)
- Q
-"RTN","BMXMON",332,0)
- ;
-"RTN","BMXMON",333,0)
-MENU ;EP - ENTRY ACTION FROM BMXMENU OPTION
-"RTN","BMXMON",334,0)
- ;
-"RTN","BMXMON",335,0)
- N BMX,BMXVER
-"RTN","BMXMON",336,0)
- ;VERSION
-"RTN","BMXMON",337,0)
- D
-"RTN","BMXMON",338,0)
- . S BMXN="BMXNET ADO.NET DATA PROVIDER" I $D(^DIC(9.4,"B",BMXN)) Q
-"RTN","BMXMON",339,0)
- . S BMXN="BMXNET RPMS .NET UTILITIES" I $D(^DIC(9.4,"B",BMXN)) Q
-"RTN","BMXMON",340,0)
- . S BMXN=""
-"RTN","BMXMON",341,0)
- . Q
-"RTN","BMXMON",342,0)
- ;
-"RTN","BMXMON",343,0)
- S BMXVER=""
-"RTN","BMXMON",344,0)
- I BMXN]"",$D(^DIC(9.4,"B",BMXN)) D
-"RTN","BMXMON",345,0)
- . S BMX=$O(^DIC(9.4,"B",BMXN,0))
-"RTN","BMXMON",346,0)
- . I $D(^DIC(9.4,BMX,"VERSION")) S BMXVER=$P(^DIC(9.4,BMX,"VERSION"),"^")
-"RTN","BMXMON",347,0)
- . E  S BMXVER="VERSION NOT FOUND"
-"RTN","BMXMON",348,0)
- S:BMXVER="" BMXVER="VERSION NOT FOUND"
-"RTN","BMXMON",349,0)
- ;
-"RTN","BMXMON",350,0)
- ;LOCATION
-"RTN","BMXMON",351,0)
- N BMXLOC
-"RTN","BMXMON",352,0)
- S BMXLOC=""
-"RTN","BMXMON",353,0)
- I $G(DUZ(2)),$D(^DIC(4,DUZ(2),0)) S BMXLOC=$P(^DIC(4,DUZ(2),0),"^")
-"RTN","BMXMON",354,0)
- S:BMXLOC="" BMXLOC="LOCATION NOT FOUND"
-"RTN","BMXMON",355,0)
- ;
-"RTN","BMXMON",356,0)
- ;WRITE
-"RTN","BMXMON",357,0)
- W !
-"RTN","BMXMON",358,0)
- W !,"BMXNet Version: ",BMXVER
-"RTN","BMXMON",359,0)
- W !,"Location: ",BMXLOC
-"RTN","BMXMON",360,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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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 ;
-"RTN","BMXRPC8",2,0)
- ;;2.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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.2;BMX;;Sep 07, 2010;Build 9
-"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 ; 9/7/10 9:34am
-"RTN","BMXUTL7",2,0)
- ;;2.2;BMX;;Sep 07, 2010;Build 9
-"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**