From 53108af97a86381334a4bcc6ae16d7d6459ad923 Mon Sep 17 00:00:00 2001 From: sam Date: Mon, 25 Jul 2011 14:48:47 +0000 Subject: [PATCH] New version of BMX. Fixes error trap problem --- k/bmx_0231.k | 23798 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 23798 insertions(+) create mode 100644 k/bmx_0231.k diff --git a/k/bmx_0231.k b/k/bmx_0231.k new file mode 100644 index 0000000..394e8cd --- /dev/null +++ b/k/bmx_0231.k @@ -0,0 +1,23798 @@ +KIDS Distribution saved on Jul 25, 2011@09:55:55 +BMX 2.31; Fixes infinite loop caused by Error Trap +**KIDS**:BMX 2.31^ + +**INSTALL NAME** +BMX 2.31 +"BLD",7644,0) +BMX 2.31^BMXNET RPMS .NET UTILITIES^0^3110725^n +"BLD",7644,1,0) +^^23^23^3110725^ +"BLD",7644,1,1,0) +BMXNet .NET Connectivity utilities for RPMS. +"BLD",7644,1,2,0) +Version 2.0 kids build to support BMXNet20.dll +"BLD",7644,1,3,0) + +"BLD",7644,1,4,0) +Version 2.1 adds support to GT.M. +"BLD",7644,1,5,0) + +"BLD",7644,1,6,0) +Version 2.2 adds a few bug fixes: +"BLD",7644,1,7,0) + - Process Name is now set in BMXMON +"BLD",7644,1,8,0) + - Timeout is now correct: +"BLD",7644,1,9,0) + - 10 seconds for 1st connection +"BLD",7644,1,10,0) + - 180 seconds for continuation +"BLD",7644,1,11,0) + - Kernel Broker Timeout for regular use +"BLD",7644,1,12,0) + - Divisions are now presented to the user if the user has more than one +"BLD",7644,1,13,0) +division in his/her profile. +"BLD",7644,1,14,0) +Version 2.2 requires BMXNet22.dll +"BLD",7644,1,15,0) + +"BLD",7644,1,16,0) +Version 2.3 (Dec 12 2010) +"BLD",7644,1,17,0) +Screens network errors and not log them into the error trap. +"BLD",7644,1,18,0) +Process Name set causes an error on Cache. Now fixed. +"BLD",7644,1,19,0) +Requires BMXNet23.dll +"BLD",7644,1,20,0) + +"BLD",7644,1,21,0) +Version 2.31 (Jul 25 2011) +"BLD",7644,1,22,0) +Error trap corrections in v 2.3 introduced a bug that causes an infinite +"BLD",7644,1,23,0) +loop in the error trap causing a hard drive to fill up. This is fixed. +"BLD",7644,4,0) +^9.64PA^90093.9^6 +"BLD",7644,4,90093.1,0) +90093.1 +"BLD",7644,4,90093.1,222) +y^y^f^^^^n +"BLD",7644,4,90093.2,0) +90093.2 +"BLD",7644,4,90093.2,222) +y^y^f^^n^^y^o^n +"BLD",7644,4,90093.5,0) +90093.5 +"BLD",7644,4,90093.5,222) +y^y^f^^^^n +"BLD",7644,4,90093.9,0) +90093.9 +"BLD",7644,4,90093.9,222) +y^y^f^^^^n +"BLD",7644,4,90093.98,0) +90093.98 +"BLD",7644,4,90093.98,222) +y^y^f^^^^n +"BLD",7644,4,90093.99,0) +90093.99 +"BLD",7644,4,90093.99,222) +y^y^f^^n^^y^a^n +"BLD",7644,4,"B",90093.1,90093.1) + +"BLD",7644,4,"B",90093.2,90093.2) + +"BLD",7644,4,"B",90093.5,90093.5) + +"BLD",7644,4,"B",90093.9,90093.9) + +"BLD",7644,4,"B",90093.98,90093.98) + +"BLD",7644,4,"B",90093.99,90093.99) + +"BLD",7644,6.3) +16 +"BLD",7644,"ABPKG") +n +"BLD",7644,"INIT") + +"BLD",7644,"KRN",0) +^9.67PA^8989.52^19 +"BLD",7644,"KRN",.4,0) +.4 +"BLD",7644,"KRN",.4,"NM",0) +^9.68A^^ +"BLD",7644,"KRN",.401,0) +.401 +"BLD",7644,"KRN",.402,0) +.402 +"BLD",7644,"KRN",.402,"NM",0) +^9.68A^1^1 +"BLD",7644,"KRN",.402,"NM",1,0) +BMX MONITOR EDIT FILE #90093.5^90093.5^0 +"BLD",7644,"KRN",.402,"NM","B","BMX MONITOR EDIT FILE #90093.5",1) + +"BLD",7644,"KRN",.403,0) +.403 +"BLD",7644,"KRN",.5,0) +.5 +"BLD",7644,"KRN",.84,0) +.84 +"BLD",7644,"KRN",3.6,0) +3.6 +"BLD",7644,"KRN",3.8,0) +3.8 +"BLD",7644,"KRN",9.2,0) +9.2 +"BLD",7644,"KRN",9.8,0) +9.8 +"BLD",7644,"KRN",9.8,"NM",0) +^9.68A^117^59 +"BLD",7644,"KRN",9.8,"NM",45,0) +BMXADOV1^^0^B71930345 +"BLD",7644,"KRN",9.8,"NM",58,0) +BMXMON^^0^B199224797 +"BLD",7644,"KRN",9.8,"NM",59,0) +BMXADE1^^0^B11418056 +"BLD",7644,"KRN",9.8,"NM",60,0) +BMXADE2^^0^B13063702 +"BLD",7644,"KRN",9.8,"NM",61,0) +BMXADO^^0^B32349097 +"BLD",7644,"KRN",9.8,"NM",62,0) +BMXADO2^^0^B10227201 +"BLD",7644,"KRN",9.8,"NM",63,0) +BMXADOF^^0^B90964967 +"BLD",7644,"KRN",9.8,"NM",64,0) +BMXADOF1^^0^B12833341 +"BLD",7644,"KRN",9.8,"NM",65,0) +BMXADOF2^^0^B7123769 +"BLD",7644,"KRN",9.8,"NM",66,0) +BMXADOFD^^0^B8876207 +"BLD",7644,"KRN",9.8,"NM",67,0) +BMXADOFS^^0^B38538227 +"BLD",7644,"KRN",9.8,"NM",68,0) +BMXADOI^^0^B6267463 +"BLD",7644,"KRN",9.8,"NM",69,0) +BMXADOS^^0^B78902997 +"BLD",7644,"KRN",9.8,"NM",70,0) +BMXADOS1^^0^B9622665 +"BLD",7644,"KRN",9.8,"NM",71,0) +BMXADOV^^0^B22947698 +"BLD",7644,"KRN",9.8,"NM",72,0) +BMXADOV2^^0^B19908593 +"BLD",7644,"KRN",9.8,"NM",73,0) +BMXADOVJ^^0^B8677686 +"BLD",7644,"KRN",9.8,"NM",74,0) +BMXADOX^^0^B208011638 +"BLD",7644,"KRN",9.8,"NM",75,0) +BMXADOX1^^0^B84889528 +"BLD",7644,"KRN",9.8,"NM",76,0) +BMXADOX2^^0^B11989229 +"BLD",7644,"KRN",9.8,"NM",77,0) +BMXADOXX^^0^B166011930 +"BLD",7644,"KRN",9.8,"NM",78,0) +BMXADOXY^^0^B61093377 +"BLD",7644,"KRN",9.8,"NM",79,0) +BMXFIND^^0^B45092715 +"BLD",7644,"KRN",9.8,"NM",80,0) +BMXG^^0^B2718298 +"BLD",7644,"KRN",9.8,"NM",81,0) +BMXGETS^^0^B15016739 +"BLD",7644,"KRN",9.8,"NM",82,0) +BMXMBRK^^0^B32854296 +"BLD",7644,"KRN",9.8,"NM",83,0) +BMXMBRK2^^0^B17554247 +"BLD",7644,"KRN",9.8,"NM",84,0) +BMXMEVN^^0^B41862703 +"BLD",7644,"KRN",9.8,"NM",85,0) +BMXMSEC^^0^B8709977 +"BLD",7644,"KRN",9.8,"NM",86,0) +BMXPRS^^0^B8898368 +"BLD",7644,"KRN",9.8,"NM",87,0) +BMXRPC^^0^B21470311 +"BLD",7644,"KRN",9.8,"NM",88,0) +BMXRPC1^^0^B52168951 +"BLD",7644,"KRN",9.8,"NM",89,0) +BMXRPC2^^0^B11504982 +"BLD",7644,"KRN",9.8,"NM",90,0) +BMXRPC3^^0^B39843476 +"BLD",7644,"KRN",9.8,"NM",91,0) +BMXRPC4^^0^B28124037 +"BLD",7644,"KRN",9.8,"NM",92,0) +BMXRPC5^^0^B15030574 +"BLD",7644,"KRN",9.8,"NM",93,0) +BMXRPC6^^0^B14693179 +"BLD",7644,"KRN",9.8,"NM",94,0) +BMXRPC7^^0^B40496291 +"BLD",7644,"KRN",9.8,"NM",95,0) +BMXRPC8^^0^B5993639 +"BLD",7644,"KRN",9.8,"NM",96,0) +BMXRPC9^^0^B45877662 +"BLD",7644,"KRN",9.8,"NM",97,0) +BMXSQL^^0^B109951806 +"BLD",7644,"KRN",9.8,"NM",98,0) +BMXSQL1^^0^B112955506 +"BLD",7644,"KRN",9.8,"NM",99,0) +BMXSQL2^^0^B9590811 +"BLD",7644,"KRN",9.8,"NM",100,0) +BMXSQL3^^0^B190410807 +"BLD",7644,"KRN",9.8,"NM",101,0) +BMXSQL4^^0^B3594616 +"BLD",7644,"KRN",9.8,"NM",102,0) +BMXSQL5^^0^B51902207 +"BLD",7644,"KRN",9.8,"NM",103,0) +BMXSQL6^^0^B130304448 +"BLD",7644,"KRN",9.8,"NM",104,0) +BMXSQL7^^0^B65321243 +"BLD",7644,"KRN",9.8,"NM",105,0) +BMXSQL91^^0^B25109398 +"BLD",7644,"KRN",9.8,"NM",106,0) +BMXTABLE^^0^B130270 +"BLD",7644,"KRN",9.8,"NM",107,0) +BMXTRS^^0^B1202427 +"BLD",7644,"KRN",9.8,"NM",108,0) +BMXUTL1^^0^B39816098 +"BLD",7644,"KRN",9.8,"NM",109,0) +BMXUTL2^^0^B1806952 +"BLD",7644,"KRN",9.8,"NM",110,0) +BMXUTL5^^0^B16165811 +"BLD",7644,"KRN",9.8,"NM",111,0) +BMXUTL6^^0^B582471 +"BLD",7644,"KRN",9.8,"NM",114,0) +BMXE01^^0^B6931626 +"BLD",7644,"KRN",9.8,"NM",115,0) +BMXNTEG^^0^B7300059 +"BLD",7644,"KRN",9.8,"NM",116,0) +BMXPO^^0^B4666839 +"BLD",7644,"KRN",9.8,"NM",117,0) +BMXUTL7^^0^B65930 +"BLD",7644,"KRN",9.8,"NM","B","BMXADE1",59) + +"BLD",7644,"KRN",9.8,"NM","B","BMXADE2",60) + +"BLD",7644,"KRN",9.8,"NM","B","BMXADO",61) + +"BLD",7644,"KRN",9.8,"NM","B","BMXADO2",62) + +"BLD",7644,"KRN",9.8,"NM","B","BMXADOF",63) + +"BLD",7644,"KRN",9.8,"NM","B","BMXADOF1",64) + +"BLD",7644,"KRN",9.8,"NM","B","BMXADOF2",65) + +"BLD",7644,"KRN",9.8,"NM","B","BMXADOFD",66) + +"BLD",7644,"KRN",9.8,"NM","B","BMXADOFS",67) + +"BLD",7644,"KRN",9.8,"NM","B","BMXADOI",68) + +"BLD",7644,"KRN",9.8,"NM","B","BMXADOS",69) + +"BLD",7644,"KRN",9.8,"NM","B","BMXADOS1",70) + +"BLD",7644,"KRN",9.8,"NM","B","BMXADOV",71) + +"BLD",7644,"KRN",9.8,"NM","B","BMXADOV1",45) + +"BLD",7644,"KRN",9.8,"NM","B","BMXADOV2",72) + +"BLD",7644,"KRN",9.8,"NM","B","BMXADOVJ",73) + +"BLD",7644,"KRN",9.8,"NM","B","BMXADOX",74) + +"BLD",7644,"KRN",9.8,"NM","B","BMXADOX1",75) + +"BLD",7644,"KRN",9.8,"NM","B","BMXADOX2",76) + +"BLD",7644,"KRN",9.8,"NM","B","BMXADOXX",77) + +"BLD",7644,"KRN",9.8,"NM","B","BMXADOXY",78) + +"BLD",7644,"KRN",9.8,"NM","B","BMXE01",114) + +"BLD",7644,"KRN",9.8,"NM","B","BMXFIND",79) + +"BLD",7644,"KRN",9.8,"NM","B","BMXG",80) + +"BLD",7644,"KRN",9.8,"NM","B","BMXGETS",81) + +"BLD",7644,"KRN",9.8,"NM","B","BMXMBRK",82) + +"BLD",7644,"KRN",9.8,"NM","B","BMXMBRK2",83) + +"BLD",7644,"KRN",9.8,"NM","B","BMXMEVN",84) + +"BLD",7644,"KRN",9.8,"NM","B","BMXMON",58) + +"BLD",7644,"KRN",9.8,"NM","B","BMXMSEC",85) + +"BLD",7644,"KRN",9.8,"NM","B","BMXNTEG",115) + +"BLD",7644,"KRN",9.8,"NM","B","BMXPO",116) + +"BLD",7644,"KRN",9.8,"NM","B","BMXPRS",86) + +"BLD",7644,"KRN",9.8,"NM","B","BMXRPC",87) + +"BLD",7644,"KRN",9.8,"NM","B","BMXRPC1",88) + +"BLD",7644,"KRN",9.8,"NM","B","BMXRPC2",89) + +"BLD",7644,"KRN",9.8,"NM","B","BMXRPC3",90) + +"BLD",7644,"KRN",9.8,"NM","B","BMXRPC4",91) + +"BLD",7644,"KRN",9.8,"NM","B","BMXRPC5",92) + +"BLD",7644,"KRN",9.8,"NM","B","BMXRPC6",93) + +"BLD",7644,"KRN",9.8,"NM","B","BMXRPC7",94) + +"BLD",7644,"KRN",9.8,"NM","B","BMXRPC8",95) + +"BLD",7644,"KRN",9.8,"NM","B","BMXRPC9",96) + +"BLD",7644,"KRN",9.8,"NM","B","BMXSQL",97) + +"BLD",7644,"KRN",9.8,"NM","B","BMXSQL1",98) + +"BLD",7644,"KRN",9.8,"NM","B","BMXSQL2",99) + +"BLD",7644,"KRN",9.8,"NM","B","BMXSQL3",100) + +"BLD",7644,"KRN",9.8,"NM","B","BMXSQL4",101) + +"BLD",7644,"KRN",9.8,"NM","B","BMXSQL5",102) + +"BLD",7644,"KRN",9.8,"NM","B","BMXSQL6",103) + +"BLD",7644,"KRN",9.8,"NM","B","BMXSQL7",104) + +"BLD",7644,"KRN",9.8,"NM","B","BMXSQL91",105) + +"BLD",7644,"KRN",9.8,"NM","B","BMXTABLE",106) + +"BLD",7644,"KRN",9.8,"NM","B","BMXTRS",107) + +"BLD",7644,"KRN",9.8,"NM","B","BMXUTL1",108) + +"BLD",7644,"KRN",9.8,"NM","B","BMXUTL2",109) + +"BLD",7644,"KRN",9.8,"NM","B","BMXUTL5",110) + +"BLD",7644,"KRN",9.8,"NM","B","BMXUTL6",111) + +"BLD",7644,"KRN",9.8,"NM","B","BMXUTL7",117) + +"BLD",7644,"KRN",19,0) +19 +"BLD",7644,"KRN",19,"NM",0) +^9.68A^5^5 +"BLD",7644,"KRN",19,"NM",1,0) +BMX MONITOR EDIT^^0 +"BLD",7644,"KRN",19,"NM",2,0) +BMX MONITOR START^^0 +"BLD",7644,"KRN",19,"NM",3,0) +BMX MONITOR STOP^^0 +"BLD",7644,"KRN",19,"NM",4,0) +BMXMENU^^0 +"BLD",7644,"KRN",19,"NM",5,0) +BMXRPC^^0 +"BLD",7644,"KRN",19,"NM","B","BMX MONITOR EDIT",1) + +"BLD",7644,"KRN",19,"NM","B","BMX MONITOR START",2) + +"BLD",7644,"KRN",19,"NM","B","BMX MONITOR STOP",3) + +"BLD",7644,"KRN",19,"NM","B","BMXMENU",4) + +"BLD",7644,"KRN",19,"NM","B","BMXRPC",5) + +"BLD",7644,"KRN",19.1,0) +19.1 +"BLD",7644,"KRN",19.1,"NM",0) +^9.68A^1^1 +"BLD",7644,"KRN",19.1,"NM",1,0) +BMXZMENU^^0 +"BLD",7644,"KRN",19.1,"NM","B","BMXZMENU",1) + +"BLD",7644,"KRN",101,0) +101 +"BLD",7644,"KRN",101,"NM",0) +^9.68A^^ +"BLD",7644,"KRN",409.61,0) +409.61 +"BLD",7644,"KRN",409.61,"NM",0) +^9.68A^^ +"BLD",7644,"KRN",771,0) +771 +"BLD",7644,"KRN",870,0) +870 +"BLD",7644,"KRN",8989.51,0) +8989.51 +"BLD",7644,"KRN",8989.51,"NM",0) +^9.68A^^ +"BLD",7644,"KRN",8989.52,0) +8989.52 +"BLD",7644,"KRN",8994,0) +8994 +"BLD",7644,"KRN",8994,"NM",0) +^9.68A^45^45 +"BLD",7644,"KRN",8994,"NM",1,0) +BMX ADO SS^^0 +"BLD",7644,"KRN",8994,"NM",2,0) +BMX ASYNC GET^^0 +"BLD",7644,"KRN",8994,"NM",3,0) +BMX ASYNC QUEUE^^0 +"BLD",7644,"KRN",8994,"NM",4,0) +BMX AV CODE^^0 +"BLD",7644,"KRN",8994,"NM",5,0) +BMX DEMO^^0 +"BLD",7644,"KRN",8994,"NM",6,0) +BMX DENTAL REPORT 1^^0 +"BLD",7644,"KRN",8994,"NM",7,0) +BMX DENTAL REPORT 2^^0 +"BLD",7644,"KRN",8994,"NM",8,0) +BMX EVENT POLL^^0 +"BLD",7644,"KRN",8994,"NM",9,0) +BMX EVENT RAISE^^0 +"BLD",7644,"KRN",8994,"NM",10,0) +BMX EVENT REGISTER^^0 +"BLD",7644,"KRN",8994,"NM",11,0) +BMX EVENT UNREGISTER^^0 +"BLD",7644,"KRN",8994,"NM",12,0) +BMX FIELD LIST^^0 +"BLD",7644,"KRN",8994,"NM",13,0) +BMX FIND^^0 +"BLD",7644,"KRN",8994,"NM",14,0) +BMX GET VARIABLE VALUE^^0 +"BLD",7644,"KRN",8994,"NM",15,0) +BMX HEALTH SUMMARY^^0 +"BLD",7644,"KRN",8994,"NM",16,0) +BMX IM HERE^^0 +"BLD",7644,"KRN",8994,"NM",17,0) +BMX LOCK^^0 +"BLD",7644,"KRN",8994,"NM",18,0) +BMX LOOKUP^^0 +"BLD",7644,"KRN",8994,"NM",19,0) +BMX MULT LIST^^0 +"BLD",7644,"KRN",8994,"NM",20,0) +BMX NTUSER^^0 +"BLD",7644,"KRN",8994,"NM",21,0) +BMX PATIENT DEMOG DATA GET^^0 +"BLD",7644,"KRN",8994,"NM",22,0) +BMX PDATA CHART^^0 +"BLD",7644,"KRN",8994,"NM",23,0) +BMX SCHEMA ONLY^^0 +"BLD",7644,"KRN",8994,"NM",24,0) +BMX SECURITY KEY^^0 +"BLD",7644,"KRN",8994,"NM",25,0) +BMX SIGNATURE^^0 +"BLD",7644,"KRN",8994,"NM",26,0) +BMX SQL^^0 +"BLD",7644,"KRN",8994,"NM",27,0) +BMX SQL COLINFO^^0 +"BLD",7644,"KRN",8994,"NM",28,0) +BMX TABLE^^0 +"BLD",7644,"KRN",8994,"NM",29,0) +BMX TEST^^0 +"BLD",7644,"KRN",8994,"NM",30,0) +BMX TIMER TEST^^0 +"BLD",7644,"KRN",8994,"NM",31,0) +BMX TLIST^^0 +"BLD",7644,"KRN",8994,"NM",32,0) +BMX UPDATE^^0 +"BLD",7644,"KRN",8994,"NM",33,0) +BMX USER^^0 +"BLD",7644,"KRN",8994,"NM",34,0) +BMX VERSION INFO^^0 +"BLD",7644,"KRN",8994,"NM",35,0) +BMXGetFac^^0 +"BLD",7644,"KRN",8994,"NM",36,0) +BMXGetFacRS^^0 +"BLD",7644,"KRN",8994,"NM",37,0) +BMXNRC^^0 +"BLD",7644,"KRN",8994,"NM",38,0) +BMXNetGetCodes^^0 +"BLD",7644,"KRN",8994,"NM",39,0) +BMXNetSetUser^^0 +"BLD",7644,"KRN",8994,"NM",40,0) +BMXPatientInfoRS^^0 +"BLD",7644,"KRN",8994,"NM",41,0) +BMXPatientLookupRS^^0 +"BLD",7644,"KRN",8994,"NM",42,0) +BMXProviderLookupRS^^0 +"BLD",7644,"KRN",8994,"NM",43,0) +BMXSetFac^^0 +"BLD",7644,"KRN",8994,"NM",44,0) +BMXUserKeyRS^^0 +"BLD",7644,"KRN",8994,"NM",45,0) +BMX UTF-8^^0 +"BLD",7644,"KRN",8994,"NM","B","BMX ADO SS",1) + +"BLD",7644,"KRN",8994,"NM","B","BMX ASYNC GET",2) + +"BLD",7644,"KRN",8994,"NM","B","BMX ASYNC QUEUE",3) + +"BLD",7644,"KRN",8994,"NM","B","BMX AV CODE",4) + +"BLD",7644,"KRN",8994,"NM","B","BMX DEMO",5) + +"BLD",7644,"KRN",8994,"NM","B","BMX DENTAL REPORT 1",6) + +"BLD",7644,"KRN",8994,"NM","B","BMX DENTAL REPORT 2",7) + +"BLD",7644,"KRN",8994,"NM","B","BMX EVENT POLL",8) + +"BLD",7644,"KRN",8994,"NM","B","BMX EVENT RAISE",9) + +"BLD",7644,"KRN",8994,"NM","B","BMX EVENT REGISTER",10) + +"BLD",7644,"KRN",8994,"NM","B","BMX EVENT UNREGISTER",11) + +"BLD",7644,"KRN",8994,"NM","B","BMX FIELD LIST",12) + +"BLD",7644,"KRN",8994,"NM","B","BMX FIND",13) + +"BLD",7644,"KRN",8994,"NM","B","BMX GET VARIABLE VALUE",14) + +"BLD",7644,"KRN",8994,"NM","B","BMX HEALTH SUMMARY",15) + +"BLD",7644,"KRN",8994,"NM","B","BMX IM HERE",16) + +"BLD",7644,"KRN",8994,"NM","B","BMX LOCK",17) + +"BLD",7644,"KRN",8994,"NM","B","BMX LOOKUP",18) + +"BLD",7644,"KRN",8994,"NM","B","BMX MULT LIST",19) + +"BLD",7644,"KRN",8994,"NM","B","BMX NTUSER",20) + +"BLD",7644,"KRN",8994,"NM","B","BMX PATIENT DEMOG DATA GET",21) + +"BLD",7644,"KRN",8994,"NM","B","BMX PDATA CHART",22) + +"BLD",7644,"KRN",8994,"NM","B","BMX SCHEMA ONLY",23) + +"BLD",7644,"KRN",8994,"NM","B","BMX SECURITY KEY",24) + +"BLD",7644,"KRN",8994,"NM","B","BMX SIGNATURE",25) + +"BLD",7644,"KRN",8994,"NM","B","BMX SQL",26) + +"BLD",7644,"KRN",8994,"NM","B","BMX SQL COLINFO",27) + +"BLD",7644,"KRN",8994,"NM","B","BMX TABLE",28) + +"BLD",7644,"KRN",8994,"NM","B","BMX TEST",29) + +"BLD",7644,"KRN",8994,"NM","B","BMX TIMER TEST",30) + +"BLD",7644,"KRN",8994,"NM","B","BMX TLIST",31) + +"BLD",7644,"KRN",8994,"NM","B","BMX UPDATE",32) + +"BLD",7644,"KRN",8994,"NM","B","BMX USER",33) + +"BLD",7644,"KRN",8994,"NM","B","BMX UTF-8",45) + +"BLD",7644,"KRN",8994,"NM","B","BMX VERSION INFO",34) + +"BLD",7644,"KRN",8994,"NM","B","BMXGetFac",35) + +"BLD",7644,"KRN",8994,"NM","B","BMXGetFacRS",36) + +"BLD",7644,"KRN",8994,"NM","B","BMXNRC",37) + +"BLD",7644,"KRN",8994,"NM","B","BMXNetGetCodes",38) + +"BLD",7644,"KRN",8994,"NM","B","BMXNetSetUser",39) + +"BLD",7644,"KRN",8994,"NM","B","BMXPatientInfoRS",40) + +"BLD",7644,"KRN",8994,"NM","B","BMXPatientLookupRS",41) + +"BLD",7644,"KRN",8994,"NM","B","BMXProviderLookupRS",42) + +"BLD",7644,"KRN",8994,"NM","B","BMXSetFac",43) + +"BLD",7644,"KRN",8994,"NM","B","BMXUserKeyRS",44) + +"BLD",7644,"KRN","B",.4,.4) + +"BLD",7644,"KRN","B",.401,.401) + +"BLD",7644,"KRN","B",.402,.402) + +"BLD",7644,"KRN","B",.403,.403) + +"BLD",7644,"KRN","B",.5,.5) + +"BLD",7644,"KRN","B",.84,.84) + +"BLD",7644,"KRN","B",3.6,3.6) + +"BLD",7644,"KRN","B",3.8,3.8) + +"BLD",7644,"KRN","B",9.2,9.2) + +"BLD",7644,"KRN","B",9.8,9.8) + +"BLD",7644,"KRN","B",19,19) + +"BLD",7644,"KRN","B",19.1,19.1) + +"BLD",7644,"KRN","B",101,101) + +"BLD",7644,"KRN","B",409.61,409.61) + +"BLD",7644,"KRN","B",771,771) + +"BLD",7644,"KRN","B",870,870) + +"BLD",7644,"KRN","B",8989.51,8989.51) + +"BLD",7644,"KRN","B",8989.52,8989.52) + +"BLD",7644,"KRN","B",8994,8994) + +"BLD",7644,"PRE") +BMXE01 +"BLD",7644,"QUES",0) +^9.62^^ +"BLD",7644,"REQB",0) +^9.611^^ +"DATA",90093.2,1,0) +2^3^3110125.0629 +"DATA",90093.99,1,0) +TEST^2160010 +"DATA",90093.99,1,1,0) +^90093.991^6^6 +"DATA",90093.99,1,1,1,0) +.01^T^30^PATIENT^0^0^0 +"DATA",90093.99,1,1,2,0) +.02^T^6^SEX^0^0^1 +"DATA",90093.99,1,1,3,0) +.03^D^12^DOB^0^0^1 +"DATA",90093.99,1,1,4,0) +.04^T^30^LOCAL FACILITY^0^0^1 +"DATA",90093.99,1,1,5,0) +.04IEN^T^00009^LOCAL FACILITY_IEN^0^0^1 +"DATA",90093.99,1,1,6,0) +.01ID^T^99^IDENTIFIERS^1^0^1 +"DATA",90093.99,1,1,6,1) +TESTID^BMXADOV1 +"DATA",90093.99,1,2,0) +^90093.992^1^1 +"DATA",90093.99,1,2,1,0) +ALL PATIENTS +"DATA",90093.99,1,2,1,1) +ALL^BMXADO +"DATA",90093.99,1,2,1,2,0) +^90093.9922^2^2 +"DATA",90093.99,1,2,1,2,1,0) +DFN^PATIENT IEN +"DATA",90093.99,1,2,1,2,2,0) +IEN^VISIT IEN +"DATA",90093.99,2,0) +TEST1^2160010 +"DATA",90093.99,2,1,0) +^90093.991^6^6 +"DATA",90093.99,2,1,1,0) +.03^D^8^DOB^0^0^1 +"DATA",90093.99,2,1,2,0) +.04^T^40^LOCAL_FACILITY^0^1^1 +"DATA",90093.99,2,1,3,0) +.01^T^30^NAME^0^0^0 +"DATA",90093.99,2,1,4,0) +.02^T^4^SEX^0^0^1 +"DATA",90093.99,2,1,5,0) +.09^T^30^SSN^0^0^1 +"DATA",90093.99,2,1,6,0) +.08^T^30^RELIGION^0^0^1 +"DATA",90093.99,3,0) +VISIT^9000010 +"DATA",90093.99,3,1,0) +^90093.991^6^6 +"DATA",90093.99,3,1,1,0) +.01^D^12^TIMESTAMP^0^0^0 +"DATA",90093.99,3,1,2,0) +.03^T^3^TYPE^0^0^0 +"DATA",90093.99,3,1,3,0) +.05^T^30^PATIENT^0^0^0 +"DATA",90093.99,3,1,4,0) +.06^T^30^FACILITY^0^0^0 +"DATA",90093.99,3,1,5,0) +.07^T^10^CATEGORY^0^0^0 +"DATA",90093.99,3,1,6,0) +.08^T^30^CLINIC^0^0^1 +"DATA",90093.99,3,2,0) +^90093.992^1^1 +"DATA",90093.99,3,2,1,0) +POSSIBLE MATCHES +"DATA",90093.99,3,2,1,1) +VLIST^BMXADOF1 +"DATA",90093.99,4,0) +GREG^2 +"DATA",90093.99,4,1,0) +^90093.991^9^6 +"DATA",90093.99,4,1,1,0) +.01^T^30^NAME^0^0^0 +"DATA",90093.99,4,1,2,0) +.02^T^4^SEX^0^0^0 +"DATA",90093.99,4,1,3,0) +.03^D^12^DOB^0^0^0 +"DATA",90093.99,4,1,4,0) +.04IEN^T^00009^LOCAL FACILITY_IEN^0^0^1 +"DATA",90093.99,4,1,8,0) +.01ID^T^00017^NAME_ID^0^0^0 +"DATA",90093.99,4,1,8,1) +DEMOGR^BMXADOX +"DATA",90093.99,4,1,9,0) +.04^T^30^LOCAL FACILITY^0^0^1 +"DATA",90093.99,5,0) +TEST2^2160010.111 +"DATA",90093.99,5,1,0) +^90093.991^2^2 +"DATA",90093.99,5,1,1,0) +.01^T^30^MEDICATION INSTRUCTIONS^0^0^1 +"DATA",90093.99,5,1,2,0) +.02^T^4^LEVEL OF UNDERSTANDING^0^0^1 +"DATA",90093.99,6,0) +IHS PATIENT^9000001 +"DATA",90093.99,6,1,0) +^90093.991^3^3 +"DATA",90093.99,6,1,1,0) +.01^T^30^NAME^0^0^0 +"DATA",90093.99,6,1,2,0) +.02^D^21^DATE ESTABLISHED^0^0^1 +"DATA",90093.99,6,1,3,0) +.06^T^9^PCIS ID NO.^0^0^1 +"DATA",90093.99,7,0) +VISITS^9000010^0 +"DATA",90093.99,7,1,0) +^90093.991^7^7 +"DATA",90093.99,7,1,1,0) +.01^D^21^TIMESTAMP^0^0^0 +"DATA",90093.99,7,1,2,0) +.03^T^3^TYPE^0^0^0 +"DATA",90093.99,7,1,3,0) +.05^T^30^PATIENT^0^0^0 +"DATA",90093.99,7,1,4,0) +.06^T^30^FACILITY^0^0^0 +"DATA",90093.99,7,1,5,0) +.07^T^10^CATEGORY^0^0^0 +"DATA",90093.99,7,1,6,0) +.08^T^30^CLINIC^0^0^1 +"DATA",90093.99,7,1,7,0) +.05IEN^N^15^PATIENT_IEN^1^0^0 +"DATA",90093.99,8,0) +MEASUREMENTS^9000010.01 +"DATA",90093.99,8,1,0) +^90093.991^4^4 +"DATA",90093.99,8,1,1,0) +.02^T^30^PATIENT NAME^0^0^1 +"DATA",90093.99,8,1,2,0) +.03^T^30^VISIT^0^0^1 +"DATA",90093.99,8,1,3,0) +.01^T^30^TYPE^0^0^1 +"DATA",90093.99,8,1,4,0) +.04^T^100^VALUE^0^0^1 +"DATA",90093.99,9,0) +XVISIT^2160010.01 +"DATA",90093.99,9,1,0) +^90093.991^2^2 +"DATA",90093.99,9,1,1,0) +.01^D^21^VISIT^0^0^1 +"DATA",90093.99,9,1,2,0) +.02^T^30^CLINIC^0^0^1 +"DATA",90093.99,10,0) +ICD^80 +"DATA",90093.99,10,1,0) +^90093.991^3^3 +"DATA",90093.99,10,1,1,0) +.01^T^7^CODE NUMBER^0^0^1 +"DATA",90093.99,10,1,2,0) +2^T^10^IDENTIFIER^0^0^1 +"DATA",90093.99,10,1,3,0) +3^T^30^DIAGNOSIS^0^0^1 +"DATA",90093.99,11,0) +PATIENT DEMOGRAPHICS^2^0 +"DATA",90093.99,11,1,0) +^90093.991^5^5 +"DATA",90093.99,11,1,1,0) +.01^T^30^NAME^0^0^0^0 +"DATA",90093.99,11,1,2,0) +.02^T^4^SEX^0^0^1 +"DATA",90093.99,11,1,3,0) +.03^D^21^DOB^0^0^1 +"DATA",90093.99,11,1,4,0) +.09^T^30^SSN^0^0^1 +"DATA",90093.99,11,1,5,0) +.03TRIGGER1^D^21^IDOB^1^0^1 +"DATA",90093.99,11,1,5,3) +DATE^BMXADOI +"DATA",90093.99,12,0) +VIEW POVS^9000010.07 +"DATA",90093.99,12,1,0) +^90093.991^8^8 +"DATA",90093.99,12,1,1,0) +.01^T^30^POV^0^0^0 +"DATA",90093.99,12,1,2,0) +.01IEN^T^00009^POV_IEN^0^0^0 +"DATA",90093.99,12,1,3,0) +.02^T^30^PATIENT^0^0^0 +"DATA",90093.99,12,1,4,0) +.02IEN^T^00009^PATIENT_IEN^0^0^0 +"DATA",90093.99,12,1,5,0) +.03^T^30^VISIT^0^0^0 +"DATA",90093.99,12,1,6,0) +.03IEN^T^00009^VISIT_IEN^0^0^0 +"DATA",90093.99,12,1,7,0) +.04^T^30^PROVIDER NARRATIVE^0^0^0 +"DATA",90093.99,12,1,8,0) +.04IEN^T^00009^PROVIDER NARRATIVE_IEN^0^0^0 +"DATA",90093.99,13,0) +UPDATE PATIENT DEMOGRAPHICS^2 +"DATA",90093.99,13,1,0) +^90093.991^13^13 +"DATA",90093.99,13,1,1,0) +.09^T^30^SSN^0^0^0 +"DATA",90093.99,13,1,2,0) +.111^T^50^MAILING ADDRESS-STREET^0^0^1 +"DATA",90093.99,13,1,3,0) +.112^T^30^STREET ADDRESS [LINE 2]^0^0^1 +"DATA",90093.99,13,1,4,0) +.114^T^30^MAILING ADDRESS-CITY^0^0^1 +"DATA",90093.99,13,1,5,0) +.115^T^30^MAILING ADDRESS-STATE^0^0^1 +"DATA",90093.99,13,1,6,0) +.115IEN^T^00009^MAILING ADDRESS-STATE_IEN^0^0^1 +"DATA",90093.99,13,1,7,0) +.116^T^10^MAILING ADDRESS-ZIP^0^0^1 +"DATA",90093.99,13,1,8,0) +.131^T^20^HOME PHONE^0^0^1 +"DATA",90093.99,13,1,9,0) +.132^T^20^OFFICE PHONE^0^0^1 +"DATA",90093.99,13,1,10,0) +.3111^T^30^EMPLOYER^0^0^1 +"DATA",90093.99,13,1,11,0) +.31115^T^18^EMPLOYMENT STATUS^0^0^1 +"DATA",90093.99,13,1,12,0) +.01^T^30^NAME^0^0^0 +"DATA",90093.99,13,1,13,0) +.01ID^T^00017^NAME_ID^0^0^0 +"DATA",90093.99,13,1,13,1) +DEMOID^BMXADOI +"DATA",90093.99,14,0) +UPDATE PVT INSURANCE INFO^9000006.11 +"DATA",90093.99,14,1,0) +^90093.991^7^7 +"DATA",90093.99,14,1,1,0) +.01^T^30^INSURER^0^0^0 +"DATA",90093.99,14,1,2,0) +.01IEN^T^00009^INSURER_IEN^0^0^0 +"DATA",90093.99,14,1,3,0) +.02^T^30^POLICY NUMBER^0^0^1 +"DATA",90093.99,14,1,4,0) +.04^T^30^NAME OF INSURED^0^0^1 +"DATA",90093.99,14,1,5,0) +.05^T^30^RELATIONSHIP^0^0^1 +"DATA",90093.99,14,1,6,0) +.06^D^21^ELIG. DATE^0^0^1 +"DATA",90093.99,14,1,7,0) +.07^D^21^ELIG. END DATE^0^0^1 +"DATA",90093.99,15,0) +UPDATE MEDICARE INFO^9000003 +"DATA",90093.99,15,1,0) +^90093.991^6^6 +"DATA",90093.99,15,1,1,0) +.01^T^30^PATIENT NAME^0^0^1 +"DATA",90093.99,15,1,2,0) +.01IEN^T^00009^PATIENT NAME_IEN^0^0^1 +"DATA",90093.99,15,1,3,0) +.03^T^9^MEDICARE NUMBER^0^0^1 +"DATA",90093.99,15,1,4,0) +.04^T^30^SUFFIX^0^0^1 +"DATA",90093.99,15,1,5,0) +.04IEN^T^00009^SUFFIX_IEN^0^0^1 +"DATA",90093.99,15,1,6,0) +.15^T^3^MEDICARE CARD COPY ON FILE^0^0^1 +"DATA",90093.99,16,0) +UPDATE MEDICARE DATES^9000003.11 +"DATA",90093.99,16,1,0) +^90093.991^3^3 +"DATA",90093.99,16,1,1,0) +.01^D^21^ELIG. DATE^0^0^1 +"DATA",90093.99,16,1,2,0) +.02^D^21^ELIG. END DATE^0^0^1 +"DATA",90093.99,16,1,3,0) +.03^T^1^COVERAGE TYPE^0^0 +"DATA",90093.99,17,0) +UPDATE MEDICAID INFO^9000004 +"DATA",90093.99,17,1,0) +^90093.991^7^7 +"DATA",90093.99,17,1,1,0) +.01^T^30^PATIENT NAME^0^0^0 +"DATA",90093.99,17,1,2,0) +.01IEN^T^00009^PATIENT NAME_IEN^0^0^0 +"DATA",90093.99,17,1,3,0) +.02^T^30^INSURER POINTER^0^0^1 +"DATA",90093.99,17,1,4,0) +.02IEN^T^00009^INSURER POINTER_IEN^0^0^1 +"DATA",90093.99,17,1,5,0) +.03^T^30^MEDICAID NUMBER^0^0^1 +"DATA",90093.99,17,1,6,0) +.04^T^30^STATE^0^0^1 +"DATA",90093.99,17,1,7,0) +.04IEN^T^00009^STATE_IEN^0^0^1 +"DATA",90093.99,18,0) +UPDATE MEDICAID DATES^9000004.11 +"DATA",90093.99,18,1,0) +^90093.991^3^3 +"DATA",90093.99,18,1,1,0) +.01^D^21^ELIG. DATE^0^0^0 +"DATA",90093.99,18,1,2,0) +.02^D^21^ELIG. END DATE^0^0^1 +"DATA",90093.99,18,1,3,0) +.03^T^2^COVERAGE TYPE^0^0^1 +"DATA",90093.99,19,0) +VIEW PROBLEMS^9000011 +"DATA",90093.99,19,1,0) +^90093.991^13^13 +"DATA",90093.99,19,1,1,0) +.01^T^30^ICD CODE^0^0^0 +"DATA",90093.99,19,1,2,0) +.01IEN^T^00009^ICD CODE_IEN^0^0^0 +"DATA",90093.99,19,1,3,0) +.02^T^30^PATIENT^0^0^0 +"DATA",90093.99,19,1,4,0) +.02IEN^T^00009^PATIENT_IEN^0^0^0 +"DATA",90093.99,19,1,5,0) +.03^D^21^DATE LAST MODIFIED^0^0^1 +"DATA",90093.99,19,1,6,0) +.04^T^16^CLASS^0^0^1 +"DATA",90093.99,19,1,7,0) +.05^T^30^PROVIDER NARRATIVE^0^0^1 +"DATA",90093.99,19,1,8,0) +.05IEN^T^00009^PROVIDER NARRATIVE_IEN^0^0^1 +"DATA",90093.99,19,1,9,0) +.08^D^21^DATE ENTERED^0^0^1 +"DATA",90093.99,19,1,10,0) +.12^T^6^STATUS^0^0^1 +"DATA",90093.99,19,1,11,0) +.06^T^30^FACILITY^0^0^1 +"DATA",90093.99,19,1,12,0) +.06IEN^T^00009^FACILITY_IEN^0^0^1 +"DATA",90093.99,19,1,13,0) +.07^N^9^NMBR^0^0^1 +"DATA",90093.99,20,0) +UPDATE POVS^9000010.07 +"DATA",90093.99,20,1,0) +^90093.991^6^6 +"DATA",90093.99,20,1,1,0) +.01^T^30^POV^0^0^0 +"DATA",90093.99,20,1,2,0) +.02^T^30^PATIENT NAME^0^0^0 +"DATA",90093.99,20,1,3,0) +.03^T^30^VISIT^0^0^0 +"DATA",90093.99,20,1,4,0) +.04^T^30^PROVIDER NARRATIVE^0^0^0 +"DATA",90093.99,20,1,5,0) +.08^T^11^FIRST/REVISIT^0^0^1 +"DATA",90093.99,20,1,6,0) +.12^T^7^PRIMARY/SECONDARY^0^0^1 +"DATA",90093.99,21,0) +VIEW MEASUREMENTS^9000010.01 +"DATA",90093.99,21,1,0) +^90093.991^7^7 +"DATA",90093.99,21,1,1,0) +.01^T^30^TYPE^0^0^0 +"DATA",90093.99,21,1,2,0) +.01IEN^T^00009^TYPE_IEN^0^0^0 +"DATA",90093.99,21,1,3,0) +.02^T^30^PATIENT NAME^0^0^0 +"DATA",90093.99,21,1,4,0) +.02IEN^T^00009^PATIENT NAME_IEN^0^0^0 +"DATA",90093.99,21,1,5,0) +.03^T^30^VISIT^0^0^0 +"DATA",90093.99,21,1,6,0) +.03IEN^T^00009^VISIT_IEN^0^0^0 +"DATA",90093.99,21,1,7,0) +.04^T^100^VALUE^0^0^1 +"DATA",90093.99,22,0) +UPDATE MEASUREMENTS^9000010.01 +"DATA",90093.99,22,1,0) +^90093.991^5^5 +"DATA",90093.99,22,1,1,0) +.01^T^30^TYPE^0^0^0 +"DATA",90093.99,22,1,2,0) +.02^T^30^PATIENT NAME^0^0^0 +"DATA",90093.99,22,1,3,0) +.03^T^30^VISIT^0^0^0 +"DATA",90093.99,22,1,4,0) +.04^T^100^VALUE^0^0^1 +"DATA",90093.99,22,1,5,0) +99^T^30^METHOD^0^0^1 +"DATA",90093.99,23,0) +VIEW MEDS^9000010.14 +"DATA",90093.99,23,1,0) +^90093.991^8^8 +"DATA",90093.99,23,1,1,0) +.01^T^30^MEDICATION^0^0^0 +"DATA",90093.99,23,1,2,0) +.01IEN^T^00009^MEDICATION_IEN^0^0^0 +"DATA",90093.99,23,1,3,0) +.02^T^30^PATIENT NAME^0^0^0 +"DATA",90093.99,23,1,4,0) +.02IEN^T^00009^PATIENT NAME_IEN^0^0^0 +"DATA",90093.99,23,1,5,0) +.03^T^30^VISIT^0^0^0 +"DATA",90093.99,23,1,6,0) +.03IEN^T^00009^VISIT_IEN^0^0^0 +"DATA",90093.99,23,1,7,0) +.05^T^32^SIG^0^0^1 +"DATA",90093.99,23,1,8,0) +.06^I^7^QUANTITY^0^0^1 +"DATA",90093.99,24,0) +UPDATE MEDS^9000010.14 +"DATA",90093.99,24,1,0) +^90093.991^5^5 +"DATA",90093.99,24,1,1,0) +.01^T^30^MEDICATION^0^0^0 +"DATA",90093.99,24,1,2,0) +.02^T^30^PATIENT NAME^0^0^0 +"DATA",90093.99,24,1,3,0) +.03^T^30^VISIT^0^0^0 +"DATA",90093.99,24,1,4,0) +.05^T^32^SIG^0^0^1 +"DATA",90093.99,24,1,5,0) +.06^I^7^QUANTITY^0^0^1 +"DATA",90093.99,25,0) +VIEW LABS^9000010.09 +"DATA",90093.99,25,1,0) +^90093.991^7^7 +"DATA",90093.99,25,1,1,0) +.01^T^30^LAB TEST^0^0^0 +"DATA",90093.99,25,1,2,0) +.01IEN^T^00009^LAB TEST_IEN^0^0^0 +"DATA",90093.99,25,1,3,0) +.02^T^30^PATIENT NAME^0^0^0 +"DATA",90093.99,25,1,4,0) +.02IEN^T^00009^PATIENT NAME_IEN^0^0^0 +"DATA",90093.99,25,1,5,0) +.03^T^30^VISIT^0^0^0 +"DATA",90093.99,25,1,6,0) +.03IEN^T^00009^VISIT_IEN^0^0^0 +"DATA",90093.99,25,1,7,0) +.04^T^200^RESULTS^0^0^1 +"DATA",90093.99,26,0) +UPDATE LABS^9000010.09 +"DATA",90093.99,26,1,0) +^90093.991^5^5 +"DATA",90093.99,26,1,1,0) +.01^T^30^LAB TEST^0^0^0 +"DATA",90093.99,26,1,2,0) +.02^T^30^PATIENT NAME^0^0^0 +"DATA",90093.99,26,1,3,0) +.03^T^30^VISIT^0^0^0 +"DATA",90093.99,26,1,4,0) +.04^T^200^RESULTS^0^0^0 +"DATA",90093.99,26,1,5,0) +.05^T^2^ABNORMAL^0^0^1 +"DATA",90093.99,27,0) +VIEW EXAMS^9000010.13 +"DATA",90093.99,27,1,0) +^90093.991^7^7 +"DATA",90093.99,27,1,1,0) +.01^T^30^EXAM^0^0^0 +"DATA",90093.99,27,1,2,0) +.01IEN^T^00009^EXAM_IEN^0^0^0 +"DATA",90093.99,27,1,3,0) +.02^T^30^PATIENT NAME^0^0^0 +"DATA",90093.99,27,1,4,0) +.02IEN^T^00009^PATIENT NAME_IEN^0^0^0 +"DATA",90093.99,27,1,5,0) +.03^T^30^VISIT^0^0^0 +"DATA",90093.99,27,1,6,0) +.03IEN^T^00009^VISIT_IEN^0^0^0 +"DATA",90093.99,27,1,7,0) +.04^T^8^RESULT^0^0^1 +"DATA",90093.99,28,0) +UPDATE EXAMS^9000010.13 +"DATA",90093.99,28,1,0) +^90093.991^4^4 +"DATA",90093.99,28,1,1,0) +.01^T^30^EXAM^0^0^0 +"DATA",90093.99,28,1,2,0) +.02^T^30^PATIENT NAME^0^0^0 +"DATA",90093.99,28,1,3,0) +.03^T^30^VISIT^0^0^0 +"DATA",90093.99,28,1,4,0) +.04^T^8^RESULT^0^0^1 +"DATA",90093.99,29,0) +VIEW IMM^9000010.11 +"DATA",90093.99,29,1,0) +^90093.991^7^7 +"DATA",90093.99,29,1,1,0) +.01^T^30^IMMUNIZATION^0^0^0 +"DATA",90093.99,29,1,2,0) +.01IEN^T^00009^IMMUNIZATION_IEN^0^0^0 +"DATA",90093.99,29,1,3,0) +.02^T^30^PATIENT NAME^0^0^0 +"DATA",90093.99,29,1,4,0) +.02IEN^T^00009^PATIENT NAME_IEN^0^0^0 +"DATA",90093.99,29,1,5,0) +.03^T^30^VISIT^0^0^0 +"DATA",90093.99,29,1,6,0) +.03IEN^T^00009^VISIT_IEN^0^0^0 +"DATA",90093.99,29,1,7,0) +.04^T^18^SERIES^0^0^1 +"DATA",90093.99,30,0) +UPDATE IMM^9000010.11 +"DATA",90093.99,30,1,0) +^90093.991^4^4 +"DATA",90093.99,30,1,1,0) +.01^T^30^IMMUNIZATION^0^0^0 +"DATA",90093.99,30,1,2,0) +.02^T^30^PATIENT NAME^0^0^0 +"DATA",90093.99,30,1,3,0) +.03^T^30^VISIT^0^0^0 +"DATA",90093.99,30,1,4,0) +.04^T^18^SERIES^0^0^1 +"DATA",90093.99,31,0) +VIEW PROV^9000010.06 +"DATA",90093.99,31,1,0) +^90093.991^7^7 +"DATA",90093.99,31,1,1,0) +.01^T^30^PROVIDER^0^0^0 +"DATA",90093.99,31,1,2,0) +.01IEN^T^00009^PROVIDER_IEN^0^0^0 +"DATA",90093.99,31,1,3,0) +.02^T^30^PATIENT NAME^0^0^0 +"DATA",90093.99,31,1,4,0) +.02IEN^T^00009^PATIENT NAME_IEN^0^0^0 +"DATA",90093.99,31,1,5,0) +.03^T^30^VISIT^0^0^0 +"DATA",90093.99,31,1,6,0) +.03IEN^T^00009^VISIT_IEN^0^0^0 +"DATA",90093.99,31,1,7,0) +.04^T^7^PRIMARY/SECONDARY^0^0^1 +"DATA",90093.99,32,0) +UPDATE PROV^9000010.06 +"DATA",90093.99,32,1,0) +^90093.991^4^4 +"DATA",90093.99,32,1,1,0) +.01^T^30^PROVIDER^0^0^0 +"DATA",90093.99,32,1,2,0) +.02^T^30^PATIENT NAME^0^0^0 +"DATA",90093.99,32,1,3,0) +.03^T^30^VISIT^0^0^0 +"DATA",90093.99,32,1,4,0) +.04^T^7^PRIMARY/SECONDARY^0^0^1 +"DATA",90093.99,33,0) +VIEW PROCEDURES^9000010.08 +"DATA",90093.99,33,1,0) +^90093.991^8^8 +"DATA",90093.99,33,1,1,0) +.01^T^30^PROCEDURE^0^0^0 +"DATA",90093.99,33,1,2,0) +.01IEN^T^00009^PROCEDURE_IEN^0^0^0 +"DATA",90093.99,33,1,3,0) +.02^T^30^PATIENT NAME^0^0^0 +"DATA",90093.99,33,1,4,0) +.02IEN^T^00009^PATIENT NAME_IEN^0^0^0 +"DATA",90093.99,33,1,5,0) +.03^T^30^VISIT^0^0^0 +"DATA",90093.99,33,1,6,0) +.03IEN^T^00009^VISIT_IEN^0^0^0 +"DATA",90093.99,33,1,7,0) +.05^T^30^DIAGNOSIS^0^0^1 +"DATA",90093.99,33,1,8,0) +.05IEN^T^00009^DIAGNOSIS_IEN^0^0^1 +"DATA",90093.99,34,0) +UPDATE PROCEDURES^9000010.08 +"DATA",90093.99,34,1,0) +^90093.991^4^4 +"DATA",90093.99,34,1,1,0) +.01^T^30^PROCEDURE^0^0^0 +"DATA",90093.99,34,1,2,0) +.02^T^30^PATIENT NAME^0^0^0 +"DATA",90093.99,34,1,3,0) +.03^T^30^VISIT^0^0^0 +"DATA",90093.99,34,1,4,0) +.05^T^30^DIAGNOSIS^0^0^1 +"DATA",90093.99,35,0) +VIEW CPT^9000010.18 +"DATA",90093.99,35,1,0) +^90093.991^6^6 +"DATA",90093.99,35,1,1,0) +.01^T^30^CPT^0^0^0 +"DATA",90093.99,35,1,2,0) +.01IEN^T^00009^CPT_IEN^0^0^0 +"DATA",90093.99,35,1,3,0) +.02^T^30^PATIENT NAME^0^0^0 +"DATA",90093.99,35,1,4,0) +.02IEN^T^00009^PATIENT NAME_IEN^0^0^0 +"DATA",90093.99,35,1,5,0) +.03^T^30^VISIT^0^0^0 +"DATA",90093.99,35,1,6,0) +.03IEN^T^00009^VISIT_IEN^0^0^0 +"DATA",90093.99,36,0) +UPDATE CPT^9000010.18 +"DATA",90093.99,36,1,0) +^90093.991^4^4 +"DATA",90093.99,36,1,1,0) +.01^T^30^CPT^0^0^0 +"DATA",90093.99,36,1,2,0) +.02^T^30^PATIENT NAME^0^0^0 +"DATA",90093.99,36,1,3,0) +.03^T^30^VISIT^0^0^0 +"DATA",90093.99,36,1,4,0) +.04^T^30^PROVIDER NARRATIVE^0^0^1 +"DATA",90093.99,37,0) +VIEW HEALTH FACTORS^9000019 +"DATA",90093.99,37,1,0) +^90093.991^5^5 +"DATA",90093.99,37,1,1,0) +.01^T^30^HEALTH FACTOR^0^0^0 +"DATA",90093.99,37,1,2,0) +.01IEN^T^00009^HEALTH FACTOR_IEN^0^0^0 +"DATA",90093.99,37,1,3,0) +.02^T^30^PATIENT NAME^0^0^0 +"DATA",90093.99,37,1,4,0) +.02IEN^T^00009^PATIENT NAME_IEN^0^0^0 +"DATA",90093.99,37,1,5,0) +.03^D^21^DATE NOTED^0^0^1 +"DATA",90093.99,38,0) +UPDATE HEALTH FACTORS^9000019 +"DATA",90093.99,38,1,0) +^90093.991^3^3 +"DATA",90093.99,38,1,1,0) +.01^T^30^HEALTH FACTOR^0^0^0 +"DATA",90093.99,38,1,2,0) +.02^T^30^PATIENT NAME^0^0^0 +"DATA",90093.99,38,1,3,0) +.03^D^21^DATE NOTED^0^0^1 +"DATA",90093.99,39,0) +UPDATE PROBLEMS^9000011 +"DATA",90093.99,39,1,0) +^90093.991^9^9 +"DATA",90093.99,39,1,1,0) +.01^T^30^DIAGNOSIS^0^0^0 +"DATA",90093.99,39,1,2,0) +.02^T^30^PATIENT NAME^0^0^0 +"DATA",90093.99,39,1,3,0) +.03^D^21^DATE LAST MODIFIED^0^0^1 +"DATA",90093.99,39,1,4,0) +.04^T^16^CLASS^0^0^1 +"DATA",90093.99,39,1,5,0) +.05^T^30^PROVIDER NARRATIVE^0^0^0 +"DATA",90093.99,39,1,6,0) +.06^T^30^FACILITY^0^0^0 +"DATA",90093.99,39,1,7,0) +.07^N^9^NMBR^0^0^0 +"DATA",90093.99,39,1,8,0) +.08^D^21^DATE ENTERED^0^0^1 +"DATA",90093.99,39,1,9,0) +.12^T^6^STATUS^0^0^0 +"DATA",90093.99,40,0) +WEIGHT^9000010.01 +"DATA",90093.99,40,1,0) +^90093.991^1^1 +"DATA",90093.99,40,1,1,0) +.02 +"DATA",90093.99,41,0) +VIEW PERSONAL HISTORY^9000013 +"DATA",90093.99,41,1,0) +^90093.991^8^8 +"DATA",90093.99,41,1,1,0) +.01^T^30^DIAGNOSIS^0^0^0 +"DATA",90093.99,41,1,2,0) +.01IEN^T^00009^DIAGNOSIS_IEN^0^0^0 +"DATA",90093.99,41,1,3,0) +.02^T^30^PATIENT NAME^0^0^0 +"DATA",90093.99,41,1,4,0) +.02IEN^T^00009^PATIENT NAME_IEN^0^0^0 +"DATA",90093.99,41,1,5,0) +.03^D^21^DATE NOTED^0^0^1 +"DATA",90093.99,41,1,6,0) +.04^T^30^PROVIDER NARRATIVE^0^0^1 +"DATA",90093.99,41,1,7,0) +.04IEN^T^00009^PROVIDER NARRATIVE_IEN^0^0^1 +"DATA",90093.99,41,1,8,0) +.05^D^21^DATE OF ONSET^0^0^1 +"DATA",90093.99,42,0) +UPDATE PERSONAL HISTORY^9000013 +"DATA",90093.99,42,1,0) +^90093.991^5^5 +"DATA",90093.99,42,1,1,0) +.01^T^30^DIAGNOSIS^0^0^0 +"DATA",90093.99,42,1,2,0) +.02^T^30^PATIENT NAME^0^0^0 +"DATA",90093.99,42,1,3,0) +.03^D^21^DATE NOTED^0^0^1 +"DATA",90093.99,42,1,4,0) +.04^T^30^PROVIDER NARRATIVE^0^0^0 +"DATA",90093.99,42,1,5,0) +.05^D^21^DATE OF ONSET^0^0^1 +"DATA",90093.99,43,0) +VIEW FAMILY HISTORY^9000014 +"DATA",90093.99,43,1,0) +^90093.991^7^7 +"DATA",90093.99,43,1,1,0) +.01^T^30^DIAGNOSIS^0^0^0 +"DATA",90093.99,43,1,2,0) +.01IEN^T^00009^DIAGNOSIS_IEN^0^0^0 +"DATA",90093.99,43,1,3,0) +.02^T^30^PATIENT NAME^0^0^0 +"DATA",90093.99,43,1,4,0) +.02IEN^T^00009^PATIENT NAME_IEN^0^0^0 +"DATA",90093.99,43,1,5,0) +.03^D^21^DATE NOTED^0^0^1 +"DATA",90093.99,43,1,6,0) +.04^T^30^PROVIDER NARRATIVE^0^0^0 +"DATA",90093.99,43,1,7,0) +.04IEN^T^00009^PROVIDER NARRATIVE_IEN^0^0^0 +"DATA",90093.99,44,0) +UPDATE FAMILY HISTORY^9000014 +"DATA",90093.99,44,1,0) +^90093.991^4^4 +"DATA",90093.99,44,1,1,0) +.01^T^30^DIAGNOSIS^0^0^0 +"DATA",90093.99,44,1,2,0) +.02^T^30^PATIENT NAME^0^0^0 +"DATA",90093.99,44,1,3,0) +.03^D^21^DATE NOTED^0^0^1 +"DATA",90093.99,44,1,4,0) +.04^T^30^PROVIDER NARRATIVE^0^0^0 +"DATA",90093.99,45,0) +VIEW REPRODUCTIVE FACTORS^9000017 +"DATA",90093.99,45,1,0) +^90093.991^7^7 +"DATA",90093.99,45,1,1,0) +.01^T^30^NAME^0^0^0 +"DATA",90093.99,45,1,2,0) +.01IEN^T^00009^NAME_IEN^0^0^0 +"DATA",90093.99,45,1,3,0) +1^T^18^REPRODUCTIVE HISTORY^0^0^1 +"DATA",90093.99,45,1,4,0) +1.1^D^21^DATE REPRO HX OBTAINED^0^0^1 +"DATA",90093.99,45,1,5,0) +3^T^25^CONTRACEPTION METHOD^0^0^1 +"DATA",90093.99,45,1,6,0) +3.05^D^21^CONTRACEPTION BEGUN^0^0^1 +"DATA",90093.99,45,1,7,0) +3.1^D^21^DATE METHOD HX OBTAINED^0^0^1 +"DATA",90093.99,46,0) +UPDATE REPRODUCTIVE FACTORS^9000017 +"DATA",90093.99,46,1,0) +^90093.991^6^6 +"DATA",90093.99,46,1,1,0) +.01^T^30^NAME^0^0^0 +"DATA",90093.99,46,1,2,0) +1^T^18^REPRODUCTIVE HISTORY^0^0^1 +"DATA",90093.99,46,1,3,0) +1.1^D^21^DATE REPRO HX OBTAINED^0^0^1 +"DATA",90093.99,46,1,4,0) +3^T^25^CONTRACEPTION METHOD^0^0^1 +"DATA",90093.99,46,1,5,0) +3.05^D^21^CONTRACEPTION BEGUN^0^0^1 +"DATA",90093.99,46,1,6,0) +3.1^D^21^DATE METHOD HX OBTAINED^0^0^1 +"DATA",90093.99,47,0) +MEASUREMENT^9000010.01 +"DATA",90093.99,47,1,0) +^90093.991^4^4 +"DATA",90093.99,47,1,1,0) +.02^T^30^PATIENT NAME^0^0^1 +"DATA",90093.99,47,1,2,0) +.03^T^30^VISIT^0^0^1 +"DATA",90093.99,47,1,3,0) +.01^T^30^TYPE^0^0^1 +"DATA",90093.99,47,1,4,0) +.04^T^100^VALUE^0^0^1 +"DATA",90093.99,48,0) +HORACE^2^0 +"DATA",90093.99,48,1,0) +^90093.991^5^5 +"DATA",90093.99,48,1,1,0) +.01^T^30^NAME^0^0^0 +"DATA",90093.99,48,1,2,0) +.02^T^4^SEX^0^0^1 +"DATA",90093.99,48,1,3,0) +.03^D^21^DOB^0^0^1 +"DATA",90093.99,48,1,4,0) +.05^T^30^MARITAL STATUS^0^0^1 +"DATA",90093.99,48,1,5,0) +.05IEN^T^00009^MARITAL STATUS_IEN^0^0^1 +"DATA",90093.99,49,0) +SELECT LAB TESTS^60 +"DATA",90093.99,49,1,0) +^90093.991^1^1 +"DATA",90093.99,49,1,1,0) +.01^T^40^NAME^0^0^0 +"DATA",90093.99,50,0) +UPDATE PROBLEM NUMBER^9000011 +"DATA",90093.99,50,1,0) +^90093.991^2^2 +"DATA",90093.99,50,1,1,0) +.07^N^9^NMBR^0^0^1 +"DATA",90093.99,50,1,2,0) +.12^T^6^STATUS^0^0^1 +"DATA",90093.99,51,0) +UPDATE VA PATIENT^2 +"DATA",90093.99,51,1,0) +^90093.991^4^4 +"DATA",90093.99,51,1,1,0) +.01^T^30^NAME^0^0^0 +"DATA",90093.99,51,1,2,0) +.02^T^4^SEX^0^0^0 +"DATA",90093.99,51,1,3,0) +.03^D^21^DATE OF BIRTH^0^0^0 +"DATA",90093.99,51,1,4,0) +.09^T^30^SOCIAL SECURITY NUMBER^0^0^0 +"DATA",90093.99,52,0) +FILEMAN FILES^1^1 +"DATA",90093.99,52,1,0) +^90093.991^2^2 +"DATA",90093.99,52,1,1,0) +.01^T^45^NAME^0^0^0 +"DATA",90093.99,52,1,2,0) +.01TRIGGER1^T^3^SUBFILES PRESENT?^1^0^1 +"DATA",90093.99,52,1,2,3) +SFT^BMXADOS1 +"DATA",90093.99,53,0) +SUBFILES^1^1 +"DATA",90093.99,53,1,0) +^90093.991^2^2 +"DATA",90093.99,53,1,1,0) +.01^T^45^NAME^0^0^0 +"DATA",90093.99,53,1,2,0) +.01TRIGGER1^T^3^SUBFILES PRESENT?^1^0^1 +"DATA",90093.99,53,1,2,3) +SFT^BMXADOS1 +"DATA",90093.99,54,0) +FIELDS^1^1 +"DATA",90093.99,54,1,0) +^90093.991^8^8 +"DATA",90093.99,54,1,1,0) +.01^T^45^NAME^0^0^0 +"DATA",90093.99,54,1,2,0) +.001TRIGGER1^T^7^DATA TYPE^1^0^0 +"DATA",90093.99,54,1,2,3) +DDT^BMXADOS1 +"DATA",90093.99,54,1,3,0) +.01X2^T^8^DEFAULT DATA TYPE^1^0^1 +"DATA",90093.99,54,1,4,0) +.01X3^I^5^DEFAULT FIELD LENGTH^1^0^1 +"DATA",90093.99,54,1,5,0) +.01X4^T^40^DEFAULT HEADER^1^0^1 +"DATA",90093.99,54,1,6,0) +.01X5^T^3^DEFAULT READ ONLY SETTING^1^0^1 +"DATA",90093.99,54,1,7,0) +.01X6^T^3^DEFAULT KEY FIELD SETTING^1^0^1 +"DATA",90093.99,54,1,8,0) +.01X7^T^3^DEFAULT NULL ALLOWED SETTING^1^0^1 +"DATA",90093.99,55,0) +SCHEMAS^90093.99 +"DATA",90093.99,55,1,0) +^90093.991^3^3 +"DATA",90093.99,55,1,1,0) +.01^T^30^SCHEMA^0^0^0 +"DATA",90093.99,55,1,2,0) +.02^N^15^FILE OR SUBFILE NUMBER^0^0^0 +"DATA",90093.99,55,1,3,0) +.03^T^5^DATASET IS READ ONLY^0^0^1 +"DATA",90093.99,56,0) +SCHEMA DEFINITION^90093.991^0 +"DATA",90093.99,56,1,0) +^90093.991^12^12 +"DATA",90093.99,56,1,1,0) +.01^T^30^FIELD NUMBER^0^0^0 +"DATA",90093.99,56,1,2,0) +.02^T^4^DATA TYPE^0^0^0 +"DATA",90093.99,56,1,3,0) +.03^T^5^FIELD LENGTH^0^0^0 +"DATA",90093.99,56,1,4,0) +.04^T^30^COLUMN HEADER^0^0^0 +"DATA",90093.99,56,1,5,0) +.05^T^3^READ ONLY^0^0^0 +"DATA",90093.99,56,1,6,0) +.06^T^3^KEY FIELD^0^0^0 +"DATA",90093.99,56,1,7,0) +.07^T^3^NULL ALLOWED^0^0^0 +"DATA",90093.99,56,1,8,0) +.08^T^3^IEN AUTOMATICALLY INCLUDED^0^0^1 +"DATA",90093.99,56,1,9,0) +.09^T^3^ALWAYS GET INTERNAL VALUE^0^0^1 +"DATA",90093.99,56,1,10,0) +1^T^19^AUTO IDENTIFIER EXTR FUNCT^0^0^1 +"DATA",90093.99,56,1,11,0) +2^T^19^SPECIAL UPDATE EP^0^0^1 +"DATA",90093.99,56,1,12,0) +3^T^17^EXTR FUNCT FOR TRIGGERED VALUE^0^0^1 +"DATA",90093.99,57,0) +FILEMAN FILEINFO^1 +"DATA",90093.99,57,1,0) +^90093.991^1^1 +"DATA",90093.99,57,1,1,0) +.01^T^45^NAME^0^0^0 +"DATA",90093.99,58,0) +BMXADO VIEW MEASUREMENTS^9000010.01^1 +"DATA",90093.99,58,1,0) +^90093.991^5^5 +"DATA",90093.99,58,1,1,0) +.01^T^6^MEASUREMENT MNEMONIC^1^0^0 +"DATA",90093.99,58,1,2,0) +.02^T^15^PATIENT LOOKUP VALUE^1^0^0 +"DATA",90093.99,58,1,3,0) +.03^T^15^VISIT LOOKUP VALUE^1^0^0 +"DATA",90093.99,58,1,4,0) +.04^T^30^VALUE^1^0^1 +"DATA",90093.99,58,1,5,0) +.01X^T^30^MEASUREMENT^1^0^0 +"DATA",90093.99,59,0) +VEN MOJO DE MEASUREMENT^19707.82 +"DATA",90093.99,59,1,0) +^90093.991^20^10 +"DATA",90093.99,59,1,3,0) +2.01^T^9^MEASUREMENT TYPE^0^0^0 +"DATA",90093.99,59,1,4,0) +2.03^T^30^MEASUREMENT^0^0^1 +"DATA",90093.99,59,1,5,0) +2.02^T^30^MEASUREMENT VALUE^0^0^1 +"DATA",90093.99,59,1,13,0) +.01TRIGGER3^T^30^ERROR CELL^1^0^1 +"DATA",90093.99,59,1,13,3) +ECELL^VENPCCTG +"DATA",90093.99,59,1,15,0) +.01^I^15^TRANSACTION ID^0^0^1 +"DATA",90093.99,59,1,16,0) +.02IEN^I^3^SEGMENT IEN^1^0^1 +"DATA",90093.99,59,1,17,0) +.03^T^20^TID-SID^0^0^1 +"DATA",90093.99,59,1,18,0) +100^T^80^COMMENT^1^0^0 +"DATA",90093.99,59,1,19,0) +.001TRIGGER1^I^4^MEASUREMENT IEN^0^0^1 +"DATA",90093.99,59,1,19,3) +IEN^VENPCCTG +"DATA",90093.99,59,1,20,0) +999^T^1^NEW ROW^0^0^1 +"DATA",90093.99,60,0) +VEN MOJO DE INTRO^19707.82^1 +"DATA",90093.99,60,1,0) +^90093.991^24^18 +"DATA",90093.99,60,1,1,0) +.01^T^30^TRANSACTION ID^0^0^0 +"DATA",90093.99,60,1,5,0) +.05^T^30^PATIENT NAME^0^0^1 +"DATA",90093.99,60,1,6,0) +.06^T^6^SEX^0^0^1 +"DATA",90093.99,60,1,7,0) +.07^T^10^DOB^0^0^1 +"DATA",90093.99,60,1,8,0) +.08^T^15^CHART NUMBER^0^0^1 +"DATA",90093.99,60,1,9,0) +.09^T^11^SSN^0^0^1 +"DATA",90093.99,60,1,10,0) +99.01^T^15^VCN^0^0^1 +"DATA",90093.99,60,1,11,0) +99.02^T^20^VISIT TIMESTAMP^0^0^1 +"DATA",90093.99,60,1,13,0) +99.04^T^30^VISIT TYPE^0^0^1 +"DATA",90093.99,60,1,14,0) +99.05^T^30^SERVICE CAT^0^0^1 +"DATA",90093.99,60,1,15,0) +99.06^T^30^CLINIC^0^0^1 +"DATA",90093.99,60,1,18,0) +99.09^T^30^FACILITY NAME^0^0^1 +"DATA",90093.99,60,1,19,0) +99.1^D^21^DATE VISIT CREATED^0^0^1 +"DATA",90093.99,60,1,20,0) +99.11^D^21^LAST MODIFIED^0^0^1 +"DATA",90093.99,60,1,21,0) +100^T^240^COMMENT^0^0^1 +"DATA",90093.99,60,1,22,0) +98.01^T^30^FORM^0^0^1 +"DATA",90093.99,60,1,23,0) +97.01^T^99^ImagePage1^0^0^1 +"DATA",90093.99,60,1,24,0) +97.02^T^99^ImagePage2^0^0^1 +"DATA",90093.99,61,0) +GREG2^9000010^1 +"DATA",90093.99,61,1,0) +^90093.991^4^4 +"DATA",90093.99,61,1,1,0) +.01^D^15^VISIT/ADMIT DATE&TIME^1^0^0 +"DATA",90093.99,61,1,2,0) +.02^D^15^DATE VISIT CREATED^1^0^0 +"DATA",90093.99,61,1,3,0) +.05^T^30^PATIENT NAME^1^0^0 +"DATA",90093.99,61,1,4,0) +.08^T^40^CLINIC^0^0^0 +"DATA",90093.99,62,0) +HW OPTION SCHEDULING^19.2^1 +"DATA",90093.99,62,1,0) +^90093.991^4^4 +"DATA",90093.99,62,1,1,0) +.01^T^30^NAME^1^0^0^0 +"DATA",90093.99,62,1,2,0) +2^T^30^QUEUED TO RUN AT WHAT TIME^1^0^1^0 +"DATA",90093.99,62,1,3,0) +6^T^30^RESCHEDULING FREQUENCY^0^0^1^0 +"DATA",90093.99,62,1,4,0) +9^T^30^SPECIAL QUEUEING^0^0^1^0 +"DATA",90093.99,63,0) +HW SD DEVICE1^3.5^1 +"DATA",90093.99,63,1,0) +^90093.991^8^8 +"DATA",90093.99,63,1,1,0) +.01^T^30^NAME^1 +"DATA",90093.99,63,1,2,0) +1^T^30^$I^1 +"DATA",90093.99,63,1,3,0) +2^T^30^TYPE^1 +"DATA",90093.99,63,1,4,0) +3^T^30^SUBTYPE^1 +"DATA",90093.99,63,1,5,0) +4^T^30^ASK DEVICE^0 +"DATA",90093.99,63,1,6,0) +5^T^30^ASK PARAMETERS^0 +"DATA",90093.99,63,1,7,0) +7^T^30^NEAREST PHONE^0 +"DATA",90093.99,63,1,8,0) +8^T^30^KEY OPERATOR^0^^1 +"DATA",90093.99,64,0) +HW SD NEW PERSON^200^1 +"DATA",90093.99,64,1,0) +^90093.991^6^6 +"DATA",90093.99,64,1,1,0) +.01^T^30^NAME^0^0 +"DATA",90093.99,64,1,2,0) +1^T^30^INITIAL^0^0 +"DATA",90093.99,64,1,3,0) +4^T^30^SEX^0^0 +"DATA",90093.99,64,1,4,0) +5^D^15^DOB^0^0 +"DATA",90093.99,64,1,5,0) +9^T^30^SSN^0^0 +"DATA",90093.99,64,1,6,0) +13^T^30^NICK NAME^0^0 +"DATA",90093.99,65,0) +HW SD VISIT1^9000010^1 +"DATA",90093.99,65,1,0) +^90093.991^3^3 +"DATA",90093.99,65,1,1,0) +.01^D^20^VISIT/ADMIT DATE&TIME^1^0^0 +"DATA",90093.99,65,1,2,0) +.05^T^30^PATIENT NAME^1^0^0 +"DATA",90093.99,65,1,3,0) +.08^T^30^CLINIC^1^0^0 +"DATA",90093.99,66,0) +ScottsdaleDemo^9000001^1 +"DATA",90093.99,66,1,0) +^90093.991^3^3 +"DATA",90093.99,66,1,1,0) +.01^T^30^NAME^1^0^0 +"DATA",90093.99,66,1,2,0) +1102.2^D^30^DOB^1^0^1 +"DATA",90093.99,66,1,3,0) +1101.2^T^30^SEX^0^0^1 +"DATA",90093.99,67,0) +BMXADO MEASUREMENT TYPES^9999999.07 +"DATA",90093.99,67,1,0) +^90093.991^3^3 +"DATA",90093.99,67,1,1,0) +.02^T^30^MEASUREMENT NAME^0^0^0 +"DATA",90093.99,67,1,2,0) +.01^T^4^MEASUREMENT MNEMONIC^0^0^0 +"DATA",90093.99,67,1,3,0) +.03^T^2^CODE^0^0^0 +"DATA",90093.99,68,0) +BMXADO DX^19707.82^1 +"DATA",90093.99,68,1,0) +^90093.991^16^16 +"DATA",90093.99,68,1,1,0) +.01^T^7^ACTION^0^0^0 +"DATA",90093.99,68,1,2,0) +.02^T^30^PATIENT IEN^0^0^0^^1 +"DATA",90093.99,68,1,3,0) +.03^T^30^VISIT IEN^0^0^0 +"DATA",90093.99,68,1,4,0) +.04^D^21^VISIT DATE^0^0^0 +"DATA",90093.99,68,1,5,0) +.05^T^30^ICD IEN^0^0^1^^1 +"DATA",90093.99,68,1,6,0) +.06^T^9^ICD CODE^0^0^1 +"DATA",90093.99,68,1,7,0) +.07^T^30^FACILITY IEN^0^0^1^^1 +"DATA",90093.99,68,1,8,0) +.08^T^30^FACILITY ABBR^0^0^1 +"DATA",90093.99,68,1,9,0) +.09^I^3^PROBLEM NUMBER^0^0^1 +"DATA",90093.99,68,1,10,0) +.1^T^30^PROBLEM IEN^0^0^1^^1 +"DATA",90093.99,68,1,11,0) +.11^I^2^NOTE NUMBER^0^0^1 +"DATA",90093.99,68,1,12,0) +.12^I^3^NOTE IEN^0^0^1^^1 +"DATA",90093.99,68,1,13,0) +.13^I^2^FAC NOTE IEN^0^0^1^^1 +"DATA",90093.99,68,1,14,0) +.14^T^80^PROVIDER NARRATIVE^0^0^1 +"DATA",90093.99,68,1,15,0) +.15^I^2^PRIMARY-SECONDARY^0^0^1 +"DATA",90093.99,68,1,16,0) +.16^T^6^PROBLEM STATUS^0^0^1 +"DATA",90093.99,69,0) +BMXADO ADD POV^9000010.07 +"DATA",90093.99,69,1,0) +^90093.991^5^5 +"DATA",90093.99,69,1,1,0) +.01^T^9^ICD CODE^0^0^0 +"DATA",90093.99,69,1,2,0) +.02^T^15^PATIENT LOOKUP VALUE^0^0^0 +"DATA",90093.99,69,1,3,0) +.03^T^15^VISIT LOOKUP VALUE^0^0^0 +"DATA",90093.99,69,1,4,0) +.04^T^80^PROVIDER NARRATIVE^0^0^0 +"DATA",90093.99,69,1,5,0) +.12^T^2^PRIMARY-SECONDARY^0^0^1 +"DATA",90093.99,70,0) +BMXADO ADD PROBLEM^9000011 +"DATA",90093.99,70,1,0) +^90093.991^7^7 +"DATA",90093.99,70,1,1,0) +.01^T^9^ICD CODE^0^0^0 +"DATA",90093.99,70,1,2,0) +.02^T^15^PATIENT LOOKUP VALUE^0^0^0 +"DATA",90093.99,70,1,3,0) +.03^D^15^DATE LAST MODIFIED^0^0^0 +"DATA",90093.99,70,1,4,0) +.05^T^80^PROVIDER NARRATIVE^0^0^0 +"DATA",90093.99,70,1,5,0) +.06^T^15^FACILITY LOOKUP VALUE^0^0^0 +"DATA",90093.99,70,1,6,0) +.08^D^15^DATE ENTERED^0^0^0 +"DATA",90093.99,70,1,7,0) +.12^T^6^STATUS^0^0^0 +"DATA",90093.99,71,0) +BMXADO EDIT PROBLEM^9000011 +"DATA",90093.99,71,1,0) +^90093.991^4^4 +"DATA",90093.99,71,1,1,0) +.01^T^9^ICD CODE^0^0^0 +"DATA",90093.99,71,1,2,0) +.03^D^15^DATE LAST MODIFIED^0^0^0 +"DATA",90093.99,71,1,3,0) +.05^T^80^PROVIDER NARRATIVE^0^0^0 +"DATA",90093.99,71,1,4,0) +.12^T^6^PROBLEM STATUS^0^0^0 +"DATA",90093.99,72,0) +BMXADO ADD FHX^9000014 +"DATA",90093.99,72,1,0) +^90093.991^4^4 +"DATA",90093.99,72,1,1,0) +.01^T^9^ICD CODE^0^0^0 +"DATA",90093.99,72,1,2,0) +.02^T^15^PATIENT LOOKUP VALUE^0^0^0 +"DATA",90093.99,72,1,3,0) +.03^D^15^DATE NOTED^0^0^0 +"DATA",90093.99,72,1,4,0) +.04^T^80^PROVIDER NARRATIVE^0^0^0 +"DATA",90093.99,73,0) +BMXADO ADD PERSONAL HISTORY^9000013 +"DATA",90093.99,73,1,0) +^90093.991^4^4 +"DATA",90093.99,73,1,1,0) +.01^T^9^ICD CODE^0^0^0 +"DATA",90093.99,73,1,2,0) +.02^T^15^PATIENT LOOKUP VALUE^0^0^0 +"DATA",90093.99,73,1,3,0) +.03^D^15^DATE NOTED^0^0^0 +"DATA",90093.99,73,1,4,0) +.04^T^80^PROVIDER NARRATIVE^0^0^0 +"DATA",90093.99,74,0) +BMXADO ADD NOTE^9000011.1111 +"DATA",90093.99,74,1,0) +^90093.991^1^1 +"DATA",90093.99,74,1,1,0) +.03^T^44^NOTE^0^0^0 +"DATA",90093.99,75,0) +BMXADO DATA ENTRY TRANSACTION^19707.82 +"DATA",90093.99,75,1,0) +^90093.991^21^21 +"DATA",90093.99,75,1,1,0) +.01^T^30^TRANSACTION ID^0^0^0 +"DATA",90093.99,75,1,2,0) +.02^T^30^SEGMENT^0^0^0 +"DATA",90093.99,75,1,3,0) +.03^T^3^ACCEPT NON FATAL ERRORS^0^0^1 +"DATA",90093.99,75,1,4,0) +1.01^T^7^DX ACTION^0^0^1 +"DATA",90093.99,75,1,5,0) +1.02^T^30^PATIENT IEN^0^0^1 +"DATA",90093.99,75,1,6,0) +1.03^T^30^VISIT IEN^0^0^1 +"DATA",90093.99,75,1,7,0) +1.04^D^21^VISIT DATE^0^0^1 +"DATA",90093.99,75,1,8,0) +1.05^T^30^ICD IEN^0^0^1 +"DATA",90093.99,75,1,9,0) +1.06^T^9^ICD CODE^0^0^1 +"DATA",90093.99,75,1,10,0) +1.07^T^30^FACILITY IEN^0^0^1 +"DATA",90093.99,75,1,11,0) +1.08^T^9^FACILITY ABBREVIATION^0^0^1 +"DATA",90093.99,75,1,12,0) +1.09^I^3^PROBLEM NUMBER^0^0^1 +"DATA",90093.99,75,1,13,0) +1.1^T^30^PROBLEM IEN^0^0^1 +"DATA",90093.99,75,1,14,0) +1.11^I^2^NOTE NUMBER^0^0^1 +"DATA",90093.99,75,1,15,0) +1.12^I^3^NOTE IEN^0^0^1 +"DATA",90093.99,75,1,16,0) +1.13^I^2^FAC-NOTE IEN^0^0^1 +"DATA",90093.99,75,1,17,0) +1.14^T^80^PROVIDER NARRATIVE^0^0^1 +"DATA",90093.99,75,1,18,0) +1.15^I^2^PRIMARY-SECONDARY^0^0^1 +"DATA",90093.99,75,1,19,0) +1.16^T^6^PROBLEM STATUS^0^0^1 +"DATA",90093.99,75,1,20,0) +2.01^T^30^MEASUREMENT TYPE^0^0^1 +"DATA",90093.99,75,1,21,0) +2.02^T^80^MEASUREMENT VALUE^0^0^1 +"DATA",90093.99,76,0) +VEN MOJO DE CLINIC^19707.82 +"DATA",90093.99,76,1,0) +^90093.991^17^8 +"DATA",90093.99,76,1,7,0) +3.01^I^4^CLINIC IEN^0^0^0 +"DATA",90093.99,76,1,8,0) +3.02^T^30^CLINIC^0^0^0 +"DATA",90093.99,76,1,11,0) +.01TRIGGER3^T^30^ERROR CELL^1^0^1 +"DATA",90093.99,76,1,11,3) +ECELL^VENPCCTG +"DATA",90093.99,76,1,13,0) +.01^I^15^TRANSACTION ID^0^0^1 +"DATA",90093.99,76,1,14,0) +.02IEN^I^3^SEGMENT IEN^1^0^1 +"DATA",90093.99,76,1,15,0) +.03^T^20^TID-SID^0^0^1 +"DATA",90093.99,76,1,16,0) +100^T^80^COMMENT^1^0^0 +"DATA",90093.99,76,1,17,0) +999^T^1^NEW ROW^0^0^1 +"DATA",90093.99,77,0) +VEN MOJO DE PROVIDER^19707.82 +"DATA",90093.99,77,1,0) +^90093.991^18^9 +"DATA",90093.99,77,1,7,0) +4.01^I^5^PROVIDER IEN^0^0^0 +"DATA",90093.99,77,1,8,0) +4.02^T^30^PROVIDER^0^0^0 +"DATA",90093.99,77,1,11,0) +.01TRIGGER3^T^30^ERROR CELL^1^0^1 +"DATA",90093.99,77,1,11,3) +ECELL^VENPCCTG +"DATA",90093.99,77,1,13,0) +4.03^T^12^PRIMARY OR SECONDARY^0^0^1 +"DATA",90093.99,77,1,14,0) +.01^I^15^TRANSACTION ID^0^0^1 +"DATA",90093.99,77,1,15,0) +.02IEN^I^3^SEGMENT IEN^1^0^1 +"DATA",90093.99,77,1,16,0) +.03^T^20^TID-SID^0^0^1 +"DATA",90093.99,77,1,17,0) +100^T^80^COMMENT^1^0^0 +"DATA",90093.99,77,1,18,0) +999^T^1^NEW ROW^0^0^1 +"DATA",90093.99,78,0) +VEN MOJO LIST PENDING FORMS^19707.81^1 +"DATA",90093.99,78,1,0) +^90093.991^4^4 +"DATA",90093.99,78,1,1,0) +.01^T^30^VISIT^0^0^0 +"DATA",90093.99,78,1,2,0) +.02^D^21^VISIT DATE^0^0^1 +"DATA",90093.99,78,1,3,0) +.03^T^30^PATIENT^0^0^1 +"DATA",90093.99,78,1,4,0) +.04^T^30^LOCATION^0^0^1 +"DATA",90093.99,79,0) +VEN MOJO LIST DE FIFO^19707.81 +"DATA",90093.99,79,1,0) +^90093.991^3^2 +"DATA",90093.99,79,1,1,0) +.01^T^30^VISIT^0^0^0 +"DATA",90093.99,79,1,3,0) +.03^T^30^PATIENT^0^0^0 +"DATA",90093.99,80,0) +VEN MOJO DRUG LIST^50 +"DATA",90093.99,80,1,0) +^90093.991^2^2 +"DATA",90093.99,80,1,1,0) +.01^T^40^GENERIC NAME^0^0^0 +"DATA",90093.99,80,1,2,0) +5^T^60^STANDARD SIG^0^0^1 +"DATA",90093.99,81,0) +VEN MOJO RX LIST^9000010.14 +"DATA",90093.99,81,1,0) +^90093.991^5^5 +"DATA",90093.99,81,1,1,0) +.01^T^30^MEDICATION^0^0^0 +"DATA",90093.99,81,1,2,0) +.01IEN^I^00009^MEDICATION_IEN^0^0^0 +"DATA",90093.99,81,1,3,0) +.06^I^7^QUANTITY^0^0^1 +"DATA",90093.99,81,1,4,0) +.05^T^32^SIG^0^0^1 +"DATA",90093.99,81,1,5,0) +.03^T^30^VISIT^0^0^0 +"DATA",90093.99,82,0) +VEN MOJO LIST PROVIDERS^200^1 +"DATA",90093.99,82,1,0) +^90093.991^2^2 +"DATA",90093.99,82,1,1,0) +.01^T^35^LABEL^0^0^0 +"DATA",90093.99,82,1,2,0) +.001TRIGGER1^I^9^IEN^1^0^1 +"DATA",90093.99,82,1,2,3) +IEN^VENPCCTG +"DATA",90093.99,83,0) +VEN MOJO LIST CLINICS^40.7 +"DATA",90093.99,83,1,0) +^90093.991^4^4 +"DATA",90093.99,83,1,1,0) +.01^T^30^CLINIC NAME^0^0^0 +"DATA",90093.99,83,1,2,0) +1^T^2^CLINIC CODE^0^0^0 +"DATA",90093.99,83,1,3,0) +.001TRIGGER2^I^9^CLINIC NAME IEN^1^0^1 +"DATA",90093.99,83,1,3,3) +IEN^VENPCCTG +"DATA",90093.99,83,1,4,0) +.001TRIGGER1^T^36^LABEL^1^0^1 +"DATA",90093.99,83,1,4,3) +CLNN^VENPCCTG +"DATA",90093.99,84,0) +VEN MOJO LIST MEASUREMENTS^9999999.07^1 +"DATA",90093.99,84,1,0) +^90093.991^3^3 +"DATA",90093.99,84,1,1,0) +.01^T^4^MEASUREMENT TYPE^1^0^0 +"DATA",90093.99,84,1,2,0) +.02^T^30^LABEL^1^0^0 +"DATA",90093.99,84,1,3,0) +.001TRIGGER1^I^9^IEN^1^0^1 +"DATA",90093.99,84,1,3,3) +IEN^VENPCCTG +"DATA",90093.99,85,0) +VEN MOJO DE FMT UHC^19707.47 +"DATA",90093.99,85,1,0) +^90093.991^1^1 +"DATA",90093.99,85,1,1,0) +.01^T^30^HIDDEN COLUMN NAME^0^0^0 +"DATA",90093.99,86,0) +VEN MOJO DE DX PROBLEM^9000011 +"DATA",90093.99,86,1,0) +^90093.991^5^5 +"DATA",90093.99,86,1,1,0) +.01^T^9^ICD CODE^0^0^1 +"DATA",90093.99,86,1,2,0) +.05^T^80^PROVIDER NARRATIVE^0^0^1 +"DATA",90093.99,86,1,3,0) +.12^T^6^PROBLEM STATUS^0^0^0 +"DATA",90093.99,86,1,4,0) +.001TRIGGER1^I^15^PROBLEM IEN^0^0^0 +"DATA",90093.99,86,1,4,3) +PRBIEN^VENPCCTG +"DATA",90093.99,86,1,5,0) +.01IEN^I^15^ICD IEN^0^0^1 +"DATA",90093.99,87,0) +VEN MOJO DE DX DXHX^19707.82 +"DATA",90093.99,87,1,0) +^90093.991^22^20 +"DATA",90093.99,87,1,1,0) +.01^T^30^TRANSACTION ID^0^0^0 +"DATA",90093.99,87,1,2,0) +.02IEN^I^3^SEGMENT IEN^1^0^0 +"DATA",90093.99,87,1,3,0) +1.02^T^30^ACTION^0^0^1 +"DATA",90093.99,87,1,5,0) +1.05^I^15^ICD IEN^0^0^1 +"DATA",90093.99,87,1,6,0) +1.14^T^80^PROVIDER NARRATIVE^0^0^1 +"DATA",90093.99,87,1,7,0) +1.06^T^9^ICD CODE^0^0^1 +"DATA",90093.99,87,1,8,0) +1.15^T^9^P/S^0^0^1 +"DATA",90093.99,87,1,9,0) +1.18^T^3^ADD TO PROBLEM LIST^0^0^1 +"DATA",90093.99,87,1,10,0) +1.16^T^6^PROBLEM STATUS^0^0^1 +"DATA",90093.99,87,1,12,0) +.01TRIGGER3^T^60^ERROR CELL^1^0^1 +"DATA",90093.99,87,1,12,3) +ECELL^VENPCCTG +"DATA",90093.99,87,1,13,0) +1.1^T^15^PROBLEM IEN^0^0^1 +"DATA",90093.99,87,1,14,0) +.03^T^20^TID-SID^0^0^1 +"DATA",90093.99,87,1,15,0) +1.11^I^2^NOTE NUMBER^0^0^1 +"DATA",90093.99,87,1,16,0) +1.12^I^3^NOTE IEN^0^0^1 +"DATA",90093.99,87,1,17,0) +1.13^I^2^FAC-NOTE IEN^0^0^1 +"DATA",90093.99,87,1,18,0) +1.17^T^44^NOTE NARRATIVE^0^0^1 +"DATA",90093.99,87,1,19,0) +1.21^T^10^NOTE STATUS^0^0^1 +"DATA",90093.99,87,1,20,0) +99.01^T^9^NOTE FACILITY^1^0^1 +"DATA",90093.99,87,1,21,0) +999^T^1^NEW ROW^0^0^1 +"DATA",90093.99,87,1,22,0) +100^T^240^COMMENT^0^0^1 +"DATA",90093.99,88,0) +VEN MOJO DE DX NOTE^19707.82^1 +"DATA",90093.99,88,1,0) +^90093.991^11^11 +"DATA",90093.99,88,1,1,0) +.001FAC^T^9^NOTE FACILITY^1^0^1 +"DATA",90093.99,88,1,2,0) +.01^T^3^NOTE NUMBER^1^0^1 +"DATA",90093.99,88,1,3,0) +.03^T^44^NOTE NARRATIVE^1^0^1 +"DATA",90093.99,88,1,4,0) +.001DA2^I^15^PROBLEM IEN^1^0^1 +"DATA",90093.99,88,1,5,0) +.001DA1^I^3^FAC-NOTE IEN^1^0^1 +"DATA",90093.99,88,1,6,0) +.001DA^I^3^NOTE IEN^1^0^1 +"DATA",90093.99,88,1,7,0) +99ICD^T^9^ICD CODE^1^0^1 +"DATA",90093.99,88,1,8,0) +.04^T^9^NOTE STATUS^1^0^1 +"DATA",90093.99,88,1,9,0) +99.01^I^15^TRANSACTION ID^1^0^1 +"DATA",90093.99,88,1,10,0) +99.02^T^20^TID-SID^1^0^1 +"DATA",90093.99,88,1,11,0) +99.03^T^20^ACTION^1^0^1 +"DATA",90093.99,89,0) +VEN MOJO DE FMT GRID^19707.48 +"DATA",90093.99,89,1,0) +^90093.991^7^7 +"DATA",90093.99,89,1,1,0) +.01^T^30^SCHEMA^0^0^0 +"DATA",90093.99,89,1,2,0) +.02^T^3^ADD MODE^0^0^1 +"DATA",90093.99,89,1,3,0) +.03^T^4^STYLE^0^0^1 +"DATA",90093.99,89,1,4,0) +1^T^240^HIDE COLUMN^0^0^1 +"DATA",90093.99,89,1,5,0) +2^T^240^BLOCK CELL^0^0^1 +"DATA",90093.99,89,1,6,0) +3^T^240^COMBO BOX^0^0^1 +"DATA",90093.99,89,1,7,0) +4^T^240^COLUMN WIDTH^0^0^1 +"DATA",90093.99,90,0) +VEN MOJO DE ICD MATCH^80 +"DATA",90093.99,90,1,0) +^90093.991^3^3 +"DATA",90093.99,90,1,1,0) +.01^T^7^ICD CODE^0^0^0 +"DATA",90093.99,90,1,2,0) +3^T^30^DIAGNOSIS^0^0^1 +"DATA",90093.99,90,1,3,0) +10^T^250^DESCRIPTION^0^0^1 +"DATA",90093.99,91,0) +VEN MOJO DE SEGMENT^19707.44 +"DATA",90093.99,91,1,0) +^90093.991^2^2 +"DATA",90093.99,91,1,1,0) +.01^T^30^NAME^0^0^0 +"DATA",90093.99,91,1,2,0) +.03^T^30^SCHEMA^0^0^1 +"DATA",90093.99,92,0) +VEN MOJO DE SEG IMAGE^19707.461 +"DATA",90093.99,92,1,0) +^90093.991^7^7 +"DATA",90093.99,92,1,1,0) +.01^T^30^SEGMENT^0^0^0 +"DATA",90093.99,92,1,2,0) +.02^I^1^PAGE^0^0^1 +"DATA",90093.99,92,1,3,0) +.03^I^3^X POSITION^0^0^1 +"DATA",90093.99,92,1,4,0) +.04^I^3^Y POSITION^0^0^1 +"DATA",90093.99,92,1,5,0) +.05^I^3^WIDTH^0^0^1 +"DATA",90093.99,92,1,6,0) +.06^I^3^HEIGHT^0^0^1 +"DATA",90093.99,92,1,7,0) +.01TRIGGER1^N^3^SEGMENT IEN^0^0^1 +"DATA",90093.99,92,1,7,3) +IEN^VENPCCTG +"DATA",90093.99,93,0) +VEN MOJO CHECKIN PATIENTS^2^1 +"DATA",90093.99,93,1,0) +^90093.991^6^6 +"DATA",90093.99,93,1,1,0) +.01^T^30^NAME^0^0^0 +"DATA",90093.99,93,1,2,0) +.02^T^4^SEX^0^0^0^^1 +"DATA",90093.99,93,1,3,0) +.03^D^21^DOB^0^0^0 +"DATA",90093.99,93,1,4,0) +.09^T^30^SSN^0^0^1 +"DATA",90093.99,93,1,5,0) +.001TRIGGER1^T^20^CHART +"DATA",90093.99,93,1,5,3) +HRN^BMXADOV2 +"DATA",90093.99,93,1,6,0) +.001TRIGGER2^T^20^PATIENT IEN^1^0^1 +"DATA",90093.99,94,0) +VEN MOJO CHECKIN CLINICS^19707.95^1 +"DATA",90093.99,94,1,0) +^90093.991^4^4 +"DATA",90093.99,94,1,1,0) +.01^T^30^CLINIC^0^0^0 +"DATA",90093.99,94,1,2,0) +.001TRIGGER1^I^4^CLINIC IEN^1^0^1 +"DATA",90093.99,94,1,2,3) +IEN^VENPCCTG +"DATA",90093.99,94,1,3,0) +2.05^T^30^DEFAULT ENCOUNTER FORM^0^0^1 +"DATA",90093.99,94,1,4,0) +2.02^T^30^DEFAULT PROVIDER^0^0^1 +"DATA",90093.99,95,0) +VEN MOJO CHECKIN PROVIDERS^200^1 +"DATA",90093.99,95,1,0) +^90093.991^3^3 +"DATA",90093.99,95,1,1,0) +.01^T^35^PROVIDER^0^0^0 +"DATA",90093.99,95,1,2,0) +9999999.02^T^3^CODE^0^0^0 +"DATA",90093.99,95,1,3,0) +.001TRIGGER1^I^15^PROVIDER IEN^1^0^1 +"DATA",90093.99,95,1,3,3) +IEN^VENPCCTG +"DATA",90093.99,96,0) +VEN MOJO CHECKIN FORMS^19707.41^1 +"DATA",90093.99,96,1,0) +^90093.991^4^4 +"DATA",90093.99,96,1,1,0) +.01^T^30^FORM^0^0^0 +"DATA",90093.99,96,1,2,0) +.001TRIGGER1^I^4^FORM IEN^1^0^1 +"DATA",90093.99,96,1,2,3) +IEN^VENPCCTG +"DATA",90093.99,96,1,3,0) +11.01^T^30^FORM ID^0^0^1 +"DATA",90093.99,96,1,4,0) +11.02^T^3^DIGITAL VERSION ONLY^0^0^1 +"DATA",90093.99,97,0) +VEN MOJO LIST TABLET QUEUE^19707.23^1 +"DATA",90093.99,97,1,0) +^90093.991^13^13 +"DATA",90093.99,97,1,1,0) +.01^T^30^PATIENT NAME^0^0^0 +"DATA",90093.99,97,1,2,0) +.02^T^4^SEX^0^0^1 +"DATA",90093.99,97,1,3,0) +.03^D^21^DOB^0^0^1 +"DATA",90093.99,97,1,4,0) +.04^T^20^CHART NUMBER^0^0^1 +"DATA",90093.99,97,1,5,0) +.05^D^21^TIMESTAMP^0^0^1 +"DATA",90093.99,97,1,6,0) +.06^T^7^STATUS^0^0^1 +"DATA",90093.99,97,1,7,0) +.07^T^30^USER^0^0^1 +"DATA",90093.99,97,1,8,0) +.08^T^30^CLINIC^0^0^1 +"DATA",90093.99,97,1,9,0) +.01TRIGGER1^I^15^PATIENT IEN^1^0^1 +"DATA",90093.99,97,1,9,3) +IEN^VENPCCTG +"DATA",90093.99,97,1,10,0) +.07TRIGGER1^I^15^USER IEN^1^0^1 +"DATA",90093.99,97,1,10,3) +IEN^VENPCCTG +"DATA",90093.99,97,1,11,0) +.08TRIGGER1^I^4^CLINIC IEN^1^0^1 +"DATA",90093.99,97,1,11,3) +IEN^VENPCCTG +"DATA",90093.99,97,1,12,0) +.001TRIGGER1^I^6^TABLET QUEUE IEN^1^0^1 +"DATA",90093.99,97,1,12,3) +IEN^VENPCCTG +"DATA",90093.99,97,1,13,0) +.13^T^30^UID^0^0^1 +"DATA",90093.99,98,0) +VEN MOJO DE RESUME^19707.82 +"DATA",90093.99,98,1,0) +^90093.991^6^6 +"DATA",90093.99,98,1,1,0) +.01^T^30^TRANSACTION ID^0^0^0 +"DATA",90093.99,98,1,2,0) +.05^T^30^PATIENT NAME^0^0^1 +"DATA",90093.99,98,1,3,0) +99.03^D^21^VISIT DATE^0^0^1 +"DATA",90093.99,98,1,4,0) +98.01^T^30^FORM^0^0^1 +"DATA",90093.99,98,1,5,0) +99.12^T^30^UPDATED BY^0^0^1 +"DATA",90093.99,98,1,6,0) +99.13^T^10^WORKFLOW STATUS^0^0^1 +"DATA",90093.99,99,0) +VEN MOJO DE DX PRB1^19707.82 +"DATA",90093.99,99,1,0) +^90093.991^9^9 +"DATA",90093.99,99,1,1,0) +.01^T^30^TRANSACTION ID^0^0^0 +"DATA",90093.99,99,1,2,0) +.02IEN^I^3^SEGMENT^0^0^1 +"DATA",90093.99,99,1,2,3) +IEN^VENPCCT +"DATA",90093.99,99,1,3,0) +.03^T^20^TID-SID^0^0^1 +"DATA",90093.99,99,1,4,0) +1.06^T^9^ICD CODE^0^0^1 +"DATA",90093.99,99,1,5,0) +1.14^T^80^PROVIDER NARRATIVE^0^0^1 +"DATA",90093.99,99,1,6,0) +1.16^T^8^PROBLEM STATUS^0^0^1 +"DATA",90093.99,99,1,7,0) +1.1^T^15^PROBLEM IEN^0^0^1 +"DATA",90093.99,99,1,8,0) +1.05^T^15^ICD IEN^0^0^1 +"DATA",90093.99,99,1,9,0) +999^T^1^NEW ROW^0^0^1 +"DATA",90093.99,100,0) +VEN MOJO DE DX NOTE1^19707.82 +"DATA",90093.99,100,1,0) +^90093.991^10^10 +"DATA",90093.99,100,1,1,0) +.01^T^30^TRANSACTION ID^0^0^0 +"DATA",90093.99,100,1,2,0) +.02IEN^T^30^SEGMENT^0^0^1 +"DATA",90093.99,100,1,3,0) +.03^T^20^TID-SID^0^0^1 +"DATA",90093.99,100,1,4,0) +1.1^T^15^PROBLEM IEN^0^0^1 +"DATA",90093.99,100,1,5,0) +1.13^I^2^FAC-NOTE IEN^0^0^1 +"DATA",90093.99,100,1,6,0) +1.12^I^3^NOTE IEN^0^0^1 +"DATA",90093.99,100,1,7,0) +1.11^I^2^NOTE NUMBER^0^0^1 +"DATA",90093.99,100,1,8,0) +1.17^T^44^NOTE NARRATIVE^0^0^1 +"DATA",90093.99,100,1,9,0) +1.21^T^6^NOTE STATUS^0^0^1 +"DATA",90093.99,100,1,10,0) +999^T^1^NEW ROW^0^0^1 +"DATA",90093.99,101,0) +VEN MOJO DE CPT^19707.82 +"DATA",90093.99,101,1,0) +^90093.991^8^8 +"DATA",90093.99,101,1,1,0) +5.01^T^9^CPT CODE^0^0^1 +"DATA",90093.99,101,1,2,0) +5.02^T^60^CPT TEXT^0^0^1 +"DATA",90093.99,101,1,3,0) +.01TRIGGER1^T^30^ERROR CELL^1^0^1 +"DATA",90093.99,101,1,3,3) +ECELL^VENPCCTG +"DATA",90093.99,101,1,4,0) +.01^I^15^TRANSACTION ID^1^1^0 +"DATA",90093.99,101,1,5,0) +.02IEN^I^3^SEGMENT IEN^1^0^0 +"DATA",90093.99,101,1,6,0) +.03^T^20^TID-SID^1^0^0 +"DATA",90093.99,101,1,7,0) +100^T^80^COMMENT^1^0^1 +"DATA",90093.99,101,1,8,0) +999^T^1^NEW ROW^0^0^1 +"DATA",90093.99,102,0) +VEN KB CATEGORY^19707.11^1 +"DATA",90093.99,102,1,0) +^90093.991^2^2 +"DATA",90093.99,102,1,1,0) +.01^T^30^KB GROUP^1^0^0 +"DATA",90093.99,102,1,2,0) +.001TRIGGER1^N^4^IEN^1^0^1 +"DATA",90093.99,102,1,2,3) +IEN^VENPCCU +"DATA",90093.99,103,0) +VEN KB ITEM^19707.12 +"DATA",90093.99,103,1,0) +^90093.991^12^12 +"DATA",90093.99,103,1,1,0) +.01^T^30^TYPE^0^0^0 +"DATA",90093.99,103,1,2,0) +.02^T^80^TITLE^0^0^1 +"DATA",90093.99,103,1,3,0) +.04^T^16^EXTERNAL CODE^0^0^1 +"DATA",90093.99,103,1,4,0) +.07^I^2^START WKS GESTATION^0^0^1 +"DATA",90093.99,103,1,5,0) +.08^I^2^STOP WKS GESTATON^0^0^1 +"DATA",90093.99,103,1,6,0) +.09^T^8^SCHEDULING INTERVAL^0^0^1 +"DATA",90093.99,103,1,7,0) +.1^T^4^GENDER SCREEN^0^0^1 +"DATA",90093.99,103,1,8,0) +.11^T^3^INACTIVATED^0^0^1 +"DATA",90093.99,103,1,9,0) +.12^T^60^MODIFIER TEXT^0^0^1 +"DATA",90093.99,103,1,10,0) +.13^N^8^EXTERNAL START AGE^0^0^1 +"DATA",90093.99,103,1,11,0) +.14^N^8^EXTERNAL STOP AGE^0^0^1 +"DATA",90093.99,103,1,12,0) +.15^T^30^ICD TAXONOMY^0^0^1 +"DATA",90093.99,104,0) +VEN KB TEMPLATES^19707.41 +"DATA",90093.99,104,1,0) +^90093.991^2^2 +"DATA",90093.99,104,1,1,0) +.01^T^30^TEMPLATE^0^0^0 +"DATA",90093.99,104,1,2,0) +.001TRIGGER1^N^4^IEN +"DATA",90093.99,104,1,2,3) +IEN^VENPCCU +"DATA",90093.99,105,0) +VEN KB TAXONOMY^9002226 +"DATA",90093.99,105,1,0) +^90093.991^2^2 +"DATA",90093.99,105,1,1,0) +.01^T^30^NAME^0^0^0 +"DATA",90093.99,105,1,2,0) +.001TRIGGER1^N^6^IEN^1^0^1 +"DATA",90093.99,105,1,2,3) +IEN^VENPCCU +"DATA",90093.99,106,0) +VEN UP DISCIPLINES^7 +"DATA",90093.99,106,1,0) +^90093.991^2^2 +"DATA",90093.99,106,1,1,0) +.01^T^30^DISCIPLINE^0^0^0 +"DATA",90093.99,106,1,2,0) +.001TRIGGER1^N^4^IEN^1^0^1 +"DATA",90093.99,106,1,2,3) +IEN^VENPCCU +"DATA",90093.99,107,0) +VEN UP CLINIC STOPS^40.7 +"DATA",90093.99,107,1,0) +^90093.991^2^2 +"DATA",90093.99,107,1,1,0) +.01^T^30^CLINIC^0^0^0 +"DATA",90093.99,107,1,2,0) +.001TRIGGER1^N^4^CLINIC^1^0^1 +"DATA",90093.99,107,1,2,3) +IEN^VENPCCU +"DATA",90093.99,108,0) +VEN UP ICD GROUPS^19707.33 +"DATA",90093.99,108,1,0) +^90093.991^1^1 +"DATA",90093.99,108,1,1,0) +.001TRIGGER1^N^4^IDC PREFERENCE SET^1^0^1 +"DATA",90093.99,108,1,1,3) +IEN^VENPCCU +"DATA",90093.99,109,0) +VEN UP ICD ITEMS^19707.34 +"DATA",90093.99,109,1,0) +^90093.991^22^22 +"DATA",90093.99,109,1,1,0) +.01^T^30^OWNER^0^0^0 +"DATA",90093.99,109,1,2,0) +.02^T^30^DX PREFERENCE GROUP^0^0^1 +"DATA",90093.99,109,1,3,0) +.03^T^80^PRINTED NAME^0^0^1 +"DATA",90093.99,109,1,4,0) +.04^T^9^ICD CODE^0^0^1 +"DATA",90093.99,109,1,5,0) +.07^T^80^ICD TEXT^0^0^1 +"DATA",90093.99,109,1,6,0) +.08^I^6^SORT ORDER NUMBER^0^0^1 +"DATA",90093.99,109,1,7,0) +1.01^T^3^INFANT^0^0^1 +"DATA",90093.99,109,1,8,0) +1.02^I^7^INFANT TOTAL^0^0^1 +"DATA",90093.99,109,1,9,0) +1.03^T^3^CHILD^0^0^1 +"DATA",90093.99,109,1,10,0) +1.04^I^7^CHILD TOTAL^0^0^1 +"DATA",90093.99,109,1,11,0) +1.05^T^3^TEEN FEMALE^0^0^1 +"DATA",90093.99,109,1,12,0) +1.06^I^7^TEEN FEMALE TOTAL^0^0^1 +"DATA",90093.99,109,1,13,0) +1.07^T^3^TEEN MALE^0^0^1 +"DATA",90093.99,109,1,14,0) +1.08^I^7^TEEN MALE TOTAL^0^0^1 +"DATA",90093.99,109,1,15,0) +1.09^T^3^ADULT FEMALE^0^0^1 +"DATA",90093.99,109,1,16,0) +1.1^I^7^ADULT FEMALE TOTAL^0^0^1 +"DATA",90093.99,109,1,17,0) +1.11^T^3^ADULT MALE^0^0^1 +"DATA",90093.99,109,1,18,0) +1.12^I^7^ADULT MALE TOTAL^0^0^1 +"DATA",90093.99,109,1,19,0) +1.13^T^3^SENIOR FEMALE^0^0^1 +"DATA",90093.99,109,1,20,0) +1.14^I^7^SENIOR FEMALE TOTAL^0^0^1 +"DATA",90093.99,109,1,21,0) +1.15^T^3^SENIOR MALE^0^0^1 +"DATA",90093.99,109,1,22,0) +1.16^I^7^SENIOR MALE TOTAL^0^0^1 +"DATA",90093.99,110,0) +VEN CL GROUPS^19707.9 +"DATA",90093.99,110,1,0) +^90093.991^6^6 +"DATA",90093.99,110,1,1,0) +.01^T^30^NAME^0^0^0 +"DATA",90093.99,110,1,2,0) +.02^T^30^TYPE^0^0^1 +"DATA",90093.99,110,1,3,0) +.03^T^9^PRE^0^0^1 +"DATA",90093.99,110,1,4,0) +.04^T^9^POST^0^0^1 +"DATA",90093.99,110,1,5,0) +1^T^240^BRIEF DESCRIPTION^0^0^1 +"DATA",90093.99,110,1,6,0) +.001TRIGGER1^N^3^CHLECK LIST CATEGORY^1^0^1 +"DATA",90093.99,110,1,6,3) +IEN^VENPCCU +"DATA",90093.99,111,0) +VEN CL ITEMS^19707.91 +"DATA",90093.99,111,1,0) +^90093.991^8^8 +"DATA",90093.99,111,1,1,0) +.01^T^30^ITEM^0^0^0 +"DATA",90093.99,111,1,2,0) +.03^T^3^INFANTS^0^0^1 +"DATA",90093.99,111,1,3,0) +.04^T^3^CHILDREN^0^0^1 +"DATA",90093.99,111,1,4,0) +.05^T^3^MEN^0^0^1 +"DATA",90093.99,111,1,5,0) +.07^T^30^CODE1^0^0^1 +"DATA",90093.99,111,1,6,0) +.08^T^30^CODE2^0^0^1 +"DATA",90093.99,111,1,7,0) +.09^I^4^POSITION^0^0^1 +"DATA",90093.99,111,1,8,0) +.001TRIGGER1^N^6^IEN^1^0^1 +"DATA",90093.99,111,1,8,3) +IEN^VENPCCU +"DATA",90093.99,112,0) +HWADA^9999999.31^0 +"DATA",90093.99,112,1,0) +^90093.991^8^5 +"DATA",90093.99,112,1,1,0) +.01^T^30^CODE^1^0^0 +"DATA",90093.99,112,1,2,0) +.02^T^60^DESCRIPTION^0^0^1 +"DATA",90093.99,112,1,5,0) +.09^T^10^NO OPSITE^0^0^1 +"DATA",90093.99,112,1,7,0) +.04^I^10^ESTIMATED MINUTES^0^0^1 +"DATA",90093.99,112,1,8,0) +.08^D^10^INACTIVE^0^0^1 +"FIA",90093.1) +BMX USER +"FIA",90093.1,0) +^BMXUSER( +"FIA",90093.1,0,0) +90093.1 +"FIA",90093.1,0,1) +y^y^f^^^^n +"FIA",90093.1,0,10) + +"FIA",90093.1,0,11) + +"FIA",90093.1,0,"RLRO") + +"FIA",90093.1,0,"VR") +2.31^BMX +"FIA",90093.1,90093.1) +0 +"FIA",90093.2) +BMX APPLICATION +"FIA",90093.2,0) +^BMXAPPL( +"FIA",90093.2,0,0) +90093.2 +"FIA",90093.2,0,1) +y^y^f^^n^^y^o^n +"FIA",90093.2,0,10) + +"FIA",90093.2,0,11) + +"FIA",90093.2,0,"RLRO") + +"FIA",90093.2,0,"VR") +2.31^BMX +"FIA",90093.2,90093.2) +0 +"FIA",90093.5) +BMXNET MONITOR +"FIA",90093.5,0) +^BMXMON( +"FIA",90093.5,0,0) +90093.5 +"FIA",90093.5,0,1) +y^y^f^^^^n +"FIA",90093.5,0,10) + +"FIA",90093.5,0,11) + +"FIA",90093.5,0,"RLRO") + +"FIA",90093.5,0,"VR") +2.31^BMX +"FIA",90093.5,90093.5) +0 +"FIA",90093.9) +BMX GUI REPORT +"FIA",90093.9,0) +^BMXGUIR( +"FIA",90093.9,0,0) +90093.9 +"FIA",90093.9,0,1) +y^y^f^^^^n +"FIA",90093.9,0,10) + +"FIA",90093.9,0,11) + +"FIA",90093.9,0,"RLRO") + +"FIA",90093.9,0,"VR") +2.31^BMX +"FIA",90093.9,90093.9) +0 +"FIA",90093.9,90093.911) +0 +"FIA",90093.98) +BMX ADO LOG +"FIA",90093.98,0) +^BMXADOL( +"FIA",90093.98,0,0) +90093.98D +"FIA",90093.98,0,1) +y^y^f^^^^n +"FIA",90093.98,0,10) + +"FIA",90093.98,0,11) + +"FIA",90093.98,0,"RLRO") + +"FIA",90093.98,0,"VR") +2.31^BMX +"FIA",90093.98,90093.98) +0 +"FIA",90093.98,90093.981) +0 +"FIA",90093.99) +BMX ADO SCHEMA +"FIA",90093.99,0) +^BMXADO( +"FIA",90093.99,0,0) +90093.99 +"FIA",90093.99,0,1) +y^y^f^^n^^y^a^n +"FIA",90093.99,0,10) + +"FIA",90093.99,0,11) + +"FIA",90093.99,0,"RLRO") + +"FIA",90093.99,0,"VR") +2.31^BMX +"FIA",90093.99,90093.99) +0 +"FIA",90093.99,90093.991) +0 +"FIA",90093.99,90093.992) +0 +"FIA",90093.99,90093.9922) +0 +"FIA",90093.99,90093.9923) +0 +"KRN",.402,1724,-1) +0^1 +"KRN",.402,1724,0) +BMX MONITOR EDIT^3040928.1231^@^90093.5^^@^3061103 +"KRN",.402,1724,"DR",1,90093.5) +.01;.02;.03;.04; +"KRN",19,10982,-1) +0^5 +"KRN",19,10982,0) +BMXRPC^BMX Procedure Calls^^B^^^^^^^^BMXNET RPMS .NET UTILITIES +"KRN",19,10982,99.1) +59512,54859 +"KRN",19,10982,"RPC",0) +^19.05P^82^82 +"KRN",19,10982,"RPC",1,0) +BMX SQL +"KRN",19,10982,"RPC",2,0) +BMX SQL COLINFO +"KRN",19,10982,"RPC",3,0) +BMX FIELD LIST +"KRN",19,10982,"RPC",4,0) +BMX FIND +"KRN",19,10982,"RPC",5,0) +BMX LOOKUP +"KRN",19,10982,"RPC",6,0) +BMX NTUSER +"KRN",19,10982,"RPC",7,0) +BMX TABLE +"KRN",19,10982,"RPC",8,0) +BMX TLIST +"KRN",19,10982,"RPC",9,0) +BMX USER +"KRN",19,10982,"RPC",10,0) +BMX SECURITY KEY +"KRN",19,10982,"RPC",11,0) +BMX SIGNATURE +"KRN",19,10982,"RPC",12,0) +BMX MULT LIST +"KRN",19,10982,"RPC",13,0) +BMXGetFacRS +"KRN",19,10982,"RPC",14,0) +BMXSetFac +"KRN",19,10982,"RPC",15,0) +BMXPatientLookupRS +"KRN",19,10982,"RPC",16,0) +BMXPatientInfoRS +"KRN",19,10982,"RPC",20,0) +BMX HEALTH SUMMARY +"KRN",19,10982,"RPC",21,0) +BMX DENTAL REPORT 1 +"KRN",19,10982,"RPC",22,0) +BMXGetFac +"KRN",19,10982,"RPC",23,0) +BMXUserKeyRS +"KRN",19,10982,"RPC",24,0) +BMX PDATA CHART +"KRN",19,10982,"RPC",26,0) +BMX DENTAL REPORT 2 +"KRN",19,10982,"RPC",27,0) +BMX GET VARIABLE VALUE +"KRN",19,10982,"RPC",29,0) +BMX PATIENT DEMOG DATA GET +"KRN",19,10982,"RPC",30,0) +BMXProviderLookupRS +"KRN",19,10982,"RPC",61,0) +BMXNetGetCodes +"KRN",19,10982,"RPC",62,0) +BMXNetSetUser +"KRN",19,10982,"RPC",63,0) +BMX DEMO +"KRN",19,10982,"RPC",64,0) +BMX AV CODE +"KRN",19,10982,"RPC",65,0) +BMXNRC +"KRN",19,10982,"RPC",66,0) +BMX LOCK +"KRN",19,10982,"RPC",67,0) +BMX VERSION INFO +"KRN",19,10982,"RPC",68,0) +BMX IM HERE +"KRN",19,10982,"RPC",69,0) +BMX TEST +"KRN",19,10982,"RPC",70,0) +BMX SCHEMA ONLY +"KRN",19,10982,"RPC",71,0) +BMX UPDATE +"KRN",19,10982,"RPC",74,0) +BMX ADO SS +"KRN",19,10982,"RPC",75,0) +BMX EVENT REGISTER +"KRN",19,10982,"RPC",76,0) +BMX EVENT RAISE +"KRN",19,10982,"RPC",77,0) +BMX EVENT UNREGISTER +"KRN",19,10982,"RPC",78,0) +BMX EVENT POLL +"KRN",19,10982,"RPC",79,0) +BMX TIMER TEST +"KRN",19,10982,"RPC",80,0) +BMX ASYNC GET +"KRN",19,10982,"RPC",81,0) +BMX ASYNC QUEUE +"KRN",19,10982,"RPC",82,0) +BMX UTF-8 +"KRN",19,10982,"U") +BMX PROCEDURE CALLS +"KRN",19,10983,-1) +0^2 +"KRN",19,10983,0) +BMX MONITOR START^Start All BMXNet Monitors^^R^^^^^^^^^y +"KRN",19,10983,1,0) +^19.06^7^7^3040919^^ +"KRN",19,10983,1,1,0) +Use this option to start or restart all BMXNet monitors in the +"KRN",19,10983,1,2,0) +BMXNET MONITOR file. This option should be scheduled as a STARTUP +"KRN",19,10983,1,3,0) +type option in TaskMan. Do not use this option to start a +"KRN",19,10983,1,4,0) +specific monitor. To do this, in programmer mode, do STRT^BMXMON(PORT). +"KRN",19,10983,1,5,0) +See the product documentation for instructions on how to start +"KRN",19,10983,1,6,0) +session monitors in a particular namespace and on how to +"KRN",19,10983,1,7,0) +enable or disable Windows Integrated Security. +"KRN",19,10983,25) +RESTART^BMXMON +"KRN",19,10983,200.9) +s +"KRN",19,10983,"U") +START ALL BMXNET MONITORS +"KRN",19,10984,-1) +0^4 +"KRN",19,10984,0) +BMXMENU^BMXNet Management^^M^^BMXZMENU^^^^^^^^1 +"KRN",19,10984,1,0) +^^1^1^3040928^ +"KRN",19,10984,1,1,0) +Menu contains options in the BMX namespace +"KRN",19,10984,10,0) +^19.01IP^3^3 +"KRN",19,10984,10,1,0) +10986^EDIT^5 +"KRN",19,10984,10,1,"^") +BMX MONITOR EDIT +"KRN",19,10984,10,2,0) +10983^STRT^10 +"KRN",19,10984,10,2,"^") +BMX MONITOR START +"KRN",19,10984,10,3,0) +10985^STOP^15 +"KRN",19,10984,10,3,"^") +BMX MONITOR STOP +"KRN",19,10984,20) +D MENU^BMXMON +"KRN",19,10984,99) +62291,35412 +"KRN",19,10984,"U") +BMXNET MANAGEMENT +"KRN",19,10985,-1) +0^3 +"KRN",19,10985,0) +BMX MONITOR STOP^Stop All BMXNet Monitors^^R^^^^^^^^ +"KRN",19,10985,1,0) +^^1^1^3040928^ +"KRN",19,10985,1,1,0) +Use this option to stop all BMXNet monitors. +"KRN",19,10985,25) +STOPALL^BMXMON +"KRN",19,10985,"U") +STOP ALL BMXNET MONITORS +"KRN",19,10986,-1) +0^1 +"KRN",19,10986,0) +BMX MONITOR EDIT^Add/Edit BMXNet Monitor Entries^^E^^^^^^^^ +"KRN",19,10986,30) +BMXMON( +"KRN",19,10986,31) +AEMQL +"KRN",19,10986,50) +BMXMON( +"KRN",19,10986,51) +[BMX MONITOR EDIT] +"KRN",19,10986,63) + +"KRN",19,10986,99) +59806,44943 +"KRN",19,10986,"U") +ADD/EDIT BMXNET MONITOR ENTRIE +"KRN",19.1,479,-1) +0^1 +"KRN",19.1,479,0) +BMXZMENU +"KRN",8994,2396,-1) +0^21 +"KRN",8994,2396,0) +BMX PATIENT DEMOG DATA GET^PDATA^BMXRPC1^1 +"KRN",8994,2397,-1) +0^18 +"KRN",8994,2397,0) +BMX LOOKUP^LOOKUP^BMXRPC^4 +"KRN",8994,2398,-1) +0^12 +"KRN",8994,2398,0) +BMX FIELD LIST^FLDLIST^BMXRPC2^4 +"KRN",8994,2399,-1) +0^13 +"KRN",8994,2399,0) +BMX FIND^FIND^BMXFIND^4 +"KRN",8994,2400,-1) +0^28 +"KRN",8994,2400,0) +BMX TABLE^TABLE^BMXFIND^4 +"KRN",8994,2401,-1) +0^26 +"KRN",8994,2401,0) +BMX SQL^SQL^BMXSQL^4 +"KRN",8994,2402,-1) +0^31 +"KRN",8994,2402,0) +BMX TLIST^TLIST^BMXSQL^4 +"KRN",8994,2403,-1) +0^27 +"KRN",8994,2403,0) +BMX SQL COLINFO^SQLCOL^BMXSQL^4 +"KRN",8994,2404,-1) +0^14 +"KRN",8994,2404,0) +BMX GET VARIABLE VALUE^VARVAL^BMXRPC3^1 +"KRN",8994,2405,-1) +0^33 +"KRN",8994,2405,0) +BMX USER^USER^BMXRPC3^1 +"KRN",8994,2406,-1) +0^20 +"KRN",8994,2406,0) +BMX NTUSER^NTUSER^BMXRPC3^1 +"KRN",8994,2407,-1) +0^43 +"KRN",8994,2407,0) +BMXSetFac^SETFCRS^BMXRPC3^1 +"KRN",8994,2408,-1) +0^35 +"KRN",8994,2408,0) +BMXGetFac^GETFC^BMXRPC3^1 +"KRN",8994,2409,-1) +0^24 +"KRN",8994,2409,0) +BMX SECURITY KEY^APSEC^BMXRPC3^1 +"KRN",8994,2410,-1) +0^25 +"KRN",8994,2410,0) +BMX SIGNATURE^SIGCHK^BMXRPC3^1 +"KRN",8994,2411,-1) +0^19 +"KRN",8994,2411,0) +BMX MULT LIST^MLTLIST^BMXRPC2^4 +"KRN",8994,2412,-1) +0^36 +"KRN",8994,2412,0) +BMXGetFacRS^GETFCRS^BMXRPC3^1 +"KRN",8994,2413,-1) +0^41 +"KRN",8994,2413,0) +BMXPatientLookupRS^PTLOOKRS^BMXRPC4^1 +"KRN",8994,2414,-1) +0^40 +"KRN",8994,2414,0) +BMXPatientInfoRS^PTINFORS^BMXRPC4^1 +"KRN",8994,2415,-1) +0^15 +"KRN",8994,2415,0) +BMX HEALTH SUMMARY^HS^BMXRPC5^4 +"KRN",8994,2416,-1) +0^6 +"KRN",8994,2416,0) +BMX DENTAL REPORT 1^BMXADE^BMXADE1^4 +"KRN",8994,2417,-1) +0^44 +"KRN",8994,2417,0) +BMXUserKeyRS^USRKEYRS^BMXRPC6^1 +"KRN",8994,2418,-1) +0^42 +"KRN",8994,2418,0) +BMXProviderLookupRS^PRVLKRS^BMXQA2^1 +"KRN",8994,2419,-1) +0^22 +"KRN",8994,2419,0) +BMX PDATA CHART^PDATA^BMXRPC6^4 +"KRN",8994,2420,-1) +0^7 +"KRN",8994,2420,0) +BMX DENTAL REPORT 2^BMXADE^BMXADE2^4 +"KRN",8994,2421,-1) +0^37 +"KRN",8994,2421,0) +BMXNRC^ZTM^BMXNRC^4 +"KRN",8994,2422,-1) +0^38 +"KRN",8994,2422,0) +BMXNetGetCodes^NTUGET^BMXRPC3^4 +"KRN",8994,2423,-1) +0^39 +"KRN",8994,2423,0) +BMXNetSetUser^NTUSET^BMXRPC3^4 +"KRN",8994,2424,-1) +0^5 +"KRN",8994,2424,0) +BMX DEMO^PDEMO^BMXRPC6^4 +"KRN",8994,2425,-1) +0^4 +"KRN",8994,2425,0) +BMX AV CODE^WINVAL^BMXRPC7^2 +"KRN",8994,2426,-1) +0^17 +"KRN",8994,2426,0) +BMX LOCK^BMXLOCK^BMXRPC8^1 +"KRN",8994,2427,-1) +0^34 +"KRN",8994,2427,0) +BMX VERSION INFO^BMXVER^BMXRPC8^4 +"KRN",8994,2428,-1) +0^16 +"KRN",8994,2428,0) +BMX IM HERE^IMHERE^BMXRPC8^1^P +"KRN",8994,2428,1,0) +^8994.01^2^2^3040304^^^ +"KRN",8994,2428,1,1,0) +Returns a simple value to client. Used to establish continued existence +"KRN",8994,2428,1,2,0) +of the client to the server; resets the server READ timeout. +"KRN",8994,2429,-1) +0^32 +"KRN",8994,2429,0) +BMX UPDATE^FILE^BMXADOF^1 +"KRN",8994,2430,-1) +0^29 +"KRN",8994,2430,0) +BMX TEST^TESTRPC^BMXRPC9^4 +"KRN",8994,2431,-1) +0^23 +"KRN",8994,2431,0) +BMX SCHEMA ONLY^SONLY^BMXRPC9^1 +"KRN",8994,2432,-1) +0^1 +"KRN",8994,2432,0) +BMX ADO SS^SS^BMXADO^4 +"KRN",8994,2433,-1) +0^9 +"KRN",8994,2433,0) +BMX EVENT RAISE^RAISEVNT^BMXMEVN^4 +"KRN",8994,2434,-1) +0^10 +"KRN",8994,2434,0) +BMX EVENT REGISTER^REGEVNT^BMXMEVN^4 +"KRN",8994,2435,-1) +0^11 +"KRN",8994,2435,0) +BMX EVENT UNREGISTER^UNREG^BMXMEVN^4 +"KRN",8994,2436,-1) +0^8 +"KRN",8994,2436,0) +BMX EVENT POLL^POLL^BMXMEVN^4 +"KRN",8994,2437,-1) +0^30 +"KRN",8994,2437,0) +BMX TIMER TEST^TTEST^BMXMEVN^4 +"KRN",8994,2438,-1) +0^2 +"KRN",8994,2438,0) +BMX ASYNC GET^ASYNCGET^BMXMEVN^4 +"KRN",8994,2439,-1) +0^3 +"KRN",8994,2439,0) +BMX ASYNC QUEUE^ASYNCQUE^BMXMEVN^4 +"KRN",8994,2497,-1) +0^45 +"KRN",8994,2497,0) +BMX UTF-8^UTF8^BMXRPC^1^P +"KRN",8994,2497,1,0) +^^4^4^3100907^ +"KRN",8994,2497,1,1,0) +This RPC returns a single value of 1 if database supports UTF-8; 0 if +"KRN",8994,2497,1,2,0) +not. Only works on GT.M. +"KRN",8994,2497,1,3,0) + +"KRN",8994,2497,1,4,0) +Doesn't take any parameters. +"MBREQ") +0 +"ORD",3,19.1) +19.1;3;1;;KEY^XPDTA1;;;KEYF2^XPDIA1;;KEYDEL^XPDIA1 +"ORD",3,19.1,0) +SECURITY KEY +"ORD",7,.402) +.402;7;;;EDEOUT^DIFROMSO(.402,DA,"",XPDA);FPRE^DIFROMSI(.402,"",XPDA);EPRE^DIFROMSI(.402,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.402,DA,"",XPDA);DEL^DIFROMSK(.402,"",%) +"ORD",7,.402,0) +INPUT TEMPLATE +"ORD",16,8994) +8994;16;1;;;;;;;RPCDEL^XPDIA1 +"ORD",16,8994,0) +REMOTE PROCEDURE +"ORD",18,19) +19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA +"ORD",18,19,0) +OPTION +"PKG",210,-1) +1^1 +"PKG",210,0) +BMXNET RPMS .NET UTILITIES^BMX^.NET CONNECTIVITY UTILITIES +"PKG",210,1,0) +^9.41A^2^2^3061031^^^^ +"PKG",210,1,1,0) +BMXNet supports connection, authentication and data exchange between +"PKG",210,1,2,0) +Windows applications written for the .NET environment. +"PKG",210,20,0) +^9.402P^^ +"PKG",210,22,0) +^9.49I^1^1 +"PKG",210,22,1,0) +2.31^3110725 +"PKG",210,22,1,1,0) +^^23^23^3110725 +"PKG",210,22,1,1,1,0) +BMXNet .NET Connectivity utilities for RPMS. +"PKG",210,22,1,1,2,0) +Version 2.0 kids build to support BMXNet20.dll +"PKG",210,22,1,1,3,0) + +"PKG",210,22,1,1,4,0) +Version 2.1 adds support to GT.M. +"PKG",210,22,1,1,5,0) + +"PKG",210,22,1,1,6,0) +Version 2.2 adds a few bug fixes: +"PKG",210,22,1,1,7,0) + - Process Name is now set in BMXMON +"PKG",210,22,1,1,8,0) + - Timeout is now correct: +"PKG",210,22,1,1,9,0) + - 10 seconds for 1st connection +"PKG",210,22,1,1,10,0) + - 180 seconds for continuation +"PKG",210,22,1,1,11,0) + - Kernel Broker Timeout for regular use +"PKG",210,22,1,1,12,0) + - Divisions are now presented to the user if the user has more than one +"PKG",210,22,1,1,13,0) +division in his/her profile. +"PKG",210,22,1,1,14,0) +Version 2.2 requires BMXNet22.dll +"PKG",210,22,1,1,15,0) + +"PKG",210,22,1,1,16,0) +Version 2.3 (Dec 12 2010) +"PKG",210,22,1,1,17,0) +Screens network errors and not log them into the error trap. +"PKG",210,22,1,1,18,0) +Process Name set causes an error on Cache. Now fixed. +"PKG",210,22,1,1,19,0) +Requires BMXNet23.dll +"PKG",210,22,1,1,20,0) + +"PKG",210,22,1,1,21,0) +Version 2.31 (Jul 25 2011) +"PKG",210,22,1,1,22,0) +Error trap corrections in v 2.3 introduced a bug that causes an infinite +"PKG",210,22,1,1,23,0) +loop in the error trap causing a hard drive to fill up. This is fixed. +"PKG",210,"DEV") +IHS/ITSC/HWHITT +"PKG",210,"VERSION") +2.31 +"PRE") +BMXE01 +"QUES","XPF1",0) +Y +"QUES","XPF1","??") +^D REP^XPDH +"QUES","XPF1","A") +Shall I write over your |FLAG| File +"QUES","XPF1","B") +YES +"QUES","XPF1","M") +D XPF1^XPDIQ +"QUES","XPF2",0) +Y +"QUES","XPF2","??") +^D DTA^XPDH +"QUES","XPF2","A") +Want my data |FLAG| yours +"QUES","XPF2","B") +YES +"QUES","XPF2","M") +D XPF2^XPDIQ +"QUES","XPI1",0) +YO +"QUES","XPI1","??") +^D INHIBIT^XPDH +"QUES","XPI1","A") +Want KIDS to INHIBIT LOGONs during the install +"QUES","XPI1","B") +NO +"QUES","XPI1","M") +D XPI1^XPDIQ +"QUES","XPM1",0) +PO^VA(200,:EM +"QUES","XPM1","??") +^D MG^XPDH +"QUES","XPM1","A") +Enter the Coordinator for Mail Group '|FLAG|' +"QUES","XPM1","B") + +"QUES","XPM1","M") +D XPM1^XPDIQ +"QUES","XPO1",0) +Y +"QUES","XPO1","??") +^D MENU^XPDH +"QUES","XPO1","A") +Want KIDS to Rebuild Menu Trees Upon Completion of Install +"QUES","XPO1","B") +NO +"QUES","XPO1","M") +D XPO1^XPDIQ +"QUES","XPZ1",0) +Y +"QUES","XPZ1","??") +^D OPT^XPDH +"QUES","XPZ1","A") +Want to DISABLE Scheduled Options, Menu Options, and Protocols +"QUES","XPZ1","B") +NO +"QUES","XPZ1","M") +D XPZ1^XPDIQ +"QUES","XPZ2",0) +Y +"QUES","XPZ2","??") +^D RTN^XPDH +"QUES","XPZ2","A") +Want to MOVE routines to other CPUs +"QUES","XPZ2","B") +NO +"QUES","XPZ2","M") +D XPZ2^XPDIQ +"RTN") +59 +"RTN","BMXADE1") +0^59^B11418056 +"RTN","BMXADE1",1,0) +BMXADE1 ; IHS/OIT/HMW - BMXNet ADO.NET PROVIDER ; +"RTN","BMXADE1",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXADE1",3,0) + ; +"RTN","BMXADE1",4,0) + ; +"RTN","BMXADE1",5,0) + ;Dental Excel report demo +"RTN","BMXADE1",6,0) + ; +"RTN","BMXADE1",7,0) +BMXADE(BMXGBL,BMXBEG,BMXEND) ;EP +"RTN","BMXADE1",8,0) + ;Returns recordset containing services and minutes by reporting facility, patient's community and service unit +"RTN","BMXADE1",9,0) + ; +"RTN","BMXADE1",10,0) + N BMXBEGDT,BMXENDDT,BMXTMP,BMXDT,BMXRD,BMXIEN,BMXNOD,BMXPAT,BMXCOM,BMXFAC,BMXSU,BMXCOMP,BMXSUP,BMXFACP,BMXSVC,BMXMIN,BMXFEE +"RTN","BMXADE1",11,0) + S U="^",BMXRD=$C(30) +"RTN","BMXADE1",12,0) + K ^BMXTEMP($J),^BMXTMP($J) +"RTN","BMXADE1",13,0) + S BMXGBL="^BMXTEMP("_$J_")" +"RTN","BMXADE1",14,0) + S ^BMXTEMP($J,0)="T00030FACILITY^T00030PT_COMMUNITY^T00030PT_SERVICE_UNIT^I00030SERVICES^I00030MINUTES^I00030FEE"_BMXRD +"RTN","BMXADE1",15,0) + S X=BMXBEG,%DT="P" D ^%DT S BMXBEGDT=Y +"RTN","BMXADE1",16,0) + S X=BMXEND,%DT="P" D ^%DT S BMXENDDT=Y +"RTN","BMXADE1",17,0) + I BMXENDDTBMXENDDT D +"RTN","BMXADE1",25,0) + . S BMXIEN=0 F S BMXIEN=$O(^ADEPCD("AC",BMXDT,BMXIEN)) Q:'+BMXIEN D +"RTN","BMXADE1",26,0) + . . Q:'$D(^ADEPCD(BMXIEN,0)) +"RTN","BMXADE1",27,0) + . . S BMXNOD=^ADEPCD(BMXIEN,0) +"RTN","BMXADE1",28,0) + . . S BMXPAT=$P(BMXNOD,U) +"RTN","BMXADE1",29,0) + . . S BMXFACP=+$P(BMXNOD,U,3) +"RTN","BMXADE1",30,0) + . . S BMXCOMP=$$GETCOMP(BMXPAT) +"RTN","BMXADE1",31,0) + . . D CALCMIN(BMXIEN,.BMXSVC,.BMXMIN,.BMXFEE) +"RTN","BMXADE1",32,0) + . . Q:BMXSVC=0 +"RTN","BMXADE1",33,0) + . . S:'$D(^BMXTMP($J,BMXFACP,BMXCOMP)) ^BMXTMP($J,BMXFACP,BMXCOMP)="0^0^0" +"RTN","BMXADE1",34,0) + . . S $P(^BMXTMP($J,BMXFACP,BMXCOMP),U)=$P(^(BMXCOMP),U)+BMXSVC +"RTN","BMXADE1",35,0) + . . S $P(^BMXTMP($J,BMXFACP,BMXCOMP),U,2)=$P(^(BMXCOMP),U,2)+BMXMIN +"RTN","BMXADE1",36,0) + . . S $P(^BMXTMP($J,BMXFACP,BMXCOMP),U,3)=$P(^(BMXCOMP),U,3)+BMXFEE +"RTN","BMXADE1",37,0) + . . Q +"RTN","BMXADE1",38,0) + . Q +"RTN","BMXADE1",39,0) + ; +"RTN","BMXADE1",40,0) + ;Traverse ^BMXTMP and fill in ^BMXTEMP +"RTN","BMXADE1",41,0) + S BMXI=0 +"RTN","BMXADE1",42,0) + S BMXFACP=-1 F S BMXFACP=$O(^BMXTMP($J,BMXFACP)) Q:BMXFACP="" D +"RTN","BMXADE1",43,0) + . I BMXFACP=0 S BMXFAC="UNKNOWN" +"RTN","BMXADE1",44,0) + . E S BMXFAC=$P($G(^DIC(4,BMXFACP,0)),U) S:BMXFAC="" BMXFAC="UNKNOWN" +"RTN","BMXADE1",45,0) + . S BMXCOMP=-1 F S BMXCOMP=$O(^BMXTMP($J,BMXFACP,BMXCOMP)) Q:BMXCOMP="" D +"RTN","BMXADE1",46,0) + . . I BMXCOMP=0 S BMXCOM="UNKNOWN" +"RTN","BMXADE1",47,0) + . . E S BMXCOM=$P($G(^AUTTCOM(BMXCOMP,0)),U) S:BMXCOM="" BMXCOM="UNKNOWN" +"RTN","BMXADE1",48,0) + . . S BMXSU=+$P($G(^AUTTCOM(BMXCOMP,0)),U,5) +"RTN","BMXADE1",49,0) + . . I BMXSU=0 S BMXSU="UNKNOWN" +"RTN","BMXADE1",50,0) + . . E S BMXSU=$P($G(^AUTTSU(BMXSU,0)),U) +"RTN","BMXADE1",51,0) + . . S BMXI=BMXI+1 +"RTN","BMXADE1",52,0) + . . S BMXSVC=$P(^BMXTMP($J,BMXFACP,BMXCOMP),U) +"RTN","BMXADE1",53,0) + . . S BMXMIN=$P(^BMXTMP($J,BMXFACP,BMXCOMP),U,2) +"RTN","BMXADE1",54,0) + . . S BMXFEE=$P(^BMXTMP($J,BMXFACP,BMXCOMP),U,3) +"RTN","BMXADE1",55,0) + . . S ^BMXTEMP($J,BMXI)=BMXFAC_U_BMXCOM_U_BMXSU_U_BMXSVC_U_BMXMIN_U_BMXFEE_BMXRD +"RTN","BMXADE1",56,0) + . . Q +"RTN","BMXADE1",57,0) + . Q +"RTN","BMXADE1",58,0) + S BMXI=BMXI+1 +"RTN","BMXADE1",59,0) + S ^BMXTEMP($J,BMXI)=$C(31) +"RTN","BMXADE1",60,0) + Q +"RTN","BMXADE1",61,0) + ; +"RTN","BMXADE1",62,0) +GETCOMP(BMXPAT) ; +"RTN","BMXADE1",63,0) + ;Returns Patient Community Pointer +"RTN","BMXADE1",64,0) + I '$D(^AUPNPAT(BMXPAT,11)) Q 0 +"RTN","BMXADE1",65,0) + Q +$P(^AUPNPAT(BMXPAT,11),U,17) +"RTN","BMXADE1",66,0) + ; +"RTN","BMXADE1",67,0) +CALCMIN(BMXIEN,BMXSVC,BMXMIN,BMXFEE) ; +"RTN","BMXADE1",68,0) + ;Returns count of lvl 1 - 6 services and minutes for entry BMXIEN +"RTN","BMXADE1",69,0) + ;Uses ANMC rogue FEE field in AUTTADA to calculate FEE data +"RTN","BMXADE1",70,0) + N BMXA,BMXCOD,BMXALVL +"RTN","BMXADE1",71,0) + S BMXSVC=0,BMXMIN=0,BMXFEE=0 +"RTN","BMXADE1",72,0) + Q:'$D(^ADEPCD(BMXIEN,"ADA")) +"RTN","BMXADE1",73,0) + S BMXA=0 F S BMXA=$O(^ADEPCD(BMXIEN,"ADA",BMXA)) Q:'+BMXA D +"RTN","BMXADE1",74,0) + . S BMXCOD=+^ADEPCD(BMXIEN,"ADA",BMXA,0) +"RTN","BMXADE1",75,0) + . Q:'$D(^AUTTADA(BMXCOD,0)) +"RTN","BMXADE1",76,0) + . S BMXANOD=^AUTTADA(BMXCOD,0) +"RTN","BMXADE1",77,0) + . S BMXALVL=$P(BMXANOD,U,5) +"RTN","BMXADE1",78,0) + . Q:BMXALVL=0 +"RTN","BMXADE1",79,0) + . Q:BMXALVL>6 +"RTN","BMXADE1",80,0) + . S BMXSVC=BMXSVC+1 +"RTN","BMXADE1",81,0) + . S BMXMIN=BMXMIN+$P(BMXANOD,U,4) +"RTN","BMXADE1",82,0) + . S BMXFEE=BMXFEE+$P(BMXANOD,U,12) +"RTN","BMXADE1",83,0) + Q +"RTN","BMXADE2") +0^60^B13063702 +"RTN","BMXADE2",1,0) +BMXADE2 ; IHS/OIT/HMW - BMXNet ADO.NET PROVIDER ; +"RTN","BMXADE2",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXADE2",3,0) + ; +"RTN","BMXADE2",4,0) + ; +"RTN","BMXADE2",5,0) + ;Dental Excel report demo +"RTN","BMXADE2",6,0) + ; +"RTN","BMXADE2",7,0) +BMXADE(BMXGBL,BMXBEG,BMXEND) ;EP +"RTN","BMXADE2",8,0) + ;Returns recordset containing services and minutes by reporting facility, Provider, and ADA Code +"RTN","BMXADE2",9,0) + ; +"RTN","BMXADE2",10,0) + N BMXBEGDT,BMXENDDT,BMXTMP,BMXDT,BMXRD,BMXIEN,BMXNOD,BMXCOM,BMXFAC,BMXSU,BMXCOMP,BMXSUP,BMXFACP,BMXSVC,BMXMIN,BMXLVL,BMXFEE +"RTN","BMXADE2",11,0) + S U="^",BMXRD=$C(30) +"RTN","BMXADE2",12,0) + K ^BMXTEMP($J),^BMXTMP($J) +"RTN","BMXADE2",13,0) + S BMXGBL="^BMXTEMP("_$J_")" +"RTN","BMXADE2",14,0) + S ^BMXTEMP($J,0)="T00030FACILITY^T00030PROVIDER^T00030ADA_CODE^T00030LEVEL^I00030SERVICES^I00030MINUTES^I00030FEE"_BMXRD +"RTN","BMXADE2",15,0) + S X=BMXBEG,%DT="P" D ^%DT S BMXBEGDT=Y +"RTN","BMXADE2",16,0) + S X=BMXEND,%DT="P" D ^%DT S BMXENDDT=Y +"RTN","BMXADE2",17,0) + I BMXENDDTBMXENDDT D +"RTN","BMXADE2",25,0) + . S BMXIEN=0 F S BMXIEN=$O(^ADEPCD("AC",BMXDT,BMXIEN)) Q:'+BMXIEN D +"RTN","BMXADE2",26,0) + . . Q:'$D(^ADEPCD(BMXIEN,0)) +"RTN","BMXADE2",27,0) + . . S BMXNOD=^ADEPCD(BMXIEN,0) +"RTN","BMXADE2",28,0) + . . S BMXFACP=+$P(BMXNOD,U,3) +"RTN","BMXADE2",29,0) + . . S BMXPRVP=+$P(BMXNOD,U,4) +"RTN","BMXADE2",30,0) + . . S BMXCODP=0 F S BMXCODP=$O(^ADEPCD(BMXIEN,"ADA","B",BMXCODP)) Q:'+BMXCODP D +"RTN","BMXADE2",31,0) + . . . D CALCMIN(BMXCODP,.BMXMIN) +"RTN","BMXADE2",32,0) + . . . D CALCFEE(BMXCODP,.BMXFEE) +"RTN","BMXADE2",33,0) + . . . S BMXCODPS=0,BMXSVC=0 F S BMXCODPS=$O(^ADEPCD(BMXIEN,"ADA","B",BMXCODP,BMXCODPS)) Q:'+BMXCODPS D +"RTN","BMXADE2",34,0) + . . . . S BMXSVC=BMXSVC+1 +"RTN","BMXADE2",35,0) + . . . S:'$D(^BMXTMP($J,BMXFACP,BMXPRVP,BMXCODP)) ^BMXTMP($J,BMXFACP,BMXPRVP,BMXCODP)="0^0" +"RTN","BMXADE2",36,0) + . . . S $P(^BMXTMP($J,BMXFACP,BMXPRVP,BMXCODP),U)=$P(^(BMXCODP),U)+BMXSVC +"RTN","BMXADE2",37,0) + . . . S $P(^BMXTMP($J,BMXFACP,BMXPRVP,BMXCODP),U,2)=$P(^(BMXCODP),U,2)+(BMXSVC*BMXMIN) +"RTN","BMXADE2",38,0) + . . . S $P(^BMXTMP($J,BMXFACP,BMXPRVP,BMXCODP),U,3)=$P(^(BMXCODP),U,3)+(BMXSVC*BMXFEE) +"RTN","BMXADE2",39,0) + . . . Q +"RTN","BMXADE2",40,0) + . . Q +"RTN","BMXADE2",41,0) + . Q +"RTN","BMXADE2",42,0) + ; +"RTN","BMXADE2",43,0) + ;Traverse ^BMXTMP and fill in ^BMXTEMP +"RTN","BMXADE2",44,0) + S BMXI=0 +"RTN","BMXADE2",45,0) + S BMXFACP=-1 F S BMXFACP=$O(^BMXTMP($J,BMXFACP)) Q:BMXFACP="" D +"RTN","BMXADE2",46,0) + . I BMXFACP=0 S BMXFAC="UNKNOWN" +"RTN","BMXADE2",47,0) + . E S BMXFAC=$P($G(^DIC(4,BMXFACP,0)),U) S:BMXFAC="" BMXFAC="UNKNOWN" +"RTN","BMXADE2",48,0) + . S BMXPRVP=-1 F S BMXPRVP=$O(^BMXTMP($J,BMXFACP,BMXPRVP)) Q:BMXPRVP="" D +"RTN","BMXADE2",49,0) + . . S BMXPRV=$P($G(^DIC(16,BMXPRVP,0)),U) S:BMXPRV="" BMXPRV="UNKNOWN" +"RTN","BMXADE2",50,0) + . . S BMXCODP=-1 F S BMXCODP=$O(^BMXTMP($J,BMXFACP,BMXPRVP,BMXCODP)) Q:'+BMXCODP D +"RTN","BMXADE2",51,0) + . . . D CODLVL(BMXCODP,.BMXCOD,.BMXLVL) +"RTN","BMXADE2",52,0) + . . . S BMXI=BMXI+1 +"RTN","BMXADE2",53,0) + . . . S BMXSVC=$P(^BMXTMP($J,BMXFACP,BMXPRVP,BMXCODP),U) +"RTN","BMXADE2",54,0) + . . . S BMXMIN=$P(^BMXTMP($J,BMXFACP,BMXPRVP,BMXCODP),U,2) +"RTN","BMXADE2",55,0) + . . . S BMXFEE=$P(^BMXTMP($J,BMXFACP,BMXPRVP,BMXCODP),U,3) +"RTN","BMXADE2",56,0) + . . . S ^BMXTEMP($J,BMXI)=BMXFAC_U_BMXPRV_U_BMXCOD_U_BMXLVL_U_BMXSVC_U_BMXMIN_U_BMXFEE_BMXRD +"RTN","BMXADE2",57,0) + . . . Q +"RTN","BMXADE2",58,0) + . . Q +"RTN","BMXADE2",59,0) + . Q +"RTN","BMXADE2",60,0) + S BMXI=BMXI+1 +"RTN","BMXADE2",61,0) + S ^BMXTEMP($J,BMXI)=$C(31) +"RTN","BMXADE2",62,0) + Q +"RTN","BMXADE2",63,0) + ; +"RTN","BMXADE2",64,0) +CALCMIN(BMXCODP,BMXMIN) ; +"RTN","BMXADE2",65,0) + ;Returns Minutes for code BMXCOD +"RTN","BMXADE2",66,0) + N BMXANOD +"RTN","BMXADE2",67,0) + S BMXMIN=0 +"RTN","BMXADE2",68,0) + Q:'$D(^AUTTADA(BMXCODP,0)) +"RTN","BMXADE2",69,0) + S BMXANOD=^AUTTADA(BMXCODP,0) +"RTN","BMXADE2",70,0) + ;S BMXLVL=$P(BMXANOD,U,5) +"RTN","BMXADE2",71,0) + S BMXMIN=$P(BMXANOD,U,4) +"RTN","BMXADE2",72,0) + Q +"RTN","BMXADE2",73,0) + ; +"RTN","BMXADE2",74,0) +CALCFEE(BMXCODP,BMXFEE) ; +"RTN","BMXADE2",75,0) + ;Returns FEE for code BMXCOD. Only works for ANMC local fee field +"RTN","BMXADE2",76,0) + N BMXANOD +"RTN","BMXADE2",77,0) + S BMXFEE=0 +"RTN","BMXADE2",78,0) + Q:'$D(^AUTTADA(BMXCODP,0)) +"RTN","BMXADE2",79,0) + S BMXANOD=^AUTTADA(BMXCODP,0) +"RTN","BMXADE2",80,0) + S BMXFEE=+$P(BMXANOD,U,12) +"RTN","BMXADE2",81,0) + Q +"RTN","BMXADE2",82,0) + ; +"RTN","BMXADE2",83,0) +CODLVL(BMXCODP,BMXCOD,BMXLVL) ; +"RTN","BMXADE2",84,0) + ;Returns Name and Level of code at ADACODP +"RTN","BMXADE2",85,0) + N BMXANOD +"RTN","BMXADE2",86,0) + S BMXCOD="",BMXLVL="" +"RTN","BMXADE2",87,0) + Q:'$D(^AUTTADA(BMXCODP,0)) +"RTN","BMXADE2",88,0) + S BMXANOD=^AUTTADA(BMXCODP,0) +"RTN","BMXADE2",89,0) + S BMXCOD=$P(BMXANOD,U) +"RTN","BMXADE2",90,0) + S BMXLVL=$P(BMXANOD,U,5) +"RTN","BMXADO") +0^61^B32349097 +"RTN","BMXADO",1,0) +BMXADO ; IHS/CIHA/GIS - RPC CALL: GENERATE AN ADO SCHEMA STRING AND DATA SET ; +"RTN","BMXADO",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXADO",3,0) + ; SS^BMXADO: RPC EP FROM WINDOWS/WEB APP TO GENERATE A SCHEMEA STRING (& OPTIONALLY, A DATA SET AS WELL) +"RTN","BMXADO",4,0) + ; THE SCHEMA DEFINITION AND MAP IS STORED IN THE 'BMX ADO SCHEMA' FILE +"RTN","BMXADO",5,0) + ; THIS ROUTINE GENERATES THE SCHEMA STRING. BMXADOV GENERATES THE DATA SET THAT GOES WITH THE SCHEMA STRING. +"RTN","BMXADO",6,0) + ; IF THERE IS AN ERROR, XXX(1) WILL CONTAIN "ERROR|msg"_$C(30) WHERE 'msg' IS THE ERROR MESSAGE +"RTN","BMXADO",7,0) + ; E.G."ERROR|Invalid schema IEN" +"RTN","BMXADO",8,0) + ; +"RTN","BMXADO",9,0) + ; +"RTN","BMXADO",10,0) +SSD(OUT,SIEN,DAS,VSTG,JSTG) ;Debug entry point +"RTN","BMXADO",11,0) + D DEBUG^%Serenji("SS^BMXADO(.OUT,SIEN,DAS,VSTG,JSTG)") ; DEBUGGER ENTRY POINT +"RTN","BMXADO",12,0) + Q +"RTN","BMXADO",13,0) + ; +"RTN","BMXADO",14,0) + ; +"RTN","BMXADO",15,0) +SS(OUT,SIEN,DAS,VSTG,JSTG) ; EP - RETURN THE SCHEMA STRING IN AN ARRAY +"RTN","BMXADO",16,0) + ; OUT=OUTPUT VARIABLE (PASSED BY REFERENCE) +"RTN","BMXADO",17,0) + ; THE OUTPUT ARRAY IS GENERATED FROM DATA IN THE 'BMX ADO SCHEMA' FILE AND THE FILEMAN DATABASE +"RTN","BMXADO",18,0) + ; RECORDS ARE SEPARATED WITH $C(30). FIELDS ARE SEPARATED BY "^". FIELD PROPERTIES ARE SEPARATED BY "|". +"RTN","BMXADO",19,0) + ; ONE RECORD PER OUTPUT NODE. +"RTN","BMXADO",20,0) + ; 1ST RECORD IS THE "INTRODUCTION RECORD": "@@@meta@@@BMXIEN|FILE #|DA STRING" +"RTN","BMXADO",21,0) + ; THE SECOND RECORD IS THE HEADER RECORD. THE REST ARE THE DATA RECORDS +"RTN","BMXADO",22,0) + ; RECORD FORMAT: FILE#|FIELD#|DATA TYPE|LENGTH|FIELDNAME|READONLY|KEYFIELD|NULLOK_$C(30) +"RTN","BMXADO",23,0) + ; SIEN=SCHEMA NAME OR IEN FROM BMX ADO SCHEMA FILE +"RTN","BMXADO",24,0) + ; DAS= "DA" STRING: STRING FOR DEFINING PARENT FILES +"RTN","BMXADO",25,0) + ; EXAMPLE: "4,8," CORRESPONDS TO DA(2), DA(1). +"RTN","BMXADO",26,0) + ; PRIMARILY USED AS A "SEED" FOR RE-ENTRY - IF INDEX IS PRESENT. +"RTN","BMXADO",27,0) + ; IF NOT A SEED, DO NOT INCLUDE THE BOTTOM LEVEL IEN: DA; E.G., "4,8," +"RTN","BMXADO",28,0) + ; DO NOT CONFUSE WITH "IENS STRING" OF FILEMAN SILENT CALLS +"RTN","BMXADO",29,0) + ; VSTG=VIEW STRING INSTRUCTIONS (SEE BMXADOV FOR DETAILS) +"RTN","BMXADO",30,0) + ; JSTG=JOIN STRING INSTRUCTIONS (SEE BMXADOVJ FOR DETAILS) +"RTN","BMXADO",31,0) + ; +"RTN","BMXADO",32,0) + N X,Y,DIC,ERR +"RTN","BMXADO",33,0) + S OUT=$NA(^TMP("BMX ADO",$J)) K @OUT ; DEFINE THE OUTPUT ARRAY CLOSED REFERENCE +"RTN","BMXADO",34,0) + X ("S "_$C(68)_"UZ(0)=$C(64)") ; INSURE PRIVELEGES +"RTN","BMXADO",35,0) + S X="MERR^BMXADO",@^%ZOSF("TRAP") ; SET MUMPS ERROR TRAP +"RTN","BMXADO",36,0) + I '$L(SIEN) S ERR="Missing schema ID" D ERR(ERR) Q +"RTN","BMXADO",37,0) + I 'SIEN S DIC="^BMXADO(",DIC(0)="M",X=SIEN D ^DIC S SIEN=+Y I Y=-1 S ERR="Invalid schema ID" D ERR(ERR) Q +"RTN","BMXADO",38,0) + I '$D(^BMXADO(SIEN,0)) S ERR="Invalid/missing schema" D ERR(ERR) Q ; SCHEMA MUST EXIST +"RTN","BMXADO",39,0) + N FIEN,FLDIEN,TOT,STG,B,C,X,%,LEVEL,Y,SF +"RTN","BMXADO",40,0) + S FIEN=$P(^BMXADO(SIEN,0),U,2) +"RTN","BMXADO",41,0) + I '$D(^DD(FIEN,0)) S ERR="Invalid/missing file number in schema file" D ERR(ERR) Q ; INVALID FILE NUMBER +"RTN","BMXADO",42,0) + S SF=$$CKSUB(FIEN,DAS) I SF=-1 S ERR="Invalid DA string" D ERR(ERR) Q ; INVALID DA STRING +"RTN","BMXADO",43,0) + S C=",",B="|",TOT=0 ; THESE LOCALS, ALONG WITH KERNEL VARIABLES, ARE ALWAYS AVAILABLE TO ALL ROUTINES AND SUBROUTINES +"RTN","BMXADO",44,0) +JEP ; EP-RECURSION RE-ENTRY POINT FOR JOINS +"RTN","BMXADO",45,0) + I $G(SUB),$G(SF) S ERR="Invalid request" D ERR(ERR) Q ; CAN'T DO JOIN WITH A SUBFILE AS THE PRIMARY FILE +"RTN","BMXADO",46,0) + S TOT=TOT+1,@OUT@(TOT)="@@@meta@@@BMXIEN"_B_FIEN_B_DAS_U +"RTN","BMXADO",47,0) + I $G(SUB) S TOT=TOT+1,@OUT@(TOT)=FIEN_"|.0001|N|15|DA(1)|TRUE|FALSE|FALSE^" +"RTN","BMXADO",48,0) + I $G(SF) D SFH(SF) ; SUBFILE HEADERS +"RTN","BMXADO",49,0) + S TOT=TOT+1,@OUT@(TOT)=FIEN_"|.001|N|15|BMXIEN|TRUE|TRUE|FALSE^" ; KEY FIELD PART OF HEADER RECORD +"RTN","BMXADO",50,0) + S FLDIEN=0 +"RTN","BMXADO",51,0) + F S FLDIEN=$O(^BMXADO(SIEN,1,FLDIEN)) Q:'FLDIEN S STG=$G(^BMXADO(SIEN,1,FLDIEN,0)) I $L(STG) D ; REST OF HEADER RECORD +"RTN","BMXADO",52,0) + . S X=FIEN_B_$P(STG,U)_B_$P(STG,U,2)_B_$P(STG,U,3)_B_$P(STG,U,4)_B +"RTN","BMXADO",53,0) + . S %=$S($P(STG,U,5):"TRUE",$P($G(^BMXADO(+$G(IEN),0)),U,3):"TRUE",1:"FALSE") S X=X_%_B ; READ ONLY +"RTN","BMXADO",54,0) + . S %=$S($P(STG,U,6):"TRUE",1:"FALSE") S X=X_%_B ; THIS IS A KEY FIELD +"RTN","BMXADO",55,0) + . S %=$S($P(STG,U,7):"TRUE",1:"FALSE") S X=X_%_U ; NULL VALUE IS OK (NOT MANDATORY FOR TRANSACTION) +"RTN","BMXADO",56,0) + . S TOT=TOT+1 +"RTN","BMXADO",57,0) + . S @OUT@(TOT)=X +"RTN","BMXADO",58,0) + . Q +"RTN","BMXADO",59,0) + I TOT'>2 Q ; NOTHING TO PROCESS +"RTN","BMXADO",60,0) + S %=@OUT@(TOT) I $E(%,$L(%))=U S $E(%,$L(%))=$C(30),@OUT@(TOT)=% ; END OF RECORD MARKER +"RTN","BMXADO",61,0) + I $G(VSTG)="",$G(DFLD)=.001 S VSTG="~~~" ; SIMPLE LOOKUP INTO DETAILS FILE BY IEN +"RTN","BMXADO",62,0) + I '$L($G(VSTG)) Q ; REQUEST IS FOR SCHEMA ONLY - NO DATA +"RTN","BMXADO",63,0) +DATASET S VSTG=SIEN_"~"_DAS_"~"_VSTG +"RTN","BMXADO",64,0) + I $O(^TMP("BMX JOIN",$J,1,+$G(SDETAIL),0)) D JVIEW Q ; JOIN ITERATION ; NO SUPPORT FOR EXTENDED JOINS +"RTN","BMXADO",65,0) + D VIEW^BMXADOV(.OUT,VSTG,.TOT) ; APPEND A DATA SET TO A SCHEMA STRING +"RTN","BMXADO",66,0) + I '$L($G(JSTG)) S JSTG=$P(VSTG,"~",11,999) ; INCLUDED FOR BKWD COMPATIBILITY ;JOIN INSTRUCTIONS SPAN MULTIPLE ~ PIECES (11,999) BECAUSE OF POSSIBLE NESTED VSTG +"RTN","BMXADO",67,0) + I $L(JSTG) D JOIN^BMXADOVJ(SIEN,JSTG) ; ADD DATA SET(S) TO FULFIL THE JOIN REQUEST +"RTN","BMXADO",68,0) + Q +"RTN","BMXADO",69,0) + ; +"RTN","BMXADO",70,0) +JVIEW ; JOIN VIEW - SET XCNT AND RESET THE VSTG +"RTN","BMXADO",71,0) + N XCNT,DA,NODE,% +"RTN","BMXADO",72,0) + S NODE=999999999999 +"RTN","BMXADO",73,0) + F S NODE=$O(@OUT@(NODE),-1) Q:'NODE I @OUT@(NODE)["|.001|" Q +"RTN","BMXADO",74,0) + I 'NODE Q ; INVALID SCHEMA - JOIN CANCELLED +"RTN","BMXADO",75,0) + I '$L($P(VSTG,"~",3)),'$G(SUB),$G(DFLD)'=.001 Q ; THERE MUST BE AN INDEX OR SUBFILE FOR A JOIN TO TAKE PLACE +"RTN","BMXADO",76,0) + D JFLD^BMXADOVJ ; STUFF VALUES FOR JOIN FLDS INTO INTRO SEGMENT OF THE SCHEMA +"RTN","BMXADO",77,0) + S XCNT=NODE +"RTN","BMXADO",78,0) + S DA=0 +"RTN","BMXADO",79,0) + F S DA=$O(^TMP("BMX JOIN",$J,1,SDETAIL,DA)) Q:'DA D D VIEW^BMXADOV(.OUT,VSTG,.TOT) ; APPEND JOINED DATA SETS TO A SCHEMA STRING +"RTN","BMXADO",80,0) + . I $P(VSTG,"~",3)="AA",$L($P(VSTG,"~",10)) D Q +"RTN","BMXADO",81,0) + .. S %=$P(VSTG,"~",10) +"RTN","BMXADO",82,0) + .. S $P(%,"|",1)=DA +"RTN","BMXADO",83,0) + .. S $P(VSTG,"~",10)=% +"RTN","BMXADO",84,0) + .. Q +"RTN","BMXADO",85,0) + . I $G(SUB) S DAS=DA_",",VSTG=SDETAIL_"~"_DA_",~~" Q ; SUBFILE ITERATOR +"RTN","BMXADO",86,0) + . I $P(VSTG,"~",3)="AA",$G(FIEN)=9000011 S $P(VSTG,"~",4,5)=DA_"~"_DA Q ; PROBLEM LIST ITERATOR +"RTN","BMXADO",87,0) + . S $P(VSTG,"~",4,5)=DA_"~"_DA ; SINGLE IEN ITERATOR +"RTN","BMXADO",88,0) + . Q +"RTN","BMXADO",89,0) + Q +"RTN","BMXADO",90,0) + ; +"RTN","BMXADO",91,0) +SFH(DAS) ; SUBFILE HEADERS +"RTN","BMXADO",92,0) + N L,LEV,PCE,X,%,Z,FLD +"RTN","BMXADO",93,0) + S Z="000000000",L=$L(DAS,",") +"RTN","BMXADO",94,0) + F PCE=1:1:L-1 D +"RTN","BMXADO",95,0) + . S LEV=(L+1)-PCE +"RTN","BMXADO",96,0) + . S FLD="."_$E(Z,1,LEV+1)_1 +"RTN","BMXADO",97,0) + . S TOT=TOT+1 +"RTN","BMXADO",98,0) + . S @OUT@(TOT)=FIEN_B_FLD_"|I|10|BMXIEN"_(LEV-1)_"|TRUE|TRUE|FALSE"_U ; FIX +"RTN","BMXADO",99,0) + . Q +"RTN","BMXADO",100,0) + Q +"RTN","BMXADO",101,0) + ; +"RTN","BMXADO",102,0) +CKSUB(FILE,DAS) ; CHECK THE DA STRING FOR VALIDITY AND MAKE THE DA ARRAY +"RTN","BMXADO",103,0) + N LEVEL,FIEN +"RTN","BMXADO",104,0) + S FIEN=FILE +"RTN","BMXADO",105,0) + F LEVEL=1:1 S FIEN=$G(^DD(FIEN,0,"UP")) Q:'FIEN ; COUNT THE LEVELS +"RTN","BMXADO",106,0) + I LEVEL'=$L($G(DAS),",") Q -1 ; LEVEL MATCHES DA STRING +"RTN","BMXADO",107,0) + I LEVEL=1 Q "" ; INVALID DA STRING +"RTN","BMXADO",108,0) + Q DAS +"RTN","BMXADO",109,0) + ; +"RTN","BMXADO",110,0) +LINE(FILE) ; GET FIELD VALUES +"RTN","BMXADO",111,0) + N LINE,NODE,STG,DIR,FLD,PF,SET,X,DS,DP +"RTN","BMXADO",112,0) + S LINE="" +"RTN","BMXADO",113,0) + S NODE=2,Y="" F S NODE=$O(ARR(NODE)) Q:'NODE S STG=ARR(NODE) I $L(STG) D I Y=U Q +"RTN","BMXADO",114,0) + . S FLD=$P(STG,B,2) I 'FLD S Y=U Q +"RTN","BMXADO",115,0) + . I $P(STG,B,6)="TRUE" Q ; READ ONLY +"RTN","BMXADO",116,0) + . S DIR("A")=$P(STG,B,5) I '$L(DIR("A")) S Y=U Q +"RTN","BMXADO",117,0) + . S X=$P($G(^DD(+$G(FILE),FLD,0)),U,2) +"RTN","BMXADO",118,0) + . I X["P" D Q +"RTN","BMXADO",119,0) + .. S PF=+$P(X,"P",2) I 'PF S Y=U Q +"RTN","BMXADO",120,0) + .. S DIR(0)="P^"_PF_":EQMZ" +"RTN","BMXADO",121,0) + .. D DIR +"RTN","BMXADO",122,0) + .. Q +"RTN","BMXADO",123,0) + . I X["S" D Q +"RTN","BMXADO",124,0) + .. S DIR(0)="S^"_$P(^DD(FILE,FLD,0),U,3) +"RTN","BMXADO",125,0) + .. D DIR +"RTN","BMXADO",126,0) + .. Q +"RTN","BMXADO",127,0) + . I X["D" D Q +"RTN","BMXADO",128,0) + .. S DS=$P(^DD(FILE,FLD,0),U,5) +"RTN","BMXADO",129,0) + .. I DS'["%DT=""" S DIR(0)="D^::EX" D DIR Q +"RTN","BMXADO",130,0) + .. S DP=$P(DS,"%DT="_$C(34),2) S DP=$P(DP,$C(34,32),1) +"RTN","BMXADO",131,0) + .. S DIR(0)="D^::"_DP +"RTN","BMXADO",132,0) + .. D DIR +"RTN","BMXADO",133,0) + .. Q +"RTN","BMXADO",134,0) + . S DIR="F" +"RTN","BMXADO",135,0) + . D DIR +"RTN","BMXADO",136,0) + . Q +"RTN","BMXADO",137,0) + Q LINE +"RTN","BMXADO",138,0) + ; +"RTN","BMXADO",139,0) +DIR D ^DIR +"RTN","BMXADO",140,0) + I Y?1."^" S Y=U Q +"RTN","BMXADO",141,0) + I Y?1.N1"^".E S Y="`"_+Y +"RTN","BMXADO",142,0) + S LINE=LINE_U_Y +"RTN","BMXADO",143,0) + Q +"RTN","BMXADO",144,0) + ; +"RTN","BMXADO",145,0) +MERR ; MUMPS ERROR TRAP +"RTN","BMXADO",146,0) + N X +"RTN","BMXADO",147,0) + X ("S X=$"_"ZE") +"RTN","BMXADO",148,0) + S X="MUMPS error: """_X_"""" +"RTN","BMXADO",149,0) + D ERR(X) +"RTN","BMXADO",150,0) + Q +"RTN","BMXADO",151,0) + ; +"RTN","BMXADO",152,0) +ERR(ERR) ;EP - BMX ADO SCHEMA ERROR PROCESSOR +"RTN","BMXADO",153,0) + N X +"RTN","BMXADO",154,0) + S X="ERROR|"_ERR_$C(30) +"RTN","BMXADO",155,0) + S @OUT@(1)=X +"RTN","BMXADO",156,0) + Q +"RTN","BMXADO",157,0) + ; +"RTN","BMXADO2") +0^62^B10227201 +"RTN","BMXADO2",1,0) +BMXADO2 ; IHS/CIHA/GIS - BMX ADO RECORDSET UTILS ; +"RTN","BMXADO2",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXADO2",3,0) + ; +"RTN","BMXADO2",4,0) + ; +"RTN","BMXADO2",5,0) +GEN(BMXY,BMXF) ;EP - Generate an ADO Schema string from a list of fields +"RTN","BMXADO2",6,0) + ;BMXY Is an out-parameter called by reference. +"RTN","BMXADO2",7,0) + ;On return, BMXY will be a zero-based one-dimensional array each node of which will +"RTN","BMXADO2",8,0) + ;contain the schema corresponding to the fields info in BMXF +"RTN","BMXADO2",9,0) + ; +"RTN","BMXADO2",10,0) + ;BMXF is an in-parameter called by reference. +"RTN","BMXADO2",11,0) + ;On input, BMXF will contain the field info on which to build the schema string. +"RTN","BMXADO2",12,0) + ; +"RTN","BMXADO2",13,0) + ;Field info in BMXF is arranged in a zero-based one-dimensional array. +"RTN","BMXADO2",14,0) + ;Node 0 of BMXF contains the KEYFIELDNAME^FILENUMBER^READONLY +"RTN","BMXADO2",15,0) + ;where KEYFIELDNAME is the name of the unique key field in the database and +"RTN","BMXADO2",16,0) + ;FILENUMBER is the FileMan file number and +"RTN","BMXADO2",17,0) + ;READONLY denotes whether the entire recordset is updateable. +"RTN","BMXADO2",18,0) + ; +"RTN","BMXADO2",19,0) + ;Each subsequent node of the BMXF arrray contains field info in the form +"RTN","BMXADO2",20,0) + ;1FILE#^2FIELD#^3LENGTH^4DATATYPE^5ALIAS^6READONLY^7KEYFIELD^8NULLOK +"RTN","BMXADO2",21,0) + ;If FILE# AND FIELD# are defined, the LENGTH and DATATYPE will be taken from the FileMan data dictionary +"RTN","BMXADO2",22,0) + ;If ALIAS is defined, the schema string will use ALIAS as the column name +"RTN","BMXADO2",23,0) + ;READONLY, KEYFIELD and NULLOK are binary fields. Note that there should be only one field +"RTN","BMXADO2",24,0) + ;in the recordset having KEYFIELD=TRUE +"RTN","BMXADO2",25,0) + ; +"RTN","BMXADO2",26,0) + ;New column info format is @@@meta@@@KEYFIELD|FILE# +"RTN","BMXADO2",27,0) + ; For each field: ^1FILE#|2FIELD#|3DATATYPE|4LENGTH|5FIELDNAME|6READONLY|7KEYFIELD|8NULL ALLOWED +"RTN","BMXADO2",28,0) + ;example: +"RTN","BMXADO2",29,0) + ;BMXY(0)="@@@meta@@@BMXIEN|2160010^" +"RTN","BMXADO2",30,0) + ;BMXY(1)="2160010|.001|I|10|BMXIEN|TRUE|TRUE|FALSE^" +"RTN","BMXADO2",31,0) + ; +"RTN","BMXADO2",32,0) + S BMXY(0)="@@@meta@@@"_$G(BMXF(0)) +"RTN","BMXADO2",33,0) + N BMXI,BMXS,BMXFM,BMXDD,BMXTYP,BMXLEN,BMXLEN2,BMXNAM,BMXKEY,BMXREAD,BMXNULL +"RTN","BMXADO2",34,0) + S BMXI=0 +"RTN","BMXADO2",35,0) + F S BMXI=$O(BMXF(BMXI)) Q:'+BMXI D +"RTN","BMXADO2",36,0) + . N BMXFM,BMXDD,BMXTYP,BMXLEN,BMXLEN2,BMXNAM,BMXKEY,BMXREAD,BMXNULL +"RTN","BMXADO2",37,0) + . S (BMXDD,BMXTYP,BMXLEN,BMXLEN2,BMXNAM,BMXKEY,BMXREAD,BMXNULL)="" +"RTN","BMXADO2",38,0) + . S BMXFM=0 ;Flag indicating whether BMXF(BMXI) is a FileMan field +"RTN","BMXADO2",39,0) + . S BMXY(BMXI)="" +"RTN","BMXADO2",40,0) + . I BMXF(BMXI) S BMXY(BMXI)=$P(BMXF(BMXI),U,1,2) S BMXFM=1 +"RTN","BMXADO2",41,0) + . I BMXFM D ;Look in ^DD for attributes +"RTN","BMXADO2",42,0) + . . S BMXDD=$G(^DD($P(BMXF(BMXI),U),$P(BMXF(BMXI),U,2),0)) +"RTN","BMXADO2",43,0) + . . ;column name +"RTN","BMXADO2",44,0) + . . S BMXNAM=$P(BMXDD,U) +"RTN","BMXADO2",45,0) + . . S BMXNAM=$TR(BMXNAM," ","_") +"RTN","BMXADO2",46,0) + . . ;Data type +"RTN","BMXADO2",47,0) + . . I $P(BMXDD,U,2)["P" S BMXDD=$$PTYPE(BMXDD) +"RTN","BMXADO2",48,0) + . . S BMXTYP=$P(BMXDD,U,2) +"RTN","BMXADO2",49,0) + . . S BMXTYP=$S(BMXTYP["F":"T",BMXTYP["S":"T",BMXTYP["D":"D") +"RTN","BMXADO2",50,0) + . . I BMXTYP["N" S BMXTYP=$S($P(BMXTYP,",",2)>0:"N",1:"I") +"RTN","BMXADO2",51,0) + . . ;default columnn lengths based on type +"RTN","BMXADO2",52,0) + . . I BMXTYP="N"!(BMXTYP="I") S BMXLEN=$P(BMXDD,U,2),BMXLEN=$P(BMXLEN,","),BMXLEN=$E(BMXLEN,3,$L(BMXLEN)) +"RTN","BMXADO2",53,0) + . . I BMXTYP="I" S BMXLEN2=$P(BMXDD,U,2),BMXLEN2=$P(BMXLEN,",",2),BMXLEN=BMXLEN+BMXLEN2+1 +"RTN","BMXADO2",54,0) + . . I BMXTYP="T" S BMXLEN=0 +"RTN","BMXADO2",55,0) + . . I BMXTYP="D" S BMXLEN=30 +"RTN","BMXADO2",56,0) + . . S BMXNULL="TRUE" S:$P(BMXDD,U,2)["R" BMXNULL="FALSE" +"RTN","BMXADO2",57,0) + . ;Look in BMXF for user-specified attributes +"RTN","BMXADO2",58,0) + . S:$P(BMXF(BMXI),U,5)]"" BMXNAM=$P(BMXF(BMXI),U,5) ;Alias +"RTN","BMXADO2",59,0) + . ;Set KEY, NULL and READONLY +"RTN","BMXADO2",60,0) + . S BMXNULL="TRUE",BMXREAD="TRUE",BMXKEY="FALSE" +"RTN","BMXADO2",61,0) + . I $P(BMXF(BMXI),U,7)="TRUE" S BMXKEY="TRUE",BMXNULL="FALSE",BMXREAD="TRUE" +"RTN","BMXADO2",62,0) + . E S:$P(BMXF(BMXI),U,8)]"" BMXNULL=$P(BMXF(BMXI),U,8) S:$P(BMXF(BMXI),U,6)]"" BMXREAD=$P(BMXF(BMXI),U,6) +"RTN","BMXADO2",63,0) + . ;Set BMXY node +"RTN","BMXADO2",64,0) + . S $P(BMXY(BMXI),"|",3)=BMXTYP +"RTN","BMXADO2",65,0) + . S $P(BMXY(BMXI),"|",4)=BMXLEN +"RTN","BMXADO2",66,0) + . S $P(BMXY(BMXI),"|",5)=BMXNAM +"RTN","BMXADO2",67,0) + . S $P(BMXY(BMXI),"|",6)=BMXREAD +"RTN","BMXADO2",68,0) + . S $P(BMXY(BMXI),"|",7)=BMXKEY +"RTN","BMXADO2",69,0) + . S $P(BMXY(BMXI),"|",8)=BMXNULL +"RTN","BMXADO2",70,0) + ; +"RTN","BMXADO2",71,0) + Q +"RTN","BMXADO2",72,0) +PTYPE(BMXDD) ; +"RTN","BMXADO2",73,0) + ;Traverse pointer chain to retrieve data type of pointed-to field +"RTN","BMXADO2",74,0) + N BMXFILE +"RTN","BMXADO2",75,0) + I $P(BMXDD,U,2)'["P" Q BMXDD +"RTN","BMXADO2",76,0) + S BMXFILE=$P(BMXDD,U,2) +"RTN","BMXADO2",77,0) + S BMXFILE=+$P(BMXFILE,"P",2) +"RTN","BMXADO2",78,0) + S BMXDD=$G(^DD(BMXFILE,".01",0)) +"RTN","BMXADO2",79,0) + S BMXDD=$$PTYPE(BMXDD) +"RTN","BMXADO2",80,0) + Q BMXDD +"RTN","BMXADOF") +0^63^B90964967 +"RTN","BMXADOF",1,0) +BMXADOF ; IHS/CIHA/GIS - RPC CALL FOR EXTENDED FUNCTIONALITY OF BMXNet UTILITIES ; +"RTN","BMXADOF",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXADOF",3,0) + ; THIS IS THE ADO RECORDSET FILER: ADO -> FILEMAN +"RTN","BMXADOF",4,0) + ; VISIT FILE UPDATES REPRESENT A SPECIAL CASE HTAT IS MANAGED IN BMXADOF1 +"RTN","BMXADOF",5,0) + ; INCLUDES TRANSACTION CONTROLS +"RTN","BMXADOF",6,0) + ; +"RTN","BMXADOF",7,0) + ; +"RTN","BMXADOF",8,0) + ; +"RTN","BMXADOF",9,0) + N DAS,FILE,DATA,OUT S DAS=7,FILE=19707.82,DATA="2.02|120/83" D FILE(.OUT,FILE,DAS,DATA) W !,OUT Q +"RTN","BMXADOF",10,0) + ; +"RTN","BMXADOF",11,0) +FILED(OUT,FILE,DAS,DATA) ; RPC CALL: UNIVERSAL FILEMAN RECORD UPDATER UTILITY +"RTN","BMXADOF",12,0) + D DEBUG^%Serenji("FILE^BMXADOF(.OUT,FILE,DAS,DATA)") ; DEBUGGER ENTRY POINT +"RTN","BMXADOF",13,0) + ; K ^GREG S ^GREG("OUT")=$G(OUT),^("FILE")=$G(FILE),^("DAS")=$G(DAS),^("DATA")=$G(DATA) D FILE(.OUT,FILE,DAS,DATA) +"RTN","BMXADOF",14,0) + Q +"RTN","BMXADOF",15,0) + ; +"RTN","BMXADOF",16,0) +FILEX(OUT,FILE,DAS,DATA) ; EP - RPC CALL: INSURES THAT BMXIEN IS VALID - MOJO ONLY +"RTN","BMXADOF",17,0) + I '$L($G(DATA)) D +"RTN","BMXADOF",18,0) + . S DATA="",%="" +"RTN","BMXADOF",19,0) + . F S %=$O(DATA(%)) Q:'% S DATA=DATA_DATA(%) ; CONVERT DATA ARRAY INTO A DATA STRING +"RTN","BMXADOF",20,0) + . Q +"RTN","BMXADOF",21,0) + I '$L(DATA) Q +"RTN","BMXADOF",22,0) + I DATA["999|" S DAS=+$P(DATA,"999|",2) I 'DAS S DAS="" ; FORCE NEW ENTRY +"RTN","BMXADOF",23,0) + D FILE(.OUT,FILE,$G(DAS),DATA) +"RTN","BMXADOF",24,0) + Q +"RTN","BMXADOF",25,0) + ; +"RTN","BMXADOF",26,0) +FILE(OUT,FILE,DAS,DATA) ;EP - RPC CALL: UNIVERSAL FILEMAN RECORD UPDATER UTILITY +"RTN","BMXADOF",27,0) + ; +"RTN","BMXADOF",28,0) + ; OUT = OUTBOUND MESSAGE RETURNED TO CALLINING APP. 'OK'=SUCCESSFUL TRANSACTION, 'OK|5' NEW RECORD DAS=5 ADDED +"RTN","BMXADOF",29,0) + ; IF TRANSACTION FAILS, AN ERROR MESSAGE IS PASSED +"RTN","BMXADOF",30,0) + ; FILE = VALID FILEMAN FILE OR SUB-FILE NUMBER - WHERE UPDATE IS TO OCCUR +"RTN","BMXADOF",31,0) + ; DAS = THE DA STRING - TYPICALLY THE FILE INTERNAL ENTRY NUMBER OF THE RECORD TO BE UPDATED +"RTN","BMXADOF",32,0) + ; IF THIS IS A SUB-FILE, DAS MUST BE PRECEDED BY PARENT DAS(S) IN COMMA SEPARATED STRING - TOP TO BOTTOM ORDER +"RTN","BMXADOF",33,0) + ; DAS MAY BE PRECEDED BY '+' = ALL FIELDS ARE MANDATORY (REQD FOR TRANSACTION) OR '-' = DELETE THIS ENTRY +"RTN","BMXADOF",34,0) + ; IF DAS STRING = NULL OR = '+', THIS MEANS ADD A NEW RECORD WITH DATA SUPPLIED IN DATA PARAMETER +"RTN","BMXADOF",35,0) + ; EXAMPLES OF DAS STRINGS: '1' (EDIT RECORD #1), '5,2,-7' (DELETE RECORD #7 IN 3RD LEVEL SUBFILE) +"RTN","BMXADOF",36,0) + ; DATA = DATA STRING OR ARRAY REFERENCE. DATA CAN BE PASSED USING THE .PARAM SYNTAX +"RTN","BMXADOF",37,0) + ; DATA STRING FORMAT: FIELD#|VALUE_$C(30)_FIELD#|VALUE_$C(30)_...FIELD#|VALUE_$C(30) +"RTN","BMXADOF",38,0) + ; $C(30) [AKA EOR] IS THE DATA ELEMENT SEPARATOR +"RTN","BMXADOF",39,0) + ; $C(30) IS USED AS THE DATA DELIMITER BECAUSE OTHER CHARACTERS LIKE '^' COULD APPEAR IN THE VALUE PIECE! +"RTN","BMXADOF",40,0) + ; EA FIELD# MAY BE PRECEED BY '+' = MANDATORY (REQD FOR TRANSACTION) OR '-' = DELETE THE VALUE OF THIS FIELD +"RTN","BMXADOF",41,0) + ; EXAMPLE: ".03|1/5/46"_EOR_"-.02|"_EOR_"+.09|139394444"_EOR NOTE -.02| IS SAME AS .02|@ OR .02| +"RTN","BMXADOF",42,0) + ; '+' IN FRONT OF THE DAS IS THE SAME AS PUTTING A '+' IN FRONT OF EVERY FIELD# IN THE DATA STRING +"RTN","BMXADOF",43,0) + ; +"RTN","BMXADOF",44,0) + ; +"RTN","BMXADOF",45,0) + ; +"RTN","BMXADOF",46,0) + N VENDUZ,VUZ +"RTN","BMXADOF",47,0) + M VENDUZ=DUZ S VUZ=$C(68,85,90) +"RTN","BMXADOF",48,0) + N OREF,CREF,DIC,DIE,DA,DR,X,Y,%,I,FLD,CNT,FNO,VAL,@VUZ,TFLG,DFLG,TOT,UFLG,XTFLG,GTFLG,GDFLG,LVLS,IENS +"RTN","BMXADOF",49,0) + I $G(FILE)=9000010 N AUPNPAT,AUPNDOB,AUPNDOD,AUPNVSIT,AUPNTALK,APCDOVRR S (APCDOVRR,AUPNTALK)=1 ; THE VISIT FILE IS UPDATED IN THIS TRANSACTION +"RTN","BMXADOF",50,0) + X ("M "_$C(68,85,90)_"=VENDUZ S "_$C(68,85,90)_"(0)="_$C(34,64,34)) K VENDUZ ; ELININATES PERMISSION PROBLEMS +"RTN","BMXADOF",51,0) + S OUT="",FLD="",GTFLG=0,GDFLG=0 +"RTN","BMXADOF",52,0) + S X="MERR^BMXADOF",@^%ZOSF("TRAP") ; SET MUMPS ERROR TRAP +"RTN","BMXADOF",53,0) + I '$D(^DD(+$G(FILE))) S OUT="Invalid file number" Q ; FILE # MUST BE VALID +"RTN","BMXADOF",54,0) + S DAS=$G(DAS) I $E(DAS)="," S DAS=$E(DAS,2,99) ; ACCURATE IF NON SUB-FILE DAS STRING DOSN'T CONTAIN A "," +"RTN","BMXADOF",55,0) + S LVLS=$L(DAS,",") +"RTN","BMXADOF",56,0) + S %=FILE F CNT=1:1 S %=$G(^DD(%,0,"UP")) I '% Q ; COUNT FILE/SUB-FILE LEVELS IN THE DATA DICTIONARY +"RTN","BMXADOF",57,0) + I LVLS'=CNT S OUT="Invalid DAS string" Q ; LEVELS IN DAS STRING MUST MATCH LEVELS IN THE DATA DICTIONARY +"RTN","BMXADOF",58,0) + I $E(DAS)="-" S DAS=$E(DAS,2,99),GDFLG=1 ; GLOBAL DELETE FLAG +"RTN","BMXADOF",59,0) + I $E(DAS)="+" S DAS=$E(DAS,2,99),GTFLG=1 ; GLOBAL TRANSACTION FLAG, ROLLBACK IF ANY FIELD FAILS TO UPDATE +"RTN","BMXADOF",60,0) + I LVLS>1 F I=1:1:LVLS D I DAS="ERR" S OUT="Invalid DAS string" Q ; MAKE DAS ARRAY. MIRRORS THE DA() ARRAY +"RTN","BMXADOF",61,0) + . I I=LVLS S DAS=$P(DAS,",",I) Q ; SET DAS OF SUBFILE +"RTN","BMXADOF",62,0) + . S %=$P(DAS,",",I) I '% S DAS="ERR" Q +"RTN","BMXADOF",63,0) + . S DAS(LVLS-I)=% ; SET DAS(S) OF PARENT FILE(S). LIKE DA(), THE LARGER THE DAS SUBSCRIPT, THE HIGHER THE LEVEL +"RTN","BMXADOF",64,0) + . Q +"RTN","BMXADOF",65,0) + I DAS="ERR" S OUT="Update cancelled. Invalid DAS string" Q +"RTN","BMXADOF",66,0) + I DAS="Add"!(DAS="ADD") S DAS="" +"RTN","BMXADOF",67,0) + S %=$E(DAS) I %="-" S GDFLG=1,DAS=$E(DAS,2,99) ; YET ANOTHER WAY TO SET GLOBAL DELETE FLAG +"RTN","BMXADOF",68,0) + S %=$$REF(FILE,.DAS) ; GET OPEN REF, CLOSED REF, AND IENS STRING +"RTN","BMXADOF",69,0) + S OREF=$P(%,"|"),CREF=$P(%,"|",2),IENS=$P(%,"|",3) I $L(OREF),$L(CREF) +"RTN","BMXADOF",70,0) + E S OUT="Update cancelled. Invalid file definition/global reference" Q ; ERROR REPORT +"RTN","BMXADOF",71,0) + I DAS,'$D(@CREF@(DAS)) S OUT="Update cancelled. Invalid DAS" Q ; IF THERE IS AN DAS, IT MUST BE VALID +"RTN","BMXADOF",72,0) + I '$G(DAS),FILE=9000010,'$$VVAR^BMXADOF2(DATA) Q ; VISIT FILE ADD REQUIRES THAT SPECIAL VARIABLES BE PRESENT AND VALID +"RTN","BMXADOF",73,0) + I 'GDFLG,DAS,DATA[".01|@" S GDFLG=1 ; ALTERNATE WAY TO SET GLOBAL DELETE FLAG: REMOVE .01 FIELD +"RTN","BMXADOF",74,0) + I GDFLG,'DAS S OUT="Deletion cancelled. Missing DAS" Q ; CAN'T DO DELETE WITHOUT AN DAS +"RTN","BMXADOF",75,0) + I GDFLG D DIK(OREF,DAS) S OUT="Record deleted|"_DAS Q ; DELETE AND QUIT +"RTN","BMXADOF",76,0) + S UFLG=$S($G(DAS):"E",1:"A") ; SET UPDATE FLAG: ADD OR EDIT +"RTN","BMXADOF",77,0) + I '$L($G(DATA)) D I '$L($G(DATA)) S OUT="Update cancelled. Missing/invalid data string" Q ; COMPRESS DATA ARRAY INTO A SINGLE STRING +"RTN","BMXADOF",78,0) + . S DATA="",%="" +"RTN","BMXADOF",79,0) + . F S %=$O(DATA(%)) Q:'% S DATA=DATA_DATA(%) ; CONVERT DATA ARRAY INTO A DATA STRING +"RTN","BMXADOF",80,0) + . Q +"RTN","BMXADOF",81,0) + S %=$L(DATA) S %=$E(DATA,%-1,%) D ; CHECK FOR PROPER TERMINATION OF DATA STRING +"RTN","BMXADOF",82,0) + . I %=$C(30,31) Q ; PROPER TERMINATION +"RTN","BMXADOF",83,0) + . I $E(%,2)=$C(30) S DATA=DATA_$C(31) Q +"RTN","BMXADOF",84,0) + . I $E(%,2)=$C(31) S DATA=$E(DATA,1,$L(DATA-1))_$C(30,31) +"RTN","BMXADOF",85,0) + . S DATA=DATA_$C(30,31) +"RTN","BMXADOF",86,0) + . Q +"RTN","BMXADOF",87,0) + S TOT=$L(DATA,$C(30)) I 'TOT S OUT="Update cancelled. Missing data string" Q +"RTN","BMXADOF",88,0) +SPEC S DATA=$$SPEC^BMXADOFS(FILE,DATA,UFLG) ; BASED ON FILE IEN, SPECIAL MODS MAY BE MADE TO THE DATA STRING +"RTN","BMXADOF",89,0) + S TOT=$L(DATA,$C(30)) I 'TOT S OUT="Update cancelled. SPEC analysis failed." Q +"RTN","BMXADOF",90,0) + F CNT=1:1:TOT S %=$P(DATA,$C(30),CNT) I $L(%) S DATA(CNT)=% ; BUILD PRIMARY FIELD ARRAY +"RTN","BMXADOF",91,0) + S %=$G(DATA(1)) I %=""!(%=$C(31)) S OUT="Update cancelled. Missing data string" Q +"RTN","BMXADOF",92,0) + S %=DATA(CNT) I %[$C(31) S %=$P(%,$C(31),1),DATA(CNT)=% ; STRIP OFF END OF FILE MARKER +"RTN","BMXADOF",93,0) + F CNT=1:1:TOT S X=$G(DATA(CNT)) I $L(X) D ; BUILD SECONDARY FIELD ARRAY +"RTN","BMXADOF",94,0) + . S TFLG=0,DFLG=0 +"RTN","BMXADOF",95,0) + . I $E(X)="+" S TFLG=1,X=$E(X,2,999),$P(FLD,U)=1 +"RTN","BMXADOF",96,0) + . I $E(X)="-" S DFLG=1,X=$E(X,2,999) +"RTN","BMXADOF",97,0) + . S FNO=$P(X,"|"),VAL=$P(X,"|",2) +"RTN","BMXADOF",98,0) + . I '$D(^DD(FILE,+$G(FNO),0)) S:$L(OUT) OUT=OUT_"~" S OUT=OUT_FNO_"|Invalid field number" Q +"RTN","BMXADOF",99,0) + . I DFLG,VAL'="" S:$L(OUT) OUT=OUT_"~" S OUT=OUT_FNO_"|Invalid deletion syntax" Q ; CANT DELETE IF A VALUE IS SENT +"RTN","BMXADOF",100,0) + . I VAL="@" S DFLG=1 ; SYNC DFLG AND VAL +"RTN","BMXADOF",101,0) + . S FLD(FNO)=VAL_U_TFLG_U_DFLG +"RTN","BMXADOF",102,0) + . I FNO=.01,TFLG S $P(FLD,U,2)=1 +"RTN","BMXADOF",103,0) + . Q +"RTN","BMXADOF",104,0) + I $P($G(FLD(.01)),U,3),UFLG="A" S OUT="Record deletion cancelled. Missing DAS" Q ; CAN'T DELETE A RECORD WITHOUT A VALID DAS +"RTN","BMXADOF",105,0) + I $P($G(FLD(.01)),U,3)!($G(GDFLG)) S UFLG="D" ; DELETION +"RTN","BMXADOF",106,0) +DELREC I UFLG="D" D DIK(OREF,DAS) S OUT="OK" Q ; DELETE THE RECORD +"RTN","BMXADOF",107,0) + I UFLG="A",'$L($P($G(FLD(.01)),U)) S OUT="Record addition cancelled. Missing .01 field" Q ; CAN'T ADD A RECORD WITHOUT A VALID .01 FIELD +"RTN","BMXADOF",108,0) +DINUM I UFLG="A",$G(^DD(FILE,.01,0))["DINUM=X" D ; IF DINUM'D RECORD EXISTS, SWITCH TO MOD MODE +"RTN","BMXADOF",109,0) + . S %=FLD(.01) +"RTN","BMXADOF",110,0) + . I $E(%)="`" S %=+$E(%,2,99) +"RTN","BMXADOF",111,0) + . I '$D(@CREF@(%,0)) Q ; OK TO ADD BRAND NEW RECORD BUT EXISTING RECORDS MUST BE EDITED +"RTN","BMXADOF",112,0) + . K FLD(.01) +"RTN","BMXADOF",113,0) + . S DAS=%,UFLG="E" +"RTN","BMXADOF",114,0) + . Q +"RTN","BMXADOF",115,0) +ADDREC I UFLG="A" D ADD(OREF) Q ; ADD A NEW ENTRY TO A FILE +"RTN","BMXADOF",116,0) +EDITREC I UFLG="E" D EDIT(OREF,DAS) Q ; EDIT AN EXISTING RECORD +"RTN","BMXADOF",117,0) + Q +"RTN","BMXADOF",118,0) + ; +"RTN","BMXADOF",119,0) +DIK(DIK,DA) ; DELETE A RECORD +"RTN","BMXADOF",120,0) + ; PATCHED BY GIS 9/28/04 TO FIX PROBLEMS WITH SUBFILE DELETION +"RTN","BMXADOF",121,0) + I '$G(DAS(1)) G DIK1 ; CHECK FOR SUBFILE DELETION +"RTN","BMXADOF",122,0) + N DA,IENS,I,DIK +"RTN","BMXADOF",123,0) + I '$G(FILE) Q +"RTN","BMXADOF",124,0) + S I=0,IENS=DAS_"," +"RTN","BMXADOF",125,0) + M DA=DAS +"RTN","BMXADOF",126,0) + F S I=$O(DAS(I)) Q:'I S IENS=IENS_DAS(I)_"," +"RTN","BMXADOF",127,0) + S DIK=$$ROOT^DILFD(FILE,IENS) I '$L(DIK) Q +"RTN","BMXADOF",128,0) +DIK1 D ^DIK +"RTN","BMXADOF",129,0) + D ^XBFMK +"RTN","BMXADOF",130,0) + Q +"RTN","BMXADOF",131,0) + ; +"RTN","BMXADOF",132,0) +ADD(DIC) ; ADD A NEW ENTRY TO A FILE +"RTN","BMXADOF",133,0) + N X,Y,%,DA,DN,UP,SB,DNODE,ERR +"RTN","BMXADOF",134,0) + S X=$P($G(FLD(.01)),U) I '$L(X) S OUT="Unable to add a new record" Q +"RTN","BMXADOF",135,0) + S X=$$POINT(FILE,.01,X) ; ADD ACCENT GRAV IF NECESSARY +"RTN","BMXADOF",136,0) + S X=""""_X_"""" ; FORCE A NEW ENTRY +"RTN","BMXADOF",137,0) + S DIC(0)="L" +"RTN","BMXADOF",138,0) + I $O(DAS(0)) D I $G(ERR) S Y=-1 G AFAIL ; GET DIC("P") IF NECESSARY +"RTN","BMXADOF",139,0) + . S %=0 F S %=$O(DAS(%)) Q:'% S DA(%)=DAS(%) ; CREATE THE DA ARRAY +"RTN","BMXADOF",140,0) + . S UP=$G(^DD(FILE,0,"UP")) I 'UP S ERR=1 Q +"RTN","BMXADOF",141,0) + . S SB=$O(^DD(UP,"SB",FILE,0)) I 'SB S ERR=1 Q +"RTN","BMXADOF",142,0) + . S DIC("P")=$P($G(^DD(UP,SB,0)),U,2) I '$L(DIC("P")) S ERR=1 Q +"RTN","BMXADOF",143,0) + . S DN=DIC_"1,0)" I $D(DN) Q +"RTN","BMXADOF",144,0) + . S @DN=(U_DIC("P")_U_U) ; CREATE THE DICTIONARY NODE +"RTN","BMXADOF",145,0) + . Q +"RTN","BMXADOF",146,0) +ADIC D ^DIC +"RTN","BMXADOF",147,0) +AFAIL I Y=-1 S OUT="Unable to add a new record" G AX +"RTN","BMXADOF",148,0) + I $O(FLD(0)) D EDIT(DIC,+Y) Q +"RTN","BMXADOF",149,0) + S OUT="OK"_"|"_+Y +"RTN","BMXADOF",150,0) +AX D ^XBFMK +"RTN","BMXADOF",151,0) + Q +"RTN","BMXADOF",152,0) + ; +"RTN","BMXADOF",153,0) +EDIT(DIE,DA) ; EDIT AN EXISTING RECORD +"RTN","BMXADOF",154,0) + N DR,RFLG,ERR,FNO,VAL,TFLG,RESULT,MSG,DIERR,DISYS,SF,APCDALVR +"RTN","BMXADOF",155,0) + S FNO=0,DR="",APCDALVR="" +"RTN","BMXADOF",156,0) + I UFLG="A" S OUT="OK New record added|"_DA +"RTN","BMXADOF",157,0) + F S FNO=$O(FLD(FNO)) Q:'FNO S X=FLD(FNO) I $L(X) D I $G(RFLG) Q ; CHECK EA FIELD AND BUILD THE DR STRING AND ERROR STRING +"RTN","BMXADOF",158,0) + . S VAL(FNO)=$P(X,U),TFLG=$P(X,U,2) I '$L(VAL(FNO)) Q +"RTN","BMXADOF",159,0) + . S SF=$$WP(FILE,FNO) +"RTN","BMXADOF",160,0) + . I SF D WORD(FILE,DA,FNO,CREF,VAL(FNO)) Q ; WORD PROCESSING FIELDS MANAGED SEPARATELY +"RTN","BMXADOF",161,0) + . S VAL(FNO)=$$POINT(FILE,FNO,VAL(FNO)) ; ADD ACCENT GRAV IF NECESSARY +"RTN","BMXADOF",162,0) + . K ERR,RESULT +"RTN","BMXADOF",163,0) + . I VAL(FNO)="@"!(VAL(FNO)="") S RESULT="@" +"RTN","BMXADOF",164,0) + . I FNO=.01,UFLG="A" S:$E(VAL(.01))="`" VAL(.01)=$E(VAL(.01),2,999) Q ; NO NEED TO EDIT THE .01 FIELD OF A RECORD THAT HAS JUST BEEN CREATED +"RTN","BMXADOF",165,0) + . I FILE\1=9000010,$L($P(FILE,".",2))=2,UFLG="E",(FNO=.02!(FNO=.03)) Q ; CAN'T EDIT EXISTING PT AND VISIT FIELDS OF V FILES +"RTN","BMXADOF",166,0) + . I FILE\1=9000010,$L($P(FILE,".",2))=2,UFLG="A",FNO=.03,VAL(.03)?1"`"1.N S %=+$E(VAL(.03),2,99) I $D(^AUPNVSIT(%,0)) S RESULT=% G E1 +"RTN","BMXADOF",167,0) + . I FILE=9000011,FNO=.07,VAL(.07)?1.N S RESULT=VAL(.07) G E1 ; THE VALIDITY CHECK FAILS - SO BYPASS THIS +"RTN","BMXADOF",168,0) +CHK . I VAL(FNO)'="@" D CHK^DIE(FILE,FNO,"",VAL(FNO),.RESULT,.ERR) +"RTN","BMXADOF",169,0) +E1 . I RESULT=U D Q +"RTN","BMXADOF",170,0) + .. S MSG=$G(ERR("DIERR",1,"TEXT",1),"Failed FileMan data validation") +"RTN","BMXADOF",171,0) + .. I $L(OUT) S OUT=OUT_"~" +"RTN","BMXADOF",172,0) + .. I TFLG!GTFLG S RFLG=1,OUT=FNO_"|"_MSG Q +"RTN","BMXADOF",173,0) + .. S OUT=OUT_FNO_"|"_MSG +"RTN","BMXADOF",174,0) + .. Q +"RTN","BMXADOF",175,0) + . S VAL(FNO)=RESULT +"RTN","BMXADOF",176,0) + . I $L(DR) S DR=DR_";" +"RTN","BMXADOF",177,0) + . I RESULT="@" S DR=DR_FNO_"////@" Q ; DELETE THIS VALUE +"RTN","BMXADOF",178,0) + . S DR=DR_FNO_"////^S X=VAL("_FNO_")" ; BUILD DR STRING +"RTN","BMXADOF",179,0) + . Q +"RTN","BMXADOF",180,0) + I $G(RFLG) D:UFLG="A" DIK(DIE,DA) S OUT="Record update cancelled"_"|"_OUT G EX ; TRANSACTION ROLLBACK FLAG IS SET, ENTRY DELETED (ADD MODE) OR UPDATE CANCELLED (EDIT MODE) +"RTN","BMXADOF",181,0) + S %=0 F S %=$O(DAS(%)) Q:'% S DA(%)=DAS(%) ; JUST IN CASE THIS IS A MILTIPLE, CREATE THE DA ARRAY +"RTN","BMXADOF",182,0) +DIE L +@CREF@(DA):2 I $T D ^DIE L -@CREF@(DA) G:OUT["valid" EX S OUT="OK" S:UFLG="A" OUT=OUT_"|"_DA G EX ; SUCCESS!!!! +"RTN","BMXADOF",183,0) + S OUT="Update cancelled. File locked" ; FILE LOCKED. UNABLE TO UPDATE +"RTN","BMXADOF",184,0) + I $L(FLD),UFLG="A" D DIK(DIE,DA) ; ROLLBACK THE NEW RECORD +"RTN","BMXADOF",185,0) +EX D ^XBFMK ; CLEANUP +"RTN","BMXADOF",186,0) + Q +"RTN","BMXADOF",187,0) + ; +"RTN","BMXADOF",188,0) +REF(FILE,DAS) ; GIVEN A FILE/SUBFILE NUMBER & DAS ARRAY, RETURN THE FM GLOBAL REFERENCE INFO: OREF|CREF|IENS +"RTN","BMXADOF",189,0) + N OREF,CREF,IENS,I,X +"RTN","BMXADOF",190,0) + S IENS=$$IENS^DILF(.DAS) I '$L(IENS) Q "" +"RTN","BMXADOF",191,0) + S OREF=$$ROOT^DILFD(FILE,IENS) I '$L(OREF) Q "" +"RTN","BMXADOF",192,0) + S CREF=$$CREF^DILF(OREF) I '$L(CREF) Q "" +"RTN","BMXADOF",193,0) + Q (OREF_"|"_CREF_"|"_IENS) +"RTN","BMXADOF",194,0) + ; +"RTN","BMXADOF",195,0) +POINT(FILE,FNO,VAL) ; ADD ACCENT GRAV IF NECESSARY +"RTN","BMXADOF",196,0) + I $E(VAL)="`" Q VAL +"RTN","BMXADOF",197,0) + I $P($G(^DD(FILE,FNO,0)),U,2)["P",VAL=+VAL,VAL\1=VAL S VAL="`"_VAL +"RTN","BMXADOF",198,0) + Q VAL +"RTN","BMXADOF",199,0) + ; +"RTN","BMXADOF",200,0) +WP(FILE,FLD) ; RETURN THE SUBFILE NUMBER IF IT IS A WORD PROCESSING FIELD +"RTN","BMXADOF",201,0) + N SF,DTYPE +"RTN","BMXADOF",202,0) + S SF=$P($G(^DD(+$G(FILE),+$G(FLD),0)),U,2) I 'SF Q 0 +"RTN","BMXADOF",203,0) + S DTYPE=$P($G(^DD(SF,.01,0)),U,2) +"RTN","BMXADOF",204,0) + I DTYPE["W" Q SF +"RTN","BMXADOF",205,0) + Q 0 +"RTN","BMXADOF",206,0) + ; +"RTN","BMXADOF",207,0) +WORD(FILE,DA,FLD,CREF,VAL) ; SUFF TEXT ENTRY INTO THE WP MULTIPLE FIELD +"RTN","BMXADOF",208,0) + N SS,TOT,A,B,I +"RTN","BMXADOF",209,0) + S SS=+$P($G(^DD(FILE,FLD,0)),U,4) I SS="" Q +"RTN","BMXADOF",210,0) + I VAL="@"!(VAL="") K @CREF@(DA,SS) Q ; DELETE THE WP RECORD: REMOVE DICTIONARY NODE AND DATA +"RTN","BMXADOF",211,0) + S TOT=0 +"RTN","BMXADOF",212,0) + F Q:'$L(VAL) D +"RTN","BMXADOF",213,0) + . S A=$E(VAL,1,80),VAL=$E(VAL,81,999999) ; PEEL OFF AN 80 CHARACTER DATA BLOCK FROM THE FRONT OF THE TEXT STRING +"RTN","BMXADOF",214,0) + . I $L(A) S TOT=TOT+1,B(TOT)=A ; BUILD THE TEMP ARRAY +"RTN","BMXADOF",215,0) + . Q +"RTN","BMXADOF",216,0) + I '$D(B(1)) Q ; NOTHING TO STORE SO QUIT +"RTN","BMXADOF",217,0) + S @CREF@(DA,SS,0)="^^"_TOT_U_TOT_U_DT ; SET DICTIONARY NODE +"RTN","BMXADOF",218,0) + F I=1:1:TOT S @CREF@(DA,SS,I,0)=B(I) ; SET DATA NODES +"RTN","BMXADOF",219,0) + Q +"RTN","BMXADOF",220,0) + ; +"RTN","BMXADOF",221,0) +MERR ; MUMPS ERROR TRAP +"RTN","BMXADOF",222,0) + N ERR,X +"RTN","BMXADOF",223,0) + X ("S X=$"_"ZE") +"RTN","BMXADOF",224,0) + S ERR="M ERROR: "_X +"RTN","BMXADOF",225,0) + S ^GREG("ERR")=ERR +"RTN","BMXADOF",226,0) + S OUT=ERR +"RTN","BMXADOF",227,0) + Q +"RTN","BMXADOF",228,0) + ; +"RTN","BMXADOF1") +0^64^B12833341 +"RTN","BMXADOF1",1,0) +BMXADOF1 ; IHS/CIHA/GIS - RPC CALL FOR EXTENDED FUNCTIONALITY OF BMXNet UTILITIES ; +"RTN","BMXADOF1",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXADOF1",3,0) + ; UPDATE FILEMAN WITH AN ADO RECORD SET FROM A WINDOWS/WEB APPLICATION +"RTN","BMXADOF1",4,0) + ; +"RTN","BMXADOF1",5,0) + ; +"RTN","BMXADOF1",6,0) + D BAFM(.OUT,$NA(^TMP("BMX ADO",6))) ; W !!! ZW OUT K OUT Q +"RTN","BMXADOF1",7,0) + ; +"RTN","BMXADOF1",8,0) +BAFM(OUT,CREF) ; EP- RPC: PASS DATA FROM A STD BROKER ADO ARRAY TO FILEMAN AND RETURN THE ACK MSG IN 'OUT' ARRAY +"RTN","BMXADOF1",9,0) + I '$L($G(CREF)) Q ; REFERENCE MUST EXIST +"RTN","BMXADOF1",10,0) + I '$D(@CREF) Q ; DATASET MUST EXIST +"RTN","BMXADOF1",11,0) + N NODE,STG,DATA,SCHEMA,X,ECNT,CNT +"RTN","BMXADOF1",12,0) + S OUT="DONE",ECNT=0,CNT=0 +"RTN","BMXADOF1",13,0) +PEEL S NODE=0,STG="" ; PEEL DATA OFF THE ARRAY AND FILE IT +"RTN","BMXADOF1",14,0) + F S NODE=$O(@CREF@(NODE)) Q:'NODE D ; LOOP THRU THE NODES TO BUILD A STRING. +"RTN","BMXADOF1",15,0) + . S X=@CREF@(NODE) I X="" Q +"RTN","BMXADOF1",16,0) + . S STG=STG_X +"RTN","BMXADOF1",17,0) + . I STG[$C(30) D S STG="" Q ; WHEN YOU HIT $C(30), PROCESS THE CURRENT STRING, AND THEN START A NEW STRING. +"RTN","BMXADOF1",18,0) + .. S STG=$TR(STG,$C(30),"") ; REMOVE THE EOR CHARACTER $C(30) FROM THE END OF THE STRING +"RTN","BMXADOF1",19,0) + .. I STG["@@@meta@@@" S SCHEMA=STG Q ; GET SCHEMA STRING. THEN KEEP LOOPING TO GET THE DATA STRINGS +"RTN","BMXADOF1",20,0) + .. D PREP(.OUT,SCHEMA,STG) ; PREP DATA STRING FOR FILING, AND THEN FILE THE DATA +"RTN","BMXADOF1",21,0) + .. Q +"RTN","BMXADOF1",22,0) + . Q +"RTN","BMXADOF1",23,0) + K @CREF ; CLEAN UP +"RTN","BMXADOF1",24,0) + I ECNT=0 S OUT(0)="OK" Q ; SUMMARY NODE OF THE OUTPUT ARRAY +"RTN","BMXADOF1",25,0) + S OUT(0)=ECNT_" error(s) detected in this transaction" +"RTN","BMXADOF1",26,0) + Q +"RTN","BMXADOF1",27,0) + ; +"RTN","BMXADOF1",28,0) +PREP(OUT,SCHEMA,DATA) ; PREPARE DATA FOR THE ADO FILER +"RTN","BMXADOF1",29,0) + N TOP,LEV,C,B,%,DA,DAS,PCE,MAX,S,D,FILE,DSTG,MAND,FLD,VAL,MSG +"RTN","BMXADOF1",30,0) + S C=",",B="|",DAS="" +"RTN","BMXADOF1",31,0) + S %=$P(SCHEMA,U,2) S TOP=$P(%,B,2) +"RTN","BMXADOF1",32,0) + S LEV=$L(TOP)-3 I LEV=2 S DAS=+DATA_C +"RTN","BMXADOF1",33,0) + S SCHEMA=$P(SCHEMA,U,2,999) +"RTN","BMXADOF1",34,0) + S MAX=$L(SCHEMA,U) +"RTN","BMXADOF1",35,0) + S FILE=+SCHEMA I '$D(^DD(FILE,0)) S ERR="Update failed. Missing/invalid file number" D ERR(ERR) Q +"RTN","BMXADOF1",36,0) +SPEC ; CHECK FOR SPECIAL CASES +"RTN","BMXADOF1",37,0) + I FILE=9000011,SCHEMA'["|.05|" G DSTG +"RTN","BMXADOF1",38,0) + I FILE=9000010.07,SCHEMA'["|.04|" G DSTG +"RTN","BMXADOF1",39,0) + I FILE=9000010.18,SCHEMA'["|.04|" G DSTG +"RTN","BMXADOF1",40,0) + I FILE=9000013,SCHEMA'["|.04|" G DSTG +"RTN","BMXADOF1",41,0) + I FILE=9000014,SCHEMA'["|.04|" G DSTG +"RTN","BMXADOF1",42,0) + I FILE'=9000010.07,FILE'=9000011,FILE'=9000013,FILE'=9000014,FILE'=9000010.18 +"RTN","BMXADOF1",43,0) + E I '$$NARR^BMXADOF2 Q ; GET IEN OF PROVIDER NARRATIVE AND SUBSTITUE THIS VALUE IN THE DATA STG +"RTN","BMXADOF1",44,0) +DSTG ; BUILD THE ADD/UPDATE STRING FOR THE EBCU FILER +"RTN","BMXADOF1",45,0) + S DA=+DATA,DAS=DAS_DA,DSTG="" +"RTN","BMXADOF1",46,0) + F PCE=2:1:MAX D +"RTN","BMXADOF1",47,0) + . S S=$P(SCHEMA,U,PCE),VAL=$P(DATA,U,PCE) +"RTN","BMXADOF1",48,0) + . I $P(S,B,6)="TRUE" Q ; READ ONLY +"RTN","BMXADOF1",49,0) + . S FLD=$P(S,B,2) I 'FLD Q ; INVALID SCHEMA PIECE +"RTN","BMXADOF1",50,0) + . I $E(FLD,1,3)=".00" Q ; IEN NOT DATA +"RTN","BMXADOF1",51,0) + . I FLD["ID" Q ; DON'T FILE THE IDENTIFIERS +"RTN","BMXADOF1",52,0) + . I SCHEMA[(B_FLD_"IEN"),FLD'["IEN",$L(VAL) Q ; WAIT FOR THE LOOKUP VALUE, BYPASS CURRENT FIELD +"RTN","BMXADOF1",53,0) + . S FLD=+FLD +"RTN","BMXADOF1",54,0) + . I $P(S,B,8)'="TRUE" S FLD="+"_FLD ; MANDATORY FIELD +"RTN","BMXADOF1",55,0) + . E I VAL="" S FLD="-"_FLD ; DELETE THE VALUE +"RTN","BMXADOF1",56,0) + . I FLD?.1E1".01" D Q ; MAKE SURE THAT THE .01 FIELD IS FIRST! +"RTN","BMXADOF1",57,0) + .. I $L(DSTG) S DSTG=FLD_B_VAL_$C(30)_DSTG Q ; APPEND .01 FIELD TO THE FRONT OF AN EXISTING UPDATE STRING +"RTN","BMXADOF1",58,0) + .. S DSTG=FLD_B_VAL ; START A NEW UPDATE STRING WITH THE .01 FIELD +"RTN","BMXADOF1",59,0) + .. Q +"RTN","BMXADOF1",60,0) + . I $L(DSTG) S DSTG=DSTG_$C(30) ; $C(30) IS THE "COLUMN" DELIMITER FOR DATA TO BE ENETERED IN THE TABLE +"RTN","BMXADOF1",61,0) + . S DSTG=DSTG_FLD_B_VAL ; "|" IS THE DATA ELEMENT DELIMITER, SEPARATING FIELD NAME AND FIELD VALUE +"RTN","BMXADOF1",62,0) + . Q +"RTN","BMXADOF1",63,0) +FILE D FILE^BMXADOF(.MSG,FILE,DAS,DSTG) ; THE DATA STRING IS PREPARED. NOW SEND IT TO THE EBCU FILER. +"RTN","BMXADOF1",64,0) + I $E(MSG,1,2)'="OK" S ECNT=ECNT+1 +"RTN","BMXADOF1",65,0) + S CNT=CNT+1 S OUT(CNT)=MSG +"RTN","BMXADOF1",66,0) + ; S DSTG=$TR(DSTG,$C(30),"}") W !,DSTG ; TEMP OUTPUT - REMOVE THIS LINE AFTER TESTING COMPLETED! +"RTN","BMXADOF1",67,0) + Q +"RTN","BMXADOF1",68,0) + ; +"RTN","BMXADOF1",69,0) +ERR(ERR) ; +"RTN","BMXADOF1",70,0) + I '$L($G(ERR)) Q +"RTN","BMXADOF1",71,0) + S ECNT=$G(ECNT)+1 +"RTN","BMXADOF1",72,0) + S CNT=CNT+1 +"RTN","BMXADOF1",73,0) + S OUT(CNT)=ERR +"RTN","BMXADOF1",74,0) + Q +"RTN","BMXADOF1",75,0) + ; +"RTN","BMXADOF2") +0^65^B7123769 +"RTN","BMXADOF2",1,0) +BMXADOF2 ; IHS/CIHA/GIS - RPC CALL FOR EXTENDED FUNCTIONALITY OF BMXNet UTILITIES ; +"RTN","BMXADOF2",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXADOF2",3,0) + ; THIS ROUTINE CONTAINS SPECIAL ENTRY POINTS FOR UPDATING RPMS +"RTN","BMXADOF2",4,0) + ; +"RTN","BMXADOF2",5,0) + ; +"RTN","BMXADOF2",6,0) + ; +"RTN","BMXADOF2",7,0) +VVAR(DATA) ; EP-CHECK SPECIAL VARIABLES REQUIRED FOR UPDATING THE VISIT FILE +"RTN","BMXADOF2",8,0) + I '$L(DATA) S OUT="Update cancelled. Missing data string" Q 0 +"RTN","BMXADOF2",9,0) + N X,I,Y,VDATE,%DT +"RTN","BMXADOF2",10,0) + K AUPNPAT,AUPNDOB,AUPNDOD,AUPNVSIT ; THE VARS ARE NOT NEW'D SINCE THEY WILL BE USED BY THE CALLING ROUTINE +"RTN","BMXADOF2",11,0) + S AUPNTALK=1,AUPNOVRR=1 +"RTN","BMXADOF2",12,0) + S X=DATA S X=$TR(X,($C(30)_"+"),$C(30)) S X=$TR(X,($C(30)_"-"),$C(30)) S X=$TR(X,($C(30)_"`"),$C(30)) S DATA=X ; STRIP OFF TRANSACTION FLAGS FROM FIELD NUMBERS +"RTN","BMXADOF2",13,0) + S X=$P(DATA,"|",2),X=$P(X,$C(30)),VDATE=-1 +"RTN","BMXADOF2",14,0) + I $E(X,1,7)?7N S VDATE=X +"RTN","BMXADOF2",15,0) + E S %DT="T" D ^%DT S VDATE=Y +"RTN","BMXADOF2",16,0) + I VDATE=-1 S OUT="Update cancelled. Visit timestamp misssing/invalid" Q 0 +"RTN","BMXADOF2",17,0) + S Y=+$P(DATA,($C(30)_".05|"),2) I 'Y S OUT="Update cancelled. Patient data missing" Q 0 ; FAILED TO FIND THE PATIENT IEN +"RTN","BMXADOF2",18,0) + S AUPNPAT=Y +"RTN","BMXADOF2",19,0) + S AUPNDOB=$P($G(^DPT(AUPNPAT,0)),U,3) I 'AUPNDOB S OUT="Update cancelled. Missing DOB" Q 0 +"RTN","BMXADOF2",20,0) + I AUPNDOB>VDATE S OUT="Update cancelled. Patient born afer visit date???" Q 0 +"RTN","BMXADOF2",21,0) + S AUPNDOD=$P($G(^DPT(AUPNPAT,.35)),U) +"RTN","BMXADOF2",22,0) + I AUPNDOD,AUPNDOD FILEMAN +"RTN","BMXADOFD",4,0) + ; CONTAINS SPECIAL ENTRY POINT FOR RPMS DATA ENTRY +"RTN","BMXADOFD",5,0) + ; +"RTN","BMXADOFD",6,0) + ; +"RTN","BMXADOFD",7,0) + ; +"RTN","BMXADOFD",8,0) + ; D SS^BMXADO(.XXX,53,"","~~~~~VMEAS~BMXADOFD~1.244A||PU\60|WT\175|HT\70") Q +"RTN","BMXADOFD",9,0) + ; D SS^BMXADO(.XXX,58,"X","AC~53~53~~~NOTES~BMXADOFD~53") Q +"RTN","BMXADOFD",10,0) + N FILE,DAS,DATA S FILE=9000010.07,DAS="+" +"RTN","BMXADOFD",11,0) + S DATA=".01|`8718"_$C(30)_".02|`1"_$C(30)_".03|`71168"_$C(30)_".04|DM--2"_$C(30,31) +"RTN","BMXADOFD",12,0) + D FILE^BMXADOF(.XXX,FILE,DAS,DATA) Q +"RTN","BMXADOFD",13,0) + ; +"RTN","BMXADOFD",14,0) +VMEAS(DATA,IENS,MAX,OUT,TOT) ; VIEW MEASUREMENTS: CUSTOM ITERATOR +"RTN","BMXADOFD",15,0) + ; DATA=VCN|ALL|MTYPE1\VAL1|MTYPE2\VAL2|...|MTYPEn\VALn +"RTN","BMXADOFD",16,0) + N VAL,CNT,P,S,PTIEN,VIEN,%,X,Y,TYPE,N,ALL,STG,MEAS,MIEN,IX +"RTN","BMXADOFD",17,0) + S P="|",S="\",N=0 +"RTN","BMXADOFD",18,0) + I '$G(TOT) Q "" +"RTN","BMXADOFD",19,0) + I '$L(OUT) Q "" +"RTN","BMXADOFD",20,0) + S VIEN=$P(DATA,P) I '$L(VCN) Q "" +"RTN","BMXADOFD",21,0) + S PTIEN=$P($G(^AUPNVSIT(VIEN,0)),U,5) I 'PTIEN Q "" +"RTN","BMXADOFD",22,0) + F CNT=2:1 S X=$P(DATA,P,CNT) Q:'$L(X) D ; CREATE PRELIMINARY DATA ARRAYS +"RTN","BMXADOFD",23,0) + . S VAL=$P(X,S,2) ; VALUE MUST EXIST +"RTN","BMXADOFD",24,0) + . I '$L(VAL) Q +"RTN","BMXADOFD",25,0) + . S TYPE=$P(X,S) ; TYPE MUST EXIST +"RTN","BMXADOFD",26,0) + . I '$L(TYPE) Q +"RTN","BMXADOFD",27,0) + . S MIEN=$O(^AUTTMSR("B",TYPE,0)) I 'MIEN Q +"RTN","BMXADOFD",28,0) + . S MEAS=$P($G(^AUTTMSR(MIEN,0)),U,2) I '$L(MEAS) Q +"RTN","BMXADOFD",29,0) + . S N=N+1 +"RTN","BMXADOFD",30,0) + . S VAL(N)=VAL +"RTN","BMXADOFD",31,0) + . S TYPE(N)=MIEN_U_TYPE_U_MEAS +"RTN","BMXADOFD",32,0) + . S IX(MIEN)=N +"RTN","BMXADOFD",33,0) + . Q +"RTN","BMXADOFD",34,0) +MG S N=0 F S N=$O(VAL(N)) Q:'N D +"RTN","BMXADOFD",35,0) + . S TOT=TOT+1 +"RTN","BMXADOFD",36,0) + . S @OUT@(TOT)=+TYPE(N)_U_$P(TYPE(N),U,2)_U_"`"_PTIEN_U_"`"_VIEN_U_VAL(N)_U_$P(TYPE(N),U,3)_$C(30) +"RTN","BMXADOFD",37,0) + . Q +"RTN","BMXADOFD",38,0) + Q "" +"RTN","BMXADOFD",39,0) + ; +"RTN","BMXADOFD",40,0) +ICDVAL(CODE) ; EP-RPC-VERIFY ICD CODE BY RETURNING ITS IEN +"RTN","BMXADOFD",41,0) + I '$L($G(CODE)) Q "" +"RTN","BMXADOFD",42,0) + N IEN +"RTN","BMXADOFD",43,0) + S IEN=$O(^ICD9("BA",CODE_" ",0)) +"RTN","BMXADOFD",44,0) + I 'IEN Q "" +"RTN","BMXADOFD",45,0) + Q IEN +"RTN","BMXADOFD",46,0) + ; +"RTN","BMXADOFD",47,0) +FACNIEN(PIEN,FIEN) ;EP - GIVEN A PROBLEM IEN AND FACILITY IEN, RETURN THE FACILITY-NOTE IEN +"RTN","BMXADOFD",48,0) + I '$D(^AUPNPROB(+$G(PIEN),0)) Q "" +"RTN","BMXADOFD",49,0) + I '$D(^DIC(4,+$G(FIEN),0)) Q "" +"RTN","BMXADOFD",50,0) + N NFIEN +"RTN","BMXADOFD",51,0) + S FNIEN=$O(^AUPNPROB(PIEN,11,"B",FIEN,0)) I FNIEN Q FNIEN ; IF AN FNIEN EXISTS RETURN IT +"RTN","BMXADOFD",52,0) + ; OTHERWISE-CREATE THE FM STUB NODES FOR THE FACILITY SUBFILE +"RTN","BMXADOFD",53,0) + S FNIEN=$O(^AUPNPROB(PIEN,11,999999),-1)+1 +"RTN","BMXADOFD",54,0) + S ^AUPNPROB(PIEN,11,FNIEN,0)=FIEN +"RTN","BMXADOFD",55,0) + S ^AUPNPROB(PIEN,11,FNIEN,11,0)="^9000011.1111IA^^" +"RTN","BMXADOFD",56,0) + S ^AUPNPROB(PIEN,11,"B",FIEN,FNIEN)="" +"RTN","BMXADOFD",57,0) + Q FNIEN +"RTN","BMXADOFD",58,0) + ; +"RTN","BMXADOFD",59,0) +NEXTPBN(DFN,FIEN) ; RETURN THE NEXT AVAILABLE PROBLEM NUMBER FOR A PATIENT AT THE FACILITY +"RTN","BMXADOFD",60,0) + N MAX,PIEN,X,Y +"RTN","BMXADOFD",61,0) + S MAX=0,PIEN=0 +"RTN","BMXADOFD",62,0) + F S PIEN=$O(^AUPNPROB("AC",DFN,PIEN)) Q:'PIEN D ; FIND ALL PROBLEMS FOR THIS PATIENT +"RTN","BMXADOFD",63,0) + . S X=$G(^AUPNPROB(PIEN,0)) I '$L(X) Q "" +"RTN","BMXADOFD",64,0) + . I $P(X,U,6)'=FIEN Q ; ONLY CHECK NUMBERS AT THIS FACILITY +"RTN","BMXADOFD",65,0) + . S Y=$P(X,U,7) +"RTN","BMXADOFD",66,0) + . I Y>MAX S MAX=Y ; GET THE HIGHEST NUMBER THUS FAR +"RTN","BMXADOFD",67,0) + . Q +"RTN","BMXADOFD",68,0) + S MAX=(MAX\1)+1 ; GET NEXT AVAILABLE INTEGER +"RTN","BMXADOFD",69,0) + Q MAX +"RTN","BMXADOFD",70,0) + ; +"RTN","BMXADOFD",71,0) +NN W $$NEXTNOTE(221,4585) Q +"RTN","BMXADOFD",72,0) +NEXTNOTE(PIEN,FIEN) ; RETRUN THE NEXT NOTE NUMBER FOR A PROBLEM AND FACILITY +"RTN","BMXADOFD",73,0) + I '$D(^AUPNPROB(+$G(PIEN),0)) Q "" +"RTN","BMXADOFD",74,0) + I '$D(^DIC(4,+$G(FIEN),0)) Q "" +"RTN","BMXADOFD",75,0) + N MAX,NIEN,FNIEN,X,Y +"RTN","BMXADOFD",76,0) + S MAX=0,NIEN=0 +"RTN","BMXADOFD",77,0) + S FNIEN=$$FACNIEN^BMXADOFD(PIEN,FIEN) I 'FNIEN Q "" +"RTN","BMXADOFD",78,0) + F S NIEN=$O(^AUPNPROB(PIEN,11,FNIEN,11,NIEN)) Q:'NIEN D +"RTN","BMXADOFD",79,0) + . S X=$G(^AUPNPROB(PIEN,11,FNIEN,11,NIEN,0)) I '$L(X) Q +"RTN","BMXADOFD",80,0) + . S Y=+X +"RTN","BMXADOFD",81,0) + . I Y>MAX S MAX=Y +"RTN","BMXADOFD",82,0) + . Q +"RTN","BMXADOFD",83,0) + S MAX=MAX+1 +"RTN","BMXADOFD",84,0) + Q MAX +"RTN","BMXADOFS") +0^67^B38538227 +"RTN","BMXADOFS",1,0) +BMXADOFS ; IHS/CIHA/GIS - RPC CALL FOR EXTENDED FUNCTIONALITY OF BMXNet UTILITIES ; +"RTN","BMXADOFS",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXADOFS",3,0) + ; THIS IS THE ADO RECORDSET FILER: ADO -> FILEMAN +"RTN","BMXADOFS",4,0) + ; CONTAINS SPECIAL CODE RELATED TO FILING PROPLEMS, POVS, FAMILY HX, PERSONAL HX AND NOTES. +"RTN","BMXADOFS",5,0) + ; +"RTN","BMXADOFS",6,0) + ; +"RTN","BMXADOFS",7,0) + ; +"RTN","BMXADOFS",8,0) +PAT ; TEST PROBLEM ADD +"RTN","BMXADOFS",9,0) + S DATA=".01|`8257"_$C(30)_".02|`53"_$C(30)_".03|"_DT_$C(30)_".05|C-POX"_$C(30)_".06|`4585"_$C(30)_".12|I"_$C(30,31) +"RTN","BMXADOFS",10,0) + D FILE^BMXADOF(.XXX,9000011,"",DATA) W !,XXX K XXX,DATA Q +"RTN","BMXADOFS",11,0) + ; +"RTN","BMXADOFS",12,0) +PET ; TEST PROB EDIT +"RTN","BMXADOFS",13,0) + S DATA=".01|250.00"_$C(30)_".03|"_DT_$C(30)_".05|HI MOM"_$C(30)_".12|I"_$C(30,31) +"RTN","BMXADOFS",14,0) + D FILE^BMXADOF(.XXX,9000011,"1757",DATA) W !,XXX K XXX,DATA Q +"RTN","BMXADOFS",15,0) + ; +"RTN","BMXADOFS",16,0) +TDP ; TEST PROBLEM DELETE +"RTN","BMXADOFS",17,0) + S DATA=$C(31) +"RTN","BMXADOFS",18,0) + D FILE^BMXADOF(.XXX,9000011,"-1757",DATA) W !,XXX K XXX,DATA Q +"RTN","BMXADOFS",19,0) + ; +"RTN","BMXADOFS",20,0) +TPOV ; ADD POV TEST +"RTN","BMXADOFS",21,0) + S DATA=".01|`8718"_$C(30)_".02|`53"_$C(30)_".03|`3909"_$C(30)_".04|DM---I"_$C(30)_".12|P"_$C(30,31) +"RTN","BMXADOFS",22,0) + D FILE^BMXADOF(.XXX,9000010.07,"",DATA) W !,XXX K XXX,DATA Q +"RTN","BMXADOFS",23,0) + ; +"RTN","BMXADOFS",24,0) +TH ; HX TEST +"RTN","BMXADOFS",25,0) + S DATA=".01|250.00"_$C(30)_".02|`53"_$C(30)_".03|JUL 15,2004"_$C(30)_".04|FAMILY HX OF LUNG CA"_$C(30,31) +"RTN","BMXADOFS",26,0) + D FILE^BMXADOF(.XXX,9000014,"",DATA) W !,XXX K XXX,DATA Q +"RTN","BMXADOFS",27,0) + ; +"RTN","BMXADOFS",28,0) +TNOTE ; TEST ADDING A NOTE TO A PROBLEM +"RTN","BMXADOFS",29,0) + N DATA,XXX,PROBIEN,FACNIEN,FACIEN,DAS +"RTN","BMXADOFS",30,0) + S PROBIEN=3,FACIEN=4587 +"RTN","BMXADOFS",31,0) + S FACNIEN=$$FACNIEN(PROBIEN,FACIEN) ; YOU MUST SPECIFY THE PROBLEM IEN AND THE FACILITY IEN +"RTN","BMXADOFS",32,0) + S DAS=PROBIEN_","_FACNIEN_"," +"RTN","BMXADOFS",33,0) + S DATA=".03|NEW NOTE #2"_$C(30,31) ; THE DATA STRING JUST CONTAINS THE NOTE FIELD. +"RTN","BMXADOFS",34,0) + ; THE OTHER FIELDS (INCLUDING .01) ARE ADDED BY BMXADOF +"RTN","BMXADOFS",35,0) + D FILE^BMXADOF(.XXX,9000011.1111,DAS,DATA) W !,XXX +"RTN","BMXADOFS",36,0) + Q +"RTN","BMXADOFS",37,0) + ; +"RTN","BMXADOFS",38,0) + ; ----------------------------------------------------------------------------------------------------- +"RTN","BMXADOFS",39,0) + ; +"RTN","BMXADOFS",40,0) +SPEC(FILE,DATA,UFLG) ;EP - SPECIAL DATA MODS FOR SPECIFIC FILES +"RTN","BMXADOFS",41,0) + I FILE=9000010.07 S DATA=$$POV(DATA) Q DATA +"RTN","BMXADOFS",42,0) + I FILE=9000011 S DATA=$$PROB(DATA,$G(UFLG)) Q DATA +"RTN","BMXADOFS",43,0) + I FILE=9000013!(FILE=9000014) S DATA=$$HX(DATA) Q DATA +"RTN","BMXADOFS",44,0) + I FILE=9000011.1111 S DATA=$$NOTE(DATA,$G(DAS(2)),$G(DAS(1))) Q DATA +"RTN","BMXADOFS",45,0) + ; I FILE=9000010.18,DATA'["|.04|" G DSTG +"RTN","BMXADOFS",46,0) + Q DATA +"RTN","BMXADOFS",47,0) + ; +"RTN","BMXADOFS",48,0) +HX(DATA) ; INPUT STRING TRANSFORM FOR PHX AND FHX +"RTN","BMXADOFS",49,0) + N NARR,NIEN,%,A,B,X,Y,%DT +"RTN","BMXADOFS",50,0) + I DATA[".01|`" G HNARR +"RTN","BMXADOFS",51,0) + S DATA=$$ICD(DATA,.01) I DATA="" Q "" +"RTN","BMXADOFS",52,0) +HNARR I DATA'[".04|'" G HDT +"RTN","BMXADOFS",53,0) + S DATA=$$NARR(DATA,.04) +"RTN","BMXADOFS",54,0) +HDT I DATA'[".03|" Q DATA +"RTN","BMXADOFS",55,0) + S X=+$P(DATA,".03|",2) I X?7N Q DATA +"RTN","BMXADOFS",56,0) + S %DT="" D ^%DT +"RTN","BMXADOFS",57,0) + I Y'?7N Q DATA +"RTN","BMXADOFS",58,0) + S A=$P(DATA,".03|") +"RTN","BMXADOFS",59,0) + S B=$P(DATA,".03|",2) S B=$P(B,$C(30),2) +"RTN","BMXADOFS",60,0) + S DATA=A_".03|"_Y +"RTN","BMXADOFS",61,0) + I $L(B) S DATA=DATA_$C(30)_B +"RTN","BMXADOFS",62,0) + Q DATA +"RTN","BMXADOFS",63,0) + ; +"RTN","BMXADOFS",64,0) +POV(DATA) ; POV INPUT STRING TRANSFORM +"RTN","BMXADOFS",65,0) + N NARR,NIEN,% +"RTN","BMXADOFS",66,0) + I DATA[".01|`" G PVNARR +"RTN","BMXADOFS",67,0) + S DATA=$$ICD(DATA,.01) I DATA="" Q "" +"RTN","BMXADOFS",68,0) +PVNARR I DATA'[".04|'" Q DATA +"RTN","BMXADOFS",69,0) + S DATA=$$NARR(DATA,.04) +"RTN","BMXADOFS",70,0) + Q DATA +"RTN","BMXADOFS",71,0) + ; +"RTN","BMXADOFS",72,0) +PROB(DATA,UFLG) ; PROBLEM LIST INPUT STRING TRANSFORM +"RTN","BMXADOFS",73,0) + N NARR,NIEN,%,PNUM,FACIEN,DFN,X,A,B +"RTN","BMXADOFS",74,0) +PNARR I DATA'[".05|" G PICD +"RTN","BMXADOFS",75,0) + S %=$P(DATA,".05|",2) +"RTN","BMXADOFS",76,0) + S NARR=$P(%,$C(30)) +"RTN","BMXADOFS",77,0) + I NARR'?1"`"1.N S DATA=$$NARR(DATA,.05) ; STUFF THE NARR LOOKUP VALUE IN THE DATA STRING +"RTN","BMXADOFS",78,0) + I '$L(DATA) Q "" +"RTN","BMXADOFS",79,0) +PICD S %=$P(DATA,"|") I %'=.01,DATA'[($C(30)_".01|") G PNUM +"RTN","BMXADOFS",80,0) + S DATA=$$ICD(DATA,.01) I DATA="" Q "" +"RTN","BMXADOFS",81,0) +PNUM I $G(UFLG)="E" Q DATA ; STOP HERE IF IN EDIT MODE +"RTN","BMXADOFS",82,0) + I $P(DATA,($C(30)_".07|"),2) G TODAY ; GET NEXT PROB NUM +"RTN","BMXADOFS",83,0) + S DFN=+$P(DATA,".02|`",2) +"RTN","BMXADOFS",84,0) + I 'DFN S DATA="" Q "" +"RTN","BMXADOFS",85,0) + S FACIEN=+$P(DATA,".06|`",2) +"RTN","BMXADOFS",86,0) + I 'FACIEN Q "" +"RTN","BMXADOFS",87,0) + S PNUM=$$NEXTPBN(DFN,FACIEN) +"RTN","BMXADOFS",88,0) + I 'PNUM Q "" +"RTN","BMXADOFS",89,0) + S X=$L(DATA,$C(30)) +"RTN","BMXADOFS",90,0) + S A=$P(DATA,$C(30),1,X-1),B=$P(DATA,$C(30),X) +"RTN","BMXADOFS",91,0) + S DATA=A_$C(30)_".07|"_PNUM_$C(30)_B +"RTN","BMXADOFS",92,0) +TODAY I $P(DATA,($C(30)_".08|"),2) Q DATA ; GET TODAY'S DATE +"RTN","BMXADOFS",93,0) + S X=$L(DATA,$C(30)) +"RTN","BMXADOFS",94,0) + S A=$P(DATA,$C(30),1,X-1),B=$P(DATA,$C(30),X) +"RTN","BMXADOFS",95,0) + S DATA=A_$C(30)_".08|"_$G(DT)_$C(30)_B +"RTN","BMXADOFS",96,0) + Q DATA +"RTN","BMXADOFS",97,0) + ; +"RTN","BMXADOFS",98,0) +NOTE(DATA,PIEN,FNIEN) ; GIVEN A DATA STRING CONTAINING THE NOTE, THE PROBLEM IEN, AND THE FAC-NOTE IEN: +"RTN","BMXADOFS",99,0) + ; ADD NOTE # AND STATUS TO THE DATA STRING +"RTN","BMXADOFS",100,0) + I $G(DATA)'[".03|" Q "" +"RTN","BMXADOFS",101,0) + I '$D(^AUPNPROB(+$G(PIEN),11,+$G(FNIEN),0)) Q "" +"RTN","BMXADOFS",102,0) + N NUM +"RTN","BMXADOFS",103,0) + I DATA'[".04|" S DATA=".04|A"_$C(30)_DATA +"RTN","BMXADOFS",104,0) + I DATA'[".01|" D +"RTN","BMXADOFS",105,0) + . S NUM=$$NEXTNOTE(PIEN,FNIEN) +"RTN","BMXADOFS",106,0) + . I 'NUM Q +"RTN","BMXADOFS",107,0) + . S DATA=".01|"_NUM_$C(30)_DATA +"RTN","BMXADOFS",108,0) + Q DATA +"RTN","BMXADOFS",109,0) + ; +"RTN","BMXADOFS",110,0) +TI N XXX S XXX=$$ICD(".01|250.00"_$C(30)_".02|123"_$C(30)_".03|ABC",.01) W !,$TR(XXX,$C(30),"{") Q +"RTN","BMXADOFS",111,0) +ICD(DATA,FLD) ; VERIFY ICD CODE AND GET LOOKUP VALUE +"RTN","BMXADOFS",112,0) + I '$G(FLD) Q "" +"RTN","BMXADOFS",113,0) + I '$L($G(DATA)) Q "" +"RTN","BMXADOFS",114,0) + N %,A,B +"RTN","BMXADOFS",115,0) + S %=$P(DATA,"|") +"RTN","BMXADOFS",116,0) + I %=FLD D Q DATA +"RTN","BMXADOFS",117,0) + . S %=$P(DATA,"|",2) +"RTN","BMXADOFS",118,0) + . S %=$P(%,$C(30)) +"RTN","BMXADOFS",119,0) + . I %?1"`"1.N Q +"RTN","BMXADOFS",120,0) + . S %=$O(^ICD9("BA",%_" ",0)) +"RTN","BMXADOFS",121,0) + . I '% S DATA="" Q +"RTN","BMXADOFS",122,0) + . S A=$P(DATA,"|") +"RTN","BMXADOFS",123,0) + . S B=$P(DATA,"|",2,999) +"RTN","BMXADOFS",124,0) + . S B=$P(B,$C(30),2,999) +"RTN","BMXADOFS",125,0) + . S DATA=A_"|`"_% +"RTN","BMXADOFS",126,0) + . I $L(B) S DATA=DATA_$C(30)_B +"RTN","BMXADOFS",127,0) + . Q +"RTN","BMXADOFS",128,0) + S %=$P(DATA,($C(30)_FLD_"|"),2) D +"RTN","BMXADOFS",129,0) + . S %=$P(%,$C(30)) +"RTN","BMXADOFS",130,0) + . I %?1"`"1.N Q DATA +"RTN","BMXADOFS",131,0) + . S %=$O(^ICD9("BA",%_" ",0)) +"RTN","BMXADOFS",132,0) + . I '% S DATA="" Q +"RTN","BMXADOFS",133,0) + . S A=$P(DATA,($C(30)_FLD_"|")) +"RTN","BMXADOFS",134,0) + . S B=$P(DATA,($C(30)_FLD_"|"),2,999) +"RTN","BMXADOFS",135,0) + . S B=$P(B,$C(30),2,999) +"RTN","BMXADOFS",136,0) + . S DATA=A_$C(30)_FLD_"|`"_% +"RTN","BMXADOFS",137,0) + . I $L(B) S DATA=DATA_$C(30)_B +"RTN","BMXADOFS",138,0) + . Q +"RTN","BMXADOFS",139,0) + Q DATA +"RTN","BMXADOFS",140,0) + ; +"RTN","BMXADOFS",141,0) +NARR(DATA,FLD) ; SUBSTITUTE A LOOKUP VALUE FOR NARRATIVE DATA IN THE DATA STRING +"RTN","BMXADOFS",142,0) + N A,B,C,X,Y,DIC,Z +"RTN","BMXADOFS",143,0) + I '$G(FLD) Q "" +"RTN","BMXADOFS",144,0) + I '$L($G(DATA)) Q "" +"RTN","BMXADOFS",145,0) + S Z=FLD_"|" +"RTN","BMXADOFS",146,0) + S A=$P(DATA,Z) +"RTN","BMXADOFS",147,0) + S B=$P(DATA,Z,2) +"RTN","BMXADOFS",148,0) + S NARR=$P(B,$C(30)) +"RTN","BMXADOFS",149,0) + S NARR=$$UP^XLFSTR(NARR) ; CONVERT ALL NARRATIVE TO UPPERCASE +"RTN","BMXADOFS",150,0) + S C=$P(B,$C(30),2,999) +"RTN","BMXADOFS",151,0) + S DIC="^AUTNPOV(",DIC(0)="L",X=NARR +"RTN","BMXADOFS",152,0) + D ^DIC I Y=-1 Q "" +"RTN","BMXADOFS",153,0) + S DATA=A_FLD_"|`"_+Y +"RTN","BMXADOFS",154,0) + I $L(C) S DATA=DATA_$C(30)_C +"RTN","BMXADOFS",155,0) + D ^XBFMK +"RTN","BMXADOFS",156,0) + Q DATA +"RTN","BMXADOFS",157,0) + ; +"RTN","BMXADOFS",158,0) +FACNIEN(PIEN,FIEN) ; GIVEN A PROBLEM IEN AND FACILITY IEN, RETURN THE FACILITY-NOTE IEN +"RTN","BMXADOFS",159,0) + I '$D(^AUPNPROB(+$G(PIEN),0)) Q "" +"RTN","BMXADOFS",160,0) + I '$D(^DIC(4,+$G(FIEN),0)) Q "" +"RTN","BMXADOFS",161,0) + N FNIEN +"RTN","BMXADOFS",162,0) + S FNIEN=$O(^AUPNPROB(PIEN,11,"B",FIEN,0)) I FNIEN Q FNIEN ; IF AN FNIEN EXISTS RETURN IT +"RTN","BMXADOFS",163,0) + ; OTHERWISE-CREATE THE FM STUB NODES FOR THE FACILITY SUBFILE +"RTN","BMXADOFS",164,0) + S FNIEN=$O(^AUPNPROB(PIEN,11,999999),-1)+1 +"RTN","BMXADOFS",165,0) + S ^AUPNPROB(PIEN,11,FNIEN,0)=FIEN +"RTN","BMXADOFS",166,0) + S ^AUPNPROB(PIEN,11,FNIEN,11,0)="^9000011.1111IA^^" +"RTN","BMXADOFS",167,0) + S ^AUPNPROB(PIEN,11,"B",FIEN,FNIEN)="" +"RTN","BMXADOFS",168,0) + Q FNIEN +"RTN","BMXADOFS",169,0) + ; +"RTN","BMXADOFS",170,0) +NEXTPBN(DFN,FIEN) ; RETURN THE NEXT AVAILABLE PROBLEM NUMBER FOR A PATIENT AT THE FACILITY +"RTN","BMXADOFS",171,0) + N MAX,PIEN,X,Y +"RTN","BMXADOFS",172,0) + S MAX=0,PIEN=0 +"RTN","BMXADOFS",173,0) + F S PIEN=$O(^AUPNPROB("AC",DFN,PIEN)) Q:'PIEN D ; FIND ALL PROBLEMS FOR THIS PATIENT +"RTN","BMXADOFS",174,0) + . S X=$G(^AUPNPROB(PIEN,0)) I '$L(X) Q "" +"RTN","BMXADOFS",175,0) + . I $P(X,U,6)'=FIEN Q ; ONLY CHECK NUMBERS AT THIS FACILITY +"RTN","BMXADOFS",176,0) + . S Y=$P(X,U,7) +"RTN","BMXADOFS",177,0) + . I Y>MAX S MAX=Y ; GET THE HIGHEST NUMBER THUS FAR +"RTN","BMXADOFS",178,0) + . Q +"RTN","BMXADOFS",179,0) + S MAX=(MAX\1)+1 ; GET NEXT AVAILABLE INTEGER +"RTN","BMXADOFS",180,0) + Q MAX +"RTN","BMXADOFS",181,0) + ; +"RTN","BMXADOFS",182,0) +NN W $$NEXTNOTE(3,1) Q +"RTN","BMXADOFS",183,0) +NEXTNOTE(PIEN,FNIEN) ; RETRUN THE NEXT NOTE NUMBER FOR A PROBLEM AND FACILITY-NOTE IEN +"RTN","BMXADOFS",184,0) + I '$D(^AUPNPROB(+$G(PIEN),11,+$G(FNIEN),0)) Q "" +"RTN","BMXADOFS",185,0) + N MAX,NIEN,X,Y +"RTN","BMXADOFS",186,0) + S MAX=0,NIEN=0 +"RTN","BMXADOFS",187,0) + F S NIEN=$O(^AUPNPROB(PIEN,11,FNIEN,11,NIEN)) Q:'NIEN D +"RTN","BMXADOFS",188,0) + . S X=$G(^AUPNPROB(PIEN,11,FNIEN,11,NIEN,0)) I '$L(X) Q +"RTN","BMXADOFS",189,0) + . S Y=+X +"RTN","BMXADOFS",190,0) + . I Y>MAX S MAX=Y +"RTN","BMXADOFS",191,0) + . Q +"RTN","BMXADOFS",192,0) + S MAX=MAX+1 +"RTN","BMXADOFS",193,0) + Q MAX +"RTN","BMXADOFS",194,0) + ; +"RTN","BMXADOFS",195,0) +PIENN(PIEN) ; GIVEN A PROBLEM IEN, RETURN PROBLEM NARRATIVE (ICD) +"RTN","BMXADOFS",196,0) + N X,IIEN,NIEN,NARR,ICD +"RTN","BMXADOFS",197,0) + S X=$G(^AUPNPROB(PIEN,0)) I '$L(X) Q "" +"RTN","BMXADOFS",198,0) + S IIEN=$P(X,U) I 'IIEN Q "" +"RTN","BMXADOFS",199,0) + S NIEN=$P(X,U,5) I 'NIEN Q "" +"RTN","BMXADOFS",200,0) + S ICD=$P($G(^ICD9(IIEN,0)),U) I '$L(ICD) Q "" +"RTN","BMXADOFS",201,0) + S NARR=$P($G(^AUTNPOV(NIEN,0)),U) I '$L(NARR) Q "" +"RTN","BMXADOFS",202,0) + S X=NARR_" ("_ICD_")" +"RTN","BMXADOFS",203,0) + Q X +"RTN","BMXADOFS",204,0) + ; +"RTN","BMXADOI") +0^68^B6267463 +"RTN","BMXADOI",1,0) +BMXADOI ; IHS/CIHA/GIS - RPC CALL: GENERATE DATA FOR AN ADO DATASET ; +"RTN","BMXADOI",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXADOI",3,0) + ; CUSTOM IDENTIFIERS +"RTN","BMXADOI",4,0) + ; +"RTN","BMXADOI",5,0) + ; +"RTN","BMXADOI",6,0) + ; +"RTN","BMXADOI",7,0) +DEMOID(DA) ; EP-RETURN RPMS DEMOGRAPHIC INFO FOR IDENTIFIER FIELD +"RTN","BMXADOI",8,0) + N SEX,DOB,CHART,AGE,TRIBE,CC,X,Y,%,STG,FMDOB,NAME,S,SSN,CSTG,LOC,ABB +"RTN","BMXADOI",9,0) + I '$D(^DPT(+$G(DA),0)) Q "" +"RTN","BMXADOI",10,0) + S S=" " +"RTN","BMXADOI",11,0) + S X=$G(^DPT(DA,0)),SEX=$P(X,U,2),Y=$P(X,U,3),NAME=$P(X,U),SSN=$P(X,U,9) +"RTN","BMXADOI",12,0) + I '$L(NAME) Q "" +"RTN","BMXADOI",13,0) + I Y,$G(DT) S AGE=(DT-Y)\10000 +"RTN","BMXADOI",14,0) + I Y X ^DD("DD") S DOB=Y +"RTN","BMXADOI",15,0) + S LOC=0,CSTG="" +"RTN","BMXADOI",16,0) + F S LOC=$O(^AUPNPAT(DA,41,"B",LOC)) Q:'LOC D ; GET ALL THE CHART NUMBERS +"RTN","BMXADOI",17,0) + . S CHART=$O(^AUPNPAT(DA,41,"B",LOC,0)) I '$L(CHART) Q +"RTN","BMXADOI",18,0) + . S ABB=$P($G(^AUTTLOC(LOC,0)),U,7) I '$L(ABB) Q +"RTN","BMXADOI",19,0) + . I $L(CSTG) S CSTG=CSTG_", " +"RTN","BMXADOI",20,0) + . S CSTG=CSTG_ABB_" #"_CHART +"RTN","BMXADOI",21,0) + . Q +"RTN","BMXADOI",22,0) + I $G(DUZ(2)) S CHART=$P($G(^AUPNPAT(DA,41,DUZ(2),0)),U,2) +"RTN","BMXADOI",23,0) + S %=$P($G(^AUPNPAT(DA,11)),U,8) I % S TRIBE=$P($G(^AUTTTRI(%,0)),U) +"RTN","BMXADOI",24,0) + S CC=$P($G(^AUPNPAT(DA,11)),U,18) +"RTN","BMXADOI",25,0) + S STG=NAME +"RTN","BMXADOI",26,0) + I $L(CSTG) S STG=STG_CSTG_" --" +"RTN","BMXADOI",27,0) + I $G(AGE),$L(SEX) S STG=STG_S_AGE_" y/o "_SEX +"RTN","BMXADOI",28,0) + I '$G(AGE),$L(SEX) S STG=STG_S_SEX +"RTN","BMXADOI",29,0) + I $L($G(DOB)) S STG=STG_S_DOB +"RTN","BMXADOI",30,0) + I $L($G(SSN)) S STG=STG_S_$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9) +"RTN","BMXADOI",31,0) + I $L($G(TRIBE)) S STG=STG_S_TRIBE +"RTN","BMXADOI",32,0) + I $L($G(CC)) S STG=STG_S_CC +"RTN","BMXADOI",33,0) + Q STG +"RTN","BMXADOI",34,0) + ; +"RTN","BMXADOI",35,0) +DATE(DATE) ; TEST TRIGGER +"RTN","BMXADOI",36,0) + Q DATE +"RTN","BMXADOI",37,0) + ; +"RTN","BMXADOI",38,0) +NAME(VIEN) ; RETURN THE PATIENT'S NAME +"RTN","BMXADOI",39,0) + I '$G(VIEN) Q "" +"RTN","BMXADOI",40,0) + N DFN +"RTN","BMXADOI",41,0) + S DFN=$P($G(^AUPNVSIT(VIEN,0)),U,5) I 'DFN Q "" +"RTN","BMXADOI",42,0) + Q $$GET1^DIQ(2,DFN_",",.01) +"RTN","BMXADOI",43,0) + ; +"RTN","BMXADOI",44,0) +SEX(VIEN) ; RETURN THE PATIENT'S SEX +"RTN","BMXADOI",45,0) + I '$G(VIEN) Q "" +"RTN","BMXADOI",46,0) + N DFN +"RTN","BMXADOI",47,0) + S DFN=$P($G(^AUPNVSIT(VIEN,0)),U,5) I 'DFN Q "" +"RTN","BMXADOI",48,0) + Q $$GET1^DIQ(2,DFN_",",.02) +"RTN","BMXADOI",49,0) + ; +"RTN","BMXADOI",50,0) +HRN(VIEN) ; RETURN THE CHART NUMBER FOR VISIT TRIGGER +"RTN","BMXADOI",51,0) + I '$G(VIEN) Q "" +"RTN","BMXADOI",52,0) + N DFN,LOC +"RTN","BMXADOI",53,0) + S DFN=$P($G(^AUPNVSIT(VIEN,0)),U,5) I 'DFN Q "" +"RTN","BMXADOI",54,0) + S LOC=$P($G(^AUPNVSIT(VIEN,0)),U,6) I 'LOC Q "" +"RTN","BMXADOI",55,0) + Q $$HRN^AUPNPAT(DFN,LOC,2) +"RTN","BMXADOI",56,0) + ; +"RTN","BMXADOI",57,0) +DOB(VIEN) ; RETURN THE PATIENT'S DOB +"RTN","BMXADOI",58,0) + I '$G(VIEN) Q "" +"RTN","BMXADOI",59,0) + N DFN,LOC +"RTN","BMXADOI",60,0) + S DFN=$P($G(^AUPNVSIT(VIEN,0)),U,5) I 'DFN Q "" +"RTN","BMXADOI",61,0) + Q $$DOB^AUPNPAT(DFN,"E") +"RTN","BMXADOI",62,0) + ; +"RTN","BMXADOI",63,0) +SSN(VIEN) ; RETURN THE PATIENTS DOB +"RTN","BMXADOI",64,0) + I '$G(VIEN) Q "" +"RTN","BMXADOI",65,0) + N DFN,LOC +"RTN","BMXADOI",66,0) + S DFN=$P($G(^AUPNVSIT(VIEN,0)),U,5) I 'DFN Q "" +"RTN","BMXADOI",67,0) + Q $$SSN^AUPNPAT(DFN) +"RTN","BMXADOI",68,0) + ; +"RTN","BMXADOI",69,0) +VISDATE(VIEN) ; RETURN THE DATE OF THE VISIT +"RTN","BMXADOI",70,0) + I '$G(VIEN) Q "" +"RTN","BMXADOI",71,0) + N FMDT +"RTN","BMXADOI",72,0) + S FMDT=+$G(^AUPNVSIT(VIEN,0))\1 I 'FMDT Q "" +"RTN","BMXADOI",73,0) + S %=$$FMTE^XLFDT(FMDT,1) +"RTN","BMXADOI",74,0) + G TD1 +"RTN","BMXADOI",75,0) + ; +"RTN","BMXADOI",76,0) +TODAY(VIEN) ; RETURN TODAY'S DATE +"RTN","BMXADOI",77,0) + I '$G(DT) Q "" +"RTN","BMXADOI",78,0) + S %=$$FMTE^XLFDT(DT,1) +"RTN","BMXADOI",79,0) +TD1 S %=$$UP^XLFSTR(%) +"RTN","BMXADOI",80,0) + S %=$P(%," ",1,2)_$P(%," ",3) +"RTN","BMXADOI",81,0) + Q % +"RTN","BMXADOI",82,0) + ; +"RTN","BMXADOS") +0^69^B78902997 +"RTN","BMXADOS",1,0) +BMXADOS ; IHS/CIHA/GIS - UPDATE THE BMX ADO SCHEMA FILE ; 12/7/10 4:07pm +"RTN","BMXADOS",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXADOS",3,0) + ; ENABLES NAVIGATION TO SUBFILES PRIOR TO UPDATING THE SCHEMA FILE ENTRY +"RTN","BMXADOS",4,0) + ; +"RTN","BMXADOS",5,0) + ; Change log: +"RTN","BMXADOS",6,0) + ; Sam Habiel - 3101212 v2.21 +"RTN","BMXADOS",7,0) + ; - Changed the quit from the line in ASTG b/c it couldn't compile in GT.M +"RTN","BMXADOS",8,0) + ; F PCE=1:1:LEV S FNO=+$P(STG,",",PCE) D I '$L(STG) Q "" **OLD** +"RTN","BMXADOS",9,0) + ; F PCE=1:1:LEV S FNO=+$P(STG,",",PCE) D Q:'$L(STG) ; v 2.21 SMH +"RTN","BMXADOS",10,0) + ; +"RTN","BMXADOS",11,0) + ; +"RTN","BMXADOS",12,0) + ; +"RTN","BMXADOS",13,0) +UPDATE ; UPDATE THE SCHEMA FILE +"RTN","BMXADOS",14,0) + N DIC,X,Y,%,STOP,FIEN,FNAME,SNAME,SIEN +"RTN","BMXADOS",15,0) +UDIC S DIC("A")="Enter schema name: " ; EP FROM VENPCCTU +"RTN","BMXADOS",16,0) + S DIC(0)="AEQLM",DIC="^BMXADO(" +"RTN","BMXADOS",17,0) + D ^DIC I Y=-1 G FIN +"RTN","BMXADOS",18,0) +SCHEMA S SNAME=$P(Y,U,2),SIEN=+Y +"RTN","BMXADOS",19,0) + S FIEN=$$FILE(SIEN) I 'FIEN G FIN +"RTN","BMXADOS",20,0) + I FIEN'=$P($G(^BMXADO(SIEN,0)),U,2) S DIE=DIC,DA=SIEN,DR=".02////^S X=FIEN" D ^DIE +"RTN","BMXADOS",21,0) + F D FLD(FIEN,SIEN) I $G(STOP) Q ; GET FIELD INFO +"RTN","BMXADOS",22,0) +FIN D ^XBFMK +"RTN","BMXADOS",23,0) + Q +"RTN","BMXADOS",24,0) + ; +"RTN","BMXADOS",25,0) +FLD(FIEN,SIEN) ; GET THE FIELD +"RTN","BMXADOS",26,0) + N DIC,X,Y,DIE,DA,DR,FLDIEN,FLDNAME,FLDTYPE,FDEF,TRANS +"RTN","BMXADOS",27,0) + N %,%Y,HDR,DTYPE,LEN,FARR,I,TOT,PAUSE,PFLAG,IFLAG,IMSG,STG,READ +"RTN","BMXADOS",28,0) + D FLIST(.FARR,FIEN,0) +"RTN","BMXADOS",29,0) + S TOT=$O(FARR(9999),-1) I 'TOT S STOP=1 Q +"RTN","BMXADOS",30,0) + W !,"Select a field from this "_$S($D(^DD(FIEN,0,"UP")):"sub-",1:"")_"file: " +"RTN","BMXADOS",31,0) + S I=0 F S I=$O(FARR(I)) Q:'I S PAUSE=$$PAUSE(I) Q:PAUSE'="" W I,?3,FARR(I) +"RTN","BMXADOS",32,0) + I $G(PAUSE)=U S STOP=1 Q +"RTN","BMXADOS",33,0) + I $G(PAUSE) S Y=PAUSE G FLD1 +"RTN","BMXADOS",34,0) + S DIR(0)="NO^1:"_TOT_":",DIR("A")="Select a field from the list" K DA D ^DIR K DIR +"RTN","BMXADOS",35,0) + I 'Y S STOP=1 Q +"RTN","BMXADOS",36,0) +FLD1 S %=FARR(+Y) +"RTN","BMXADOS",37,0) + S FLDIEN=+$P(%," [",2),FLDNAME=$P(%," [") +"RTN","BMXADOS",38,0) + I $$FDEL(SIEN,FLDIEN) Q ; FIELD DELETED +"RTN","BMXADOS",39,0) + S X=$$FDEF(FIEN,FLDIEN) I '$L(X) W " ??" Q +"RTN","BMXADOS",40,0) + S DTYPE=$E(X),LEN=+$E(X,2,6) +"RTN","BMXADOS",41,0) + S DIR(0)="F^1:30",DIR("A")="Column header",DIR("B")=FLDNAME D ^DIR K DIR +"RTN","BMXADOS",42,0) + S HDR=Y,TRANS=0 +"RTN","BMXADOS",43,0) + S %=$P($G(^DD(FIEN,FLDIEN,0)),U,2) ; CHECK FM DD TO SEE IF FIELD IS REQUIRED +"RTN","BMXADOS",44,0) + I %["R" W !,"FileMan requires a non-null value for this field" S %=2 +"RTN","BMXADOS",45,0) + E W !,"Is null allowed" S %=$S(FLDIEN=.01:2,1:1) D YN^DICN I %Y?1."^" Q +"RTN","BMXADOS",46,0) + I %=2 S TRANS=1 ; NON NULL VALUE REQUIRED TO COMPLETE THE TRANSACTION OR THERE WILL BE ROLLBACK +"RTN","BMXADOS",47,0) + I $G(PFLAG) D ; IF POINTER, ASK IF USER WANTS TO AUTOMATICALLY INSERT THE LOOKUP VALUE FIELD IN THE SCHEMA +"RTN","BMXADOS",48,0) + . W !,"This field is a pointer value (IEN)." +"RTN","BMXADOS",49,0) + . W !,"Want to automatically insert the lookup value in the schema" +"RTN","BMXADOS",50,0) + . S %=2 D YN^DICN W ! I %=1 S PFLAG=2 +"RTN","BMXADOS",51,0) + . Q +"RTN","BMXADOS",52,0) +IFLG I $G(IFLAG) D ; NON-POINTER .01 FIELD. ASK IF USER WANTS TO REFERENCE IDENTIFIER EP +"RTN","BMXADOS",53,0) + . W !,"Want to display identifiers with this field" +"RTN","BMXADOS",54,0) + . S %=2 D YN^DICN W ! I %'=1 Q +"RTN","BMXADOS",55,0) + . S IMSG="Respond with a valid entry point in the format 'TAG^ROUTINE'." +"RTN","BMXADOS",56,0) + . W !,"Entry Point to generate Identifiers: " R Y:$G(DTIME,60) E Q +"RTN","BMXADOS",57,0) + . I Y?1."^" Q +"RTN","BMXADOS",58,0) + . I Y?1."?" W !,IMSG S IFLAG(0)="!" Q +"RTN","BMXADOS",59,0) + . I Y'?1U.7UN1"^"1U.7UN S IFLAG(0)="!" W " ??" +"RTN","BMXADOS",60,0) + . I $L(Y)>2 S IFLAG(0)=Y,IFLAG=2 +"RTN","BMXADOS",61,0) + . Q +"RTN","BMXADOS",62,0) + I $G(IFLAG(0))="!" W !,IMSG K IPFLAG(0),IMSG W !!! G IFLG +"RTN","BMXADOS",63,0) + S DA(1)=SIEN,DIC="^BMXADO("_DA(1)_",1," +"RTN","BMXADOS",64,0) + S DIC("P")=90093.991,DIC(0)="L",X=FLDIEN +"RTN","BMXADOS",65,0) + I '$D(^BMXADO(SIEN,1,0)) S ^BMXADO(SIEN,1,0)="^90093.991^^" +"RTN","BMXADOS",66,0) + D ^DIC I Y=-1 Q +"RTN","BMXADOS",67,0) + S READ=($P($G(^DD(FIEN,FLDIEN,0)),U,2)["C") ; COMPUTED FIELDS ARE READ ONLY! +"RTN","BMXADOS",68,0) + S DIE=DIC,DA=+Y +"RTN","BMXADOS",69,0) + S DR=".02///^S X=DTYPE;.03///^S X=LEN;.04///^S X=HDR;.05///^S X=READ;.06///0;.07///^S X=('TRANS)" +"RTN","BMXADOS",70,0) + D ^DIE +"RTN","BMXADOS",71,0) + I $G(IFLAG)=2 D ID +"RTN","BMXADOS",72,0) + I $G(PFLAG)'=2 Q +"RTN","BMXADOS",73,0) +LKUP ; AUTOMATICALLY ADD A LOOKUP FIELD TO THE SCHEMA +"RTN","BMXADOS",74,0) + S X=FLDIEN_"IEN" +"RTN","BMXADOS",75,0) + D ^DIC I Y=-1 Q +"RTN","BMXADOS",76,0) + W !,"The LOOKUP field '"_X_"' has been added to the schema",! +"RTN","BMXADOS",77,0) + S HDR=HDR_"_IEN",DTYPE="I",LEN="00009" +"RTN","BMXADOS",78,0) + S DIE=DIC,DA=+Y +"RTN","BMXADOS",79,0) + S DR=".02///^S X=DTYPE;.03///^S X=LEN;.04///^S X=HDR;.05///^S X=READ;.06///0;.07///^S X=('TRANS)" +"RTN","BMXADOS",80,0) + D ^DIE +"RTN","BMXADOS",81,0) + Q +"RTN","BMXADOS",82,0) + ; +"RTN","BMXADOS",83,0) +ID ; AUTOMATICALLY ADD AN IDENTIFIER REFERENCE +"RTN","BMXADOS",84,0) + N X,Y,DIE,DR,DA,REF +"RTN","BMXADOS",85,0) + S X=".01ID",DA(1)=SIEN +"RTN","BMXADOS",86,0) + S REF=IFLAG(0) I '$L(REF) Q +"RTN","BMXADOS",87,0) + D ^DIC I Y=-1 Q +"RTN","BMXADOS",88,0) + W !,"The identifier field '"_X_"' has been added to the schema",! +"RTN","BMXADOS",89,0) + S HDR=HDR_"_ID",DTYPE="T",LEN="00017" +"RTN","BMXADOS",90,0) + S DIE=DIC,DA=+Y +"RTN","BMXADOS",91,0) + S DR=".02///^S X=DTYPE;.03///^S X=LEN;.04///^S X=HDR;.05///^S X=READ;.06///0;.07///^S X=('TRANS);1///^S X=REF" +"RTN","BMXADOS",92,0) + D ^DIE +"RTN","BMXADOS",93,0) + Q +"RTN","BMXADOS",94,0) + ; +"RTN","BMXADOS",95,0) +FDEL(SIEN,FIELD) ; DELETE AN EXISTING ENTRY FROM THE 'FIELD' MULTIPLE. RETURN '1' IF THE RECORD WAS DELETED +"RTN","BMXADOS",96,0) + N FIEN,DA,DIK +"RTN","BMXADOS",97,0) + S FIEN=$O(^BMXADO(SIEN,1,"B",FIELD,0)) I 'FIEN Q 0 ; THIS IS A NEW ENTRY +"RTN","BMXADOS",98,0) + W !,"This field already is attached to the schema. Want to delete it" +"RTN","BMXADOS",99,0) + S %=2 D YN^DICN +"RTN","BMXADOS",100,0) + I %'=1 Q 0 +"RTN","BMXADOS",101,0) + S DA(1)=SIEN,DIK="^BMXADO("_DA(1)_",1,",DA=FIEN +"RTN","BMXADOS",102,0) + D ^DIK +"RTN","BMXADOS",103,0) + S FIEN=$O(^BMXADO(SIEN,1,"B",(FIELD_"IEN"),0)) +"RTN","BMXADOS",104,0) + I FIEN S DA=FIEN D ^DIK ; DELETE LOOKUP VALUE FIELD AS WELL +"RTN","BMXADOS",105,0) + W " Done!",! +"RTN","BMXADOS",106,0) + Q 1 +"RTN","BMXADOS",107,0) + ; +"RTN","BMXADOS",108,0) +FDEF(FILE,FIELD) ;EP - GIVEN A FILEMAN FILE AND FIELD, RETURN THE DATA DEFINITION IN ADO FORMAT +"RTN","BMXADOS",109,0) + N %,X,Y,Z,STG,I,DTYPE,FNAME,LEN,DNAME +"RTN","BMXADOS",110,0) + I '$D(^DD(+$G(FILE),+$G(FIELD),0)) Q "" +"RTN","BMXADOS",111,0) + S STG=$G(^DD(FILE,FIELD,0)) I '$L(STG) Q "" ; GET DATA DEF STRING +"RTN","BMXADOS",112,0) +DTYPE S %="DNSFWCPVM",X=$P(STG,U,2),DTYPE="" ; GET DATA TYPE +"RTN","BMXADOS",113,0) + F I=1:1:$L(%) S Y=$E(%,I) I X[Y S DTYPE=Y Q +"RTN","BMXADOS",114,0) + I DTYPE="" Q "" +"RTN","BMXADOS",115,0) +FNAME S DNAME=$P(STG,U) I '$L(DNAME) Q "" ; FIELD NAME +"RTN","BMXADOS",116,0) +DDA ; ADO FORMAT +"RTN","BMXADOS",117,0) + I DTYPE="D" D Q "D"_LEN_DNAME +"RTN","BMXADOS",118,0) + . S LEN="00021" +"RTN","BMXADOS",119,0) + . I STG["S %DT=" S %=$P(STG,"S %DT=",2),%=$P(%,$C(34)) +"RTN","BMXADOS",120,0) + . I $G(FLDIEN)=.01 S IFLAG=1 +"RTN","BMXADOS",121,0) + . I %["S" S LEN="00019" Q +"RTN","BMXADOS",122,0) + . I %["T" S LEN="00018" Q +"RTN","BMXADOS",123,0) + . Q +"RTN","BMXADOS",124,0) + I DTYPE="N",STG["1N.N" D Q:'LEN "" Q "I"_LEN_DNAME ; INTEGER +"RTN","BMXADOS",125,0) + . S %=+$P(STG,"K:+X'=X!(X>",2) +"RTN","BMXADOS",126,0) + . S Y=$L(%) +"RTN","BMXADOS",127,0) + . S LEN=$E("00000",1,5-$L(Y))_Y +"RTN","BMXADOS",128,0) + . Q +"RTN","BMXADOS",129,0) + I DTYPE="N" D Q:'LEN "" Q "N"_LEN_DNAME ; NUMBER (COULD HAVE A DECIMAL VALUE) +"RTN","BMXADOS",130,0) + . S %=+$P(STG,"!(X?.E1"".""",2) +"RTN","BMXADOS",131,0) + . S X=+$P(STG,"K:+X'=X!(X>",2) +"RTN","BMXADOS",132,0) + . S Y=%+($L(+X)) +"RTN","BMXADOS",133,0) + . S LEN=$E("00000",1,5-$L(Y))_Y +"RTN","BMXADOS",134,0) + . Q +"RTN","BMXADOS",135,0) + I DTYPE="F" D Q:'LEN "" Q "T"_LEN_DNAME +"RTN","BMXADOS",136,0) + . S Y=+$P(STG,"K:$L(X)>",2) +"RTN","BMXADOS",137,0) + . S LEN=$E("00000",1,5-$L(Y))_Y +"RTN","BMXADOS",138,0) + . I 'LEN S LEN="00030" +"RTN","BMXADOS",139,0) + . I $G(FLDIEN)=.01 S IFLAG=1 +"RTN","BMXADOS",140,0) + . Q +"RTN","BMXADOS",141,0) + I DTYPE="S" D Q:'LEN "" Q "T"_LEN_DNAME +"RTN","BMXADOS",142,0) + . S X=$P(STG,U,3),Y=0 +"RTN","BMXADOS",143,0) + . F I=1:1:$L(X,":") S Z=$P(X,":",2),Z=$P(Z,";"),%=$L(Z) I %>Y S Y=% +"RTN","BMXADOS",144,0) + . S LEN=$E("00000",1,5-$L(Y))_Y +"RTN","BMXADOS",145,0) + . Q +"RTN","BMXADOS",146,0) + I DTYPE="P" S PFLAG=1 Q "T00030"_DNAME +"RTN","BMXADOS",147,0) + I DTYPE="W" Q "T05000"_DNAME +"RTN","BMXADOS",148,0) + I DTYPE="V" Q "" +"RTN","BMXADOS",149,0) + Q "T00250"_DNAME +"RTN","BMXADOS",150,0) + ; +"RTN","BMXADOS",151,0) +FILE(SIEN) ; GET THE FILE OR SUBFILE NUMBER +"RTN","BMXADOS",152,0) + N FNO,FIEN,DIC,X,Y,%,FILE,NSTG,GBL,FNAME,SUB,FARR,TOT,I +"RTN","BMXADOS",153,0) + S (FILE,FNO)=$P(^BMXADO(SIEN,0),U,2) +"RTN","BMXADOS",154,0) +OLD I FNO D I $G(FIEN) Q FIEN +"RTN","BMXADOS",155,0) + . S NSTG=$O(^DD(FNO,0,"NM","")) +"RTN","BMXADOS",156,0) + . F S FNO=$G(^DD(FNO,0,"UP")) Q:'FNO S NSTG=$O(^DD(FNO,0,"NM",""))_"/"_NSTG +"RTN","BMXADOS",157,0) +OLD1 . W !,$S(NSTG["/":"Sub-",1:""),"File #",FILE," (",NSTG,") is linked to this schema." +"RTN","BMXADOS",158,0) + . W !,"Want to keep it" S %=1 +"RTN","BMXADOS",159,0) + . D YN^DICN I %'=2 W:%=1 " OK" S FIEN=FILE Q +"RTN","BMXADOS",160,0) + . W !!,"If you change or delete this file number,",!,"all the information in this schema will be deleted." +"RTN","BMXADOS",161,0) + . W !,"Are you sure you want to do this" S %=2 D YN^DICN +"RTN","BMXADOS",162,0) + . I %'=1 W !! G OLD1 +"RTN","BMXADOS",163,0) + . S GBL="^BMXADO("_SIEN_")" +"RTN","BMXADOS",164,0) + . K @GBL@(1),@GBL@(2) +"RTN","BMXADOS",165,0) + . S $P(@GBL@(0),U,2)="" +"RTN","BMXADOS",166,0) + . W !,"This schema definition has been deleted. You may redefine it now" +"RTN","BMXADOS",167,0) + . Q +"RTN","BMXADOS",168,0) +NEW S DIC=1,DIC(0)="AEQM" D ^DIC I Y=-1 Q "" +"RTN","BMXADOS",169,0) + S FNO=+Y,FNAME=$P(Y,U,2) +"RTN","BMXADOS",170,0) +NEW1 D SC(.FARR,FNO,1) +"RTN","BMXADOS",171,0) + S TOT=$O(FARR(999999),-1) I 'TOT Q FNO ; NO SUBFILES FOUND +"RTN","BMXADOS",172,0) + W !!,"The ",FNAME," file contains the following sub-file" I TOT>1 W "s" +"RTN","BMXADOS",173,0) + W ! +"RTN","BMXADOS",174,0) + S I=0 F S I=$O(FARR(I)) Q:'I S PAUSE=$$PAUSE(I) Q:PAUSE'="" W I,?3,FARR(I) +"RTN","BMXADOS",175,0) + I $G(PAUSE)=U Q "" +"RTN","BMXADOS",176,0) + I $G(PAUSE) S Y=PAUSE G NEW2 +"RTN","BMXADOS",177,0) + W !!,"Is the schema linked to a sub-file in this list" +"RTN","BMXADOS",178,0) + S %=2 D YN^DICN I %=2 Q FNO +"RTN","BMXADOS",179,0) + S DIR(0)="NO^1:"_TOT_":",DIR("A")="Select a sub-file from the list" K DA D ^DIR K DIR +"RTN","BMXADOS",180,0) + I 'Y Q "" +"RTN","BMXADOS",181,0) +NEW2 Q +$P(FARR(+Y)," (",2) +"RTN","BMXADOS",182,0) + ; +"RTN","BMXADOS",183,0) +PAUSE(I) ; SCROLL CHECK +"RTN","BMXADOS",184,0) + N % +"RTN","BMXADOS",185,0) + W ! +"RTN","BMXADOS",186,0) + I (I#20) Q "" +"RTN","BMXADOS",187,0) + W "Select a number from the list (1-",(I-1),") or press to continue: " +"RTN","BMXADOS",188,0) + R %:$G(DTIME,60) E Q "" +"RTN","BMXADOS",189,0) + I %?1."^" Q U +"RTN","BMXADOS",190,0) + I $L(%),$D(FARR(I)) Q % +"RTN","BMXADOS",191,0) + I $L(%) W " ??" H 2 +"RTN","BMXADOS",192,0) + W $C(13),?79,$C(13) +"RTN","BMXADOS",193,0) + Q "" +"RTN","BMXADOS",194,0) + ; +"RTN","BMXADOS",195,0) +SC(OUT,FILE,MODE) ;EP - SUB CRAWLER. GIVEN A FILE NUMBER RETURN ALL OF ITS DESCENDANT FILES IN AN ARRAY +"RTN","BMXADOS",196,0) + I '$D(^DD(FILE,"SB")) Q ; NO DESCENDANTS +"RTN","BMXADOS",197,0) + N TOT,FNO,FNAME,FIEN,LEVEL,NODE,SARR,STG,X,%,UP,ARR +"RTN","BMXADOS",198,0) + S FIEN=FILE,TOT=0 +"RTN","BMXADOS",199,0) + D PASS1 +"RTN","BMXADOS",200,0) + I '$O(ARR(0)) Q +"RTN","BMXADOS",201,0) +SC2 ; SECOND PASS. BUILD THE INTERMEDIATE ARRAY +"RTN","BMXADOS",202,0) + S FNO=0 F S FNO=$O(ARR(FNO)) Q:'FNO D +"RTN","BMXADOS",203,0) + . I $P($G(^DD(FNO,.01,0)),U,2)["W" K ARR(FNO) Q ; WORD PROCESSING FIELDS DO NOT COUNT +"RTN","BMXADOS",204,0) + . S STG=FNO,UP=FNO +"RTN","BMXADOS",205,0) + . F S UP=$G(^DD(UP,0,"UP")) Q:'UP S STG=UP_","_STG ; BUILD DESCENDANT STRING +"RTN","BMXADOS",206,0) + . I $G(MODE) S STG=$$ASTG(STG) +"RTN","BMXADOS",207,0) + . S STG=$P(STG,",",2,99) ; DONT NEED TOP LEVEL FILE +"RTN","BMXADOS",208,0) + . I '$L(STG) Q ; SOMETHING IS SCREWED UP +"RTN","BMXADOS",209,0) + . S LEVEL=$L(STG,",") +"RTN","BMXADOS",210,0) + . S FNAME=$O(^DD(FNO,0,"NM","")) +"RTN","BMXADOS",211,0) + . S X="SARR("_STG_")" +"RTN","BMXADOS",212,0) + . S @X=FNAME_U_LEVEL_U_FNO +"RTN","BMXADOS",213,0) + . K ARR(FNO) +"RTN","BMXADOS",214,0) + . Q +"RTN","BMXADOS",215,0) +SC3 ; 3RD PASS. BUILD OUTPUT ARAY +"RTN","BMXADOS",216,0) + S NODE="SARR" +"RTN","BMXADOS",217,0) + F S NODE=$Q(@NODE) Q:NODE="" D +"RTN","BMXADOS",218,0) + . S X=@NODE +"RTN","BMXADOS",219,0) + . S TOT=TOT+1 +"RTN","BMXADOS",220,0) + . S FNAME=$P(X,U) +"RTN","BMXADOS",221,0) + . S LEVEL=$P(X,U,2) +"RTN","BMXADOS",222,0) + . S FNO=$P(X,U,3) +"RTN","BMXADOS",223,0) + . S OUT(TOT)=$E(" ",1,LEVEL)_FNAME_" ("_FNO_")" +"RTN","BMXADOS",224,0) + . Q +"RTN","BMXADOS",225,0) + Q +"RTN","BMXADOS",226,0) + ; +"RTN","BMXADOS",227,0) +PASS1 ; PASS 1. BUILD THE ARRAY OF ALL SUBFILES +"RTN","BMXADOS",228,0) + N FNO S FNO=0 +"RTN","BMXADOS",229,0) + F S FNO=$O(^DD(FIEN,"SB",FNO)) Q:'FNO D +"RTN","BMXADOS",230,0) + . S ARR(FNO)="" +"RTN","BMXADOS",231,0) + . I '$D(^DD(FNO,"SB")) Q +"RTN","BMXADOS",232,0) + . N FIEN S FIEN=FNO +"RTN","BMXADOS",233,0) + . D PASS1 ; RECURSION!! +"RTN","BMXADOS",234,0) + . Q +"RTN","BMXADOS",235,0) + Q +"RTN","BMXADOS",236,0) + ; +"RTN","BMXADOS",237,0) +ASTG(STG) ; CONVERT STRING FROM FILE NUMBERS TO FILE NAMES +"RTN","BMXADOS",238,0) + N PCE,LEV,FNO,NAME +"RTN","BMXADOS",239,0) + S LEV=$L(STG,",") +"RTN","BMXADOS",240,0) + F PCE=1:1:LEV S FNO=+$P(STG,",",PCE) D Q:'$L(STG) ; v 2.21 SMH +"RTN","BMXADOS",241,0) + . S NAME=$O(^DD(FNO,0,"NM","")) +"RTN","BMXADOS",242,0) + . I $E(NAME)="*" S NAME=$E(NAME,2,99) +"RTN","BMXADOS",243,0) + . I '$L(NAME) S STG="" Q +"RTN","BMXADOS",244,0) + . S $P(STG,",",PCE)=""""_NAME_"""" +"RTN","BMXADOS",245,0) + . Q +"RTN","BMXADOS",246,0) + Q STG +"RTN","BMXADOS",247,0) + ; +"RTN","BMXADOS",248,0) +FLIST(OUT,FILE,MODE) ;EP - GIVEN A FILE RETURN THE FILEDS IN AN ARRAY MODE=0: NUMERIC ORDER, MODE=1: ALPHA ORDER +"RTN","BMXADOS",249,0) + ; ONLY NON MULTIPLES AND WORD PROCESSING FIELDS ARE LISTED +"RTN","BMXADOS",250,0) + N FLD,TOT,NAME,ARR,SS,%,WP +"RTN","BMXADOS",251,0) + S FLD=0,TOT=0 +"RTN","BMXADOS",252,0) +F1 F S FLD=$O(^DD(FILE,FLD)) Q:'FLD D ; PASS 1 +"RTN","BMXADOS",253,0) + . S STG=$G(^DD(FILE,FLD,0)) I '$L(STG) Q +"RTN","BMXADOS",254,0) + . S %=$P(STG,U,2) +"RTN","BMXADOS",255,0) + . I %,$P($G(^DD(%,.01,0)),U,2)'["W" Q ; EXCLUDE ALL MULTIPLE FIELDS EXCEPT WORD PROCESSING FIELDS +"RTN","BMXADOS",256,0) + . S WP=0 I % S WP=1 +"RTN","BMXADOS",257,0) + . S NAME=$P(STG,U) +"RTN","BMXADOS",258,0) + . S SS=FLD +"RTN","BMXADOS",259,0) + . I $G(MODE)=1 S %=NAME S:$E(%)="*" %=$E(%,2,99) S SS=% +"RTN","BMXADOS",260,0) + . S ARR(SS)=FLD_U_NAME_U_WP +"RTN","BMXADOS",261,0) + . Q +"RTN","BMXADOS",262,0) +F2 S SS="" +"RTN","BMXADOS",263,0) + F S SS=$O(ARR(SS)) Q:SS="" D +"RTN","BMXADOS",264,0) + . S TOT=TOT+1 +"RTN","BMXADOS",265,0) + . S %=ARR(SS) +"RTN","BMXADOS",266,0) + . S OUT(TOT)=$P(%,U,2)_" ["_+%_"]"_$S($P(%,U,3):" (word processing)",1:"") +"RTN","BMXADOS",267,0) + . K ARR(SS) +"RTN","BMXADOS",268,0) + . Q +"RTN","BMXADOS",269,0) + Q +"RTN","BMXADOS",270,0) + ; +"RTN","BMXADOS1") +0^70^B9622665 +"RTN","BMXADOS1",1,0) +BMXADOS1 ; IHS/CIHA/GIS - UPDATE THE BMX ADO SCHEMA FILE GUI VERSION ; +"RTN","BMXADOS1",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXADOS1",3,0) + ; RPC CALLS +"RTN","BMXADOS1",4,0) + ; +"RTN","BMXADOS1",5,0) + ; +"RTN","BMXADOS1",6,0) + ; +"RTN","BMXADOS1",7,0) +DISP(OUT) ; TEMP DISPLAY +"RTN","BMXADOS1",8,0) + N I,X +"RTN","BMXADOS1",9,0) + S I=0 W ! +"RTN","BMXADOS1",10,0) + F S I=$O(@OUT@(I)) Q:'I S X=@OUT@(I) S X=$TR(X,$C(30),"}") S X=$TR(X,$C(31),"{") W !,X +"RTN","BMXADOS1",11,0) + Q +"RTN","BMXADOS1",12,0) + ; +"RTN","BMXADOS1",13,0) +SCHEMA(NAME) ; GIVEN SCHEMA NAME, RETURN THE IEN +"RTN","BMXADOS1",14,0) + N IEN +"RTN","BMXADOS1",15,0) + S IEN=$O(^BMXADO("B",NAME,0)) +"RTN","BMXADOS1",16,0) + Q IEN +"RTN","BMXADOS1",17,0) + ; +"RTN","BMXADOS1",18,0) +FILE ; RETURN A LIST OF FILES +"RTN","BMXADOS1",19,0) + N OUT,%,SIEN +"RTN","BMXADOS1",20,0) + S SIEN=$$SCHEMA("FILEMAN FILES") +"RTN","BMXADOS1",21,0) + D SS^BMXADO(.OUT,SIEN,"","B~B~C~") +"RTN","BMXADOS1",22,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOS1",23,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOS1",24,0) + Q +"RTN","BMXADOS1",25,0) + ; +"RTN","BMXADOS1",26,0) +SF ; RETURN A LIST OF SUBFILES +"RTN","BMXADOS1",27,0) + N OUT,%,SIEN +"RTN","BMXADOS1",28,0) + S SIEN=$$SCHEMA("SUBFILES") +"RTN","BMXADOS1",29,0) + D SS^BMXADO(.OUT,SIEN,"","~~~~~SFIT~BMXADOS1~2~") +"RTN","BMXADOS1",30,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOS1",31,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOS1",32,0) + Q +"RTN","BMXADOS1",33,0) + ; +"RTN","BMXADOS1",34,0) +FLD ; RETURN LIST OF FIELDS FOR A FILE OR SUBFILE +"RTN","BMXADOS1",35,0) + N OUT,%,SIEN +"RTN","BMXADOS1",36,0) + S SIEN=$$SCHEMA("FIELDS") +"RTN","BMXADOS1",37,0) + D SS^BMXADO(.OUT,SIEN,"","~~~~~FLDIT~BMXADOS1~2~") +"RTN","BMXADOS1",38,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOS1",39,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOS1",40,0) + Q +"RTN","BMXADOS1",41,0) + ; +"RTN","BMXADOS1",42,0) +SCH ; RETURN A LIST OF SCHEMAS +"RTN","BMXADOS1",43,0) + N OUT,%,SIEN +"RTN","BMXADOS1",44,0) + S SIEN=$$SCHEMA("SCHEMAS") +"RTN","BMXADOS1",45,0) + D SS^BMXADO(.OUT,SIEN,"","B~~~") +"RTN","BMXADOS1",46,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOS1",47,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOS1",48,0) + Q +"RTN","BMXADOS1",49,0) + ; +"RTN","BMXADOS1",50,0) +SD ; RETURN THE SCHEMA DEFINITION +"RTN","BMXADOS1",51,0) + N OUT,%,SIEN +"RTN","BMXADOS1",52,0) + S SIEN=$$SCHEMA("SCHEMA DEFINITION") +"RTN","BMXADOS1",53,0) + D SS^BMXADO(.OUT,SIEN,"52,","~~~") +"RTN","BMXADOS1",54,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOS1",55,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOS1",56,0) + Q +"RTN","BMXADOS1",57,0) + ; +"RTN","BMXADOS1",58,0) +FLDIT(PARAM,IENS,MAX,OUT,TOT) ; CUSTOM ITERATOR TO DISPLAY FIELDS +"RTN","BMXADOS1",59,0) + N SFARR,CNT,DEL,NUM,NAME,DDT,DLEN,DHDR,DRO,DKEY,DNA,X,Y +"RTN","BMXADOS1",60,0) + D FLIST^BMXADOS(.SFARR,PARAM) +"RTN","BMXADOS1",61,0) + S CNT=0,DEL=" [" +"RTN","BMXADOS1",62,0) + F S CNT=$O(SFARR(CNT)) Q:'CNT D +"RTN","BMXADOS1",63,0) + . S X=SFARR(CNT) I '$L(X) Q +"RTN","BMXADOS1",64,0) + . S NAME=$P(X,DEL) +"RTN","BMXADOS1",65,0) + . ; F Q:$E(NAME)'=" " S NAME=$E(NAME,2,999) +"RTN","BMXADOS1",66,0) + . I '$L(NAME) Q +"RTN","BMXADOS1",67,0) + . S NUM=+$P(X,DEL,2) I 'NUM Q +"RTN","BMXADOS1",68,0) + . S TOT=TOT+1 +"RTN","BMXADOS1",69,0) + . S Y=$$FDEF^BMXADOS(PARAM,NUM) I '$L(Y) Q ; "" +"RTN","BMXADOS1",70,0) + . S DDT=$E(Y),DLEN=+$E(Y,2,6),DHDR=$E(Y,7,99) +"RTN","BMXADOS1",71,0) + . S DRO="NO" S DKEY="NO" S DNA="YES" +"RTN","BMXADOS1",72,0) + . S ^TMP("BMX ADO",$J,TOT)=NUM_U_NAME_U_DDT_U_DLEN_U_DHDR_U_DRO_U_DKEY_U_DNA_$C(30) +"RTN","BMXADOS1",73,0) + Q "" +"RTN","BMXADOS1",74,0) + ; +"RTN","BMXADOS1",75,0) +FNIT(PARAM,IENS,MAX,OUT,TOT) ; CUSTOM ITERATOR TO DISPLAY FILE OR SUBFILE NAME GIVEN FILE NUMBER +"RTN","BMXADOS1",76,0) + N NUM,NAME +"RTN","BMXADOS1",77,0) + S NUM=+PARAM +"RTN","BMXADOS1",78,0) + S NAME="" +"RTN","BMXADOS1",79,0) + Q:'$D(^DD(NUM,0,"NM")) "" +"RTN","BMXADOS1",80,0) + S NAME=$O(^DD(NUM,0,"NM",0)) +"RTN","BMXADOS1",81,0) + S TOT=TOT+1 +"RTN","BMXADOS1",82,0) + S ^TMP("BMX ADO",$J,TOT)=NUM_U_NAME_$C(30) +"RTN","BMXADOS1",83,0) + Q "" +"RTN","BMXADOS1",84,0) + ; +"RTN","BMXADOS1",85,0) +SFIT(PARAM,IENS,MAX,OUT,TOT) ; CUSTOM ITERATOR TO DISPLAY SUBFILES +"RTN","BMXADOS1",86,0) + N SFARR,CNT,DEL,NUM,NAME +"RTN","BMXADOS1",87,0) + D SC^BMXADOS(.SFARR,PARAM) +"RTN","BMXADOS1",88,0) + S CNT=0,DEL=" (" +"RTN","BMXADOS1",89,0) + F S CNT=$O(SFARR(CNT)) Q:'CNT D +"RTN","BMXADOS1",90,0) + . S X=SFARR(CNT) I '$L(X) Q +"RTN","BMXADOS1",91,0) + . S NAME=$P(X,DEL) +"RTN","BMXADOS1",92,0) + . ; F Q:$E(NAME)'=" " S NAME=$E(NAME,2,999) +"RTN","BMXADOS1",93,0) + . I '$L(NAME) Q +"RTN","BMXADOS1",94,0) + . S NUM=+$P(X,DEL,2) I 'NUM Q +"RTN","BMXADOS1",95,0) + . S TOT=TOT+1 +"RTN","BMXADOS1",96,0) + . S ^TMP("BMX ADO",$J,TOT)=NUM_U_NAME_$C(30) +"RTN","BMXADOS1",97,0) + Q "" +"RTN","BMXADOS1",98,0) + ; +"RTN","BMXADOS1",99,0) +SFT(FNAME) ; TRIGGER "YES" TO INDICATE THAT A SUBFILE IS PRESENT WITHIN A FILE +"RTN","BMXADOS1",100,0) + I '$L($G(FNAME)) Q "" +"RTN","BMXADOS1",101,0) + N FIEN +"RTN","BMXADOS1",102,0) + S FIEN=$O(^DIC("B",FNAME,0)) +"RTN","BMXADOS1",103,0) + I 'FIEN Q "" +"RTN","BMXADOS1",104,0) + I '$O(^DD(FIEN,"SB",0)) Q "" +"RTN","BMXADOS1",105,0) + Q "+" +"RTN","BMXADOS1",106,0) + ; +"RTN","BMXADOV") +0^71^B22947698 +"RTN","BMXADOV",1,0) +BMXADOV ; CIHA/CIHA/GIS - RPC CALL: GENERATE DATA FOR AN ADO DATASET +"RTN","BMXADOV",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXADOV",3,0) + ; +"RTN","BMXADOV",4,0) + ; +"RTN","BMXADOV",5,0) + ; +"RTN","BMXADOV",6,0) + ; VSTG = VIEW STRING: SCHEMA NAME OR IEN~DAS~INDEX~START~STOP~MAX~FORMAT~TAG~ROUTINE~PARAM~JOIN +"RTN","BMXADOV",7,0) + ; SCHEMA NAME/IEN: FROM THE BMX ADO SCHEMA FILE +"RTN","BMXADOV",8,0) + ; DAS: THE DA STRING. HIGHEST LEVEL IS FIRST, FOLLOWED BY SUBFILE IENS. CAN BE CONVERTED TO AN 'IENS' STRING. +"RTN","BMXADOV",9,0) + ; IF THE LAST ',' PIECE OF DAS IS DEFINED, THAT IS USED AS THE CURRENT STARTING SEED POINT FOR THE ITERATOR +"RTN","BMXADOV",10,0) + ; THE NEXT INDEX VALUE AFTER THE SEED POINT WILL BE THE FIRST ENTRY SELECTED FOR THE CURRENT TRANSACTION +"RTN","BMXADOV",11,0) + ; INDEX: THE INDEX THAT RUNS THE ITERATOR. IF NULL, THE ITERATOR WULL CYCLE BY IEN +"RTN","BMXADOV",12,0) + ; START: STARTING LOOKUP VALUE IN THE OVERALL ITERATION (THE FIRST VALUE THAT CAN BE USED IN SPECIFIED INDEX) +"RTN","BMXADOV",13,0) + ; STOP: THE LAST LOOKUP VALUE IN THE OVERALL ITERATION (THE LAST VALUE USED IN SPECIFIED INDEX) +"RTN","BMXADOV",14,0) + ; START AND STOP MUST BE IN THE FORMAT (INTERNAL OR EXTERNAL) USED BY THE INDEX +"RTN","BMXADOV",15,0) + ; IF THE INDEX IS ON A POINTER FIELD, AND POINTED TO FILED IS DINUMNED, THEN THE EXTERNAL VALUE CAN BE USED +"RTN","BMXADOV",16,0) + ; MAX: MAXIMUM NUMBER OF ENTRIES REURNED IN THE TRANSACTION +"RTN","BMXADOV",17,0) + ; FORMAT: RETURN INTERNAL OR EXTERNAL VALUES IN THE DATASET +"RTN","BMXADOV",18,0) + ; TAG AND ROUTINE: ENTRY POINT FOR CUSTOM/COMPLEX ITERATION +"RTN","BMXADOV",19,0) + ; PARAM: PARAMETER STRING PASSED TO THE ITERATOR ENTRY POINT. +"RTN","BMXADOV",20,0) + ; ALSO USED WITH THE AA INDEX TO DEFINE PATIENT DFN, V FILE ATTRIBUTE TYPE AND SORT ORDER (C OR R) +"RTN","BMXADOV",21,0) + ; E.G., 1|WT|R COULD BE PATIENT #1, MEASUREMENT TYPE="WEIGHT" AND REVERSE CHRONOLICAL PRESENTATION OF DATA +"RTN","BMXADOV",22,0) + ; JOIN: JOIN INSTRUCTIONS; E.G., ...~2,4,.04|2,5,.07|4,9,SUB" +"RTN","BMXADOV",23,0) + ; +"RTN","BMXADOV",24,0) + ; +"RTN","BMXADOV",25,0) +VIEW(OUT,VSTG,TOT) ; EP-VIEW A DATA SET ; GATEWAY TO ALL ITERATORS +"RTN","BMXADOV",26,0) + ; +"RTN","BMXADOV",27,0) + ; DON'T CALL THIS EP UNLESS YOU WANT DATA RETURNED WITH THE SCHEMA! +"RTN","BMXADOV",28,0) + ; INPUT: VSTG AND THE TOTAL NUMBER OF NODES IN THE SCHEMA ARRAY +"RTN","BMXADOV",29,0) + ; OUTPUT: THE DATA NODES AND THE SEED (SEED IS STUFFED INTO 3RD PIECE OF INTRODUCTORY NODE OF SCHEMA ARRAY) +"RTN","BMXADOV",30,0) + ; RETURNS THE ADO DATASET IN THE ARRAY SPECIFIED BY 'OUT' +"RTN","BMXADOV",31,0) + ; THE SEED IS ALWAYS RETURNED IN 'LDA' REGARDLESS OF WHAT ITERATOR IS USED +"RTN","BMXADOV",32,0) + ; IF ITERATION IS COMPLETED THE SEED WILL HAVE A NULL VALUE +"RTN","BMXADOV",33,0) + ; +"RTN","BMXADOV",34,0) + ; +"RTN","BMXADOV",35,0) + ; +"RTN","BMXADOV",36,0) + N DAS,DA,IX,START,STOP,MAX,FMT,EP,IENS,OREF,CREF,FIEN,TAG,ROUTINE,X,Y,%,PARAM,NUM,FINFO,LIEN,LDA,LFILE,%DT,T +"RTN","BMXADOV",37,0) + S SIEN=+$G(VSTG) I SIEN,'$D(^BMXADO(SIEN,0)) S ERR="Invalid schema IEN" D ERR^BMXADO(ERR) Q +"RTN","BMXADOV",38,0) + I $G(TOT)<2 S ERR="Missing schema string" D ERR^BMXADO(ERR) Q ; MUST HAVE A VALID SCHEMA STRING FOR EACH TRANSACTION +"RTN","BMXADOV",39,0) +INIT ; INITIALIZE VARIABLES +"RTN","BMXADOV",40,0) + S T="~" +"RTN","BMXADOV",41,0) + S FIEN=$P(^BMXADO(SIEN,0),U,2) I '$D(^DD(FIEN,0)) S ERR="Invalid file number in schema file" D ERR^BMXADO(ERR) Q +"RTN","BMXADOV",42,0) + S DAS=$P(VSTG,T,2),IX=$P(VSTG,T,3) +"RTN","BMXADOV",43,0) + S START=$P(VSTG,T,4),STOP=$P(VSTG,T,5),MAX=$P(VSTG,T,6) +"RTN","BMXADOV",44,0) + I $L(START),$L(STOP),START,START=+START,STOP,STOP=+STOP +"RTN","BMXADOV",45,0) + S %=$T ; NUMERIC START AND STOP +"RTN","BMXADOV",46,0) + I %,START>STOP S ERR="Invalid start stop pair" D ERR^BMXADO(ERR) Q +"RTN","BMXADOV",47,0) + I '%,$L(START),$L(STOP),START]STOP S ERR="Invalid start stop pair" D ERR^BMXADO(ERR) Q +"RTN","BMXADOV",48,0) + I $L(MAX),(MAX'>0!(MAX'=MAX\1)) S ERR="Invalid MAX parameter" D ERR^BMXADO(ERR) Q +"RTN","BMXADOV",49,0) + S FMT=$P(VSTG,T,7),TAG=$P(VSTG,T,8),ROUTINE=$P(VSTG,T,9),PARAM=$P(VSTG,T,10),NUM=0 +"RTN","BMXADOV",50,0) + I $L(TAG),'$L(ROUTINE) S ERR="Invalid EP info" D ERR^BMXADO(ERR) Q +"RTN","BMXADOV",51,0) + S EP=TAG_U_ROUTINE I EP=U S EP="" +"RTN","BMXADOV",52,0) + I $L(EP) X ("S %=$L($T("_EP_"))") I '% S ERR="Invalid EP info" D ERR^BMXADO(ERR) Q +"RTN","BMXADOV",53,0) + I FMT='"I" S FMT="" +"RTN","BMXADOV",54,0) + I MAX="" S MAX=100 +"RTN","BMXADOV",55,0) + I $G(JOIN) S MAX=999999999 ; MAX IS UNLIMITED FOR SECONDARY DATA SETS DURING JOINS +"RTN","BMXADOV",56,0) + S IENS=$$IENS(DAS) ; CONVERT DA STRING TO IEN STRING ; DAS AND IENS MUST BE AVAILABLE TO ALL ITERATORS +"RTN","BMXADOV",57,0) + S OREF=$$ROOT^DILFD(FIEN,IENS) I '$L(OREF) S ERR="Unable to generate a vaild open reference" D ERR^BMXADO(ERR) Q +"RTN","BMXADOV",58,0) + S CREF=$$CREF^DILF(OREF) I '$L(CREF) S ERR="Unable to generate a vaild closed reference" D ERR^BMXADO(ERR) Q +"RTN","BMXADOV",59,0) +DATA ; GET DATA +"RTN","BMXADOV",60,0) +SPEC I $L(EP) D Q ; SPECIAL CASE: USE CUSTOM ITERATOR +"RTN","BMXADOV",61,0) + . I '$G(LDA) S LDA="" +"RTN","BMXADOV",62,0) + . X ("S LDA=$$"_EP_"(PARAM,IENS,MAX,.OUT,.TOT)") +"RTN","BMXADOV",63,0) + . D SEED(LDA) +"RTN","BMXADOV",64,0) + . Q +"RTN","BMXADOV",65,0) + I IX="" S LDA=$$NUMIT^BMXADOV1(+$G(DA)) D SEED(LDA) Q ; NO INDEX USED: ITERATE IN IEN ORDER +"RTN","BMXADOV",66,0) + I IX="AA",FIEN=9000013!(FIEN=9000019) S IX="AC" ; 'AA' ITERATION UNNECESSARY FOR SOME FILES. BETTER TO USE 'AC' +"RTN","BMXADOV",67,0) + I '$L($O(@CREF@(IX,""))) Q ; NO INDEXED DATA AVAILABLE, SO QUIT NOW +"RTN","BMXADOV",68,0) + I IX="AA" D Q ; SPECIAL CASE: AA INDEX +"RTN","BMXADOV",69,0) + . I FIEN=9000011 S LDA=$$AAP^BMXADOV1 Q ; THE AA INDEX FOR 'PROBLEMS'; LDA ALWAYS NULL +"RTN","BMXADOV",70,0) + . S LDA=$$AA^BMXADOV1 D SEED(LDA) ; THE VISIT/V-FILE AA INDEX +"RTN","BMXADOV",71,0) + . Q +"RTN","BMXADOV",72,0) + S FINFO=$$IXFLD(FIEN,IX) I FINFO="" Q ; FILE INFO: IX FIELD NUMBER, TYPE, AND DINUM SUBTYPE +"RTN","BMXADOV",73,0) + I $P(FINFO,U,2)="D" D ; PREP FOR DATE INDEX LOOKUP +"RTN","BMXADOV",74,0) + . I $L(START) S X=START D ^%DT S START=+Y +"RTN","BMXADOV",75,0) + . I $L(STOP) S X=STOP D ^%DT S STOP=+Y +"RTN","BMXADOV",76,0) + . Q +"RTN","BMXADOV",77,0) + I $P(FINFO,U,2)="P",$E(START)="`" D Q ; SPECIAL CASE: SHORTCUT TO POINTER LOOKUP FOR A SINGLE, SPECIFIC IEN. +"RTN","BMXADOV",78,0) + . S LIEN=+$E(START,2,99) +"RTN","BMXADOV",79,0) + . S LDA=$$LOOK^BMXADOV1(LIEN) +"RTN","BMXADOV",80,0) + . D SEED(LDA) +"RTN","BMXADOV",81,0) + . Q +"RTN","BMXADOV",82,0) + I $P(FINFO,U,4) S LFILE=$P(FINFO,U,3) I LFILE D Q ; SPECIAL CASE: DINUM -> TEXT LOOKUP. +"RTN","BMXADOV",83,0) + . S LDA=$$LOOK2^BMXADOV1(LFILE) +"RTN","BMXADOV",84,0) + . D SEED(LDA) +"RTN","BMXADOV",85,0) + . Q +"RTN","BMXADOV",86,0) + S LDA=$$LOOK1^BMXADOV1 ; STD INDEX LOOKUP: START FROM SCRATCH +"RTN","BMXADOV",87,0) + D SEED(LDA) ; CAPTURE RE-ENTRY SEED +"RTN","BMXADOV",88,0) + Q +"RTN","BMXADOV",89,0) + ; +"RTN","BMXADOV",90,0) +SEED(LDA) ; UPDATE THE SCHEMA STRING WITH THE SEED PARAMETER +"RTN","BMXADOV",91,0) + N X,Y +"RTN","BMXADOV",92,0) + S X=@OUT@(1) +"RTN","BMXADOV",93,0) + S Y=$P(X,U) +"RTN","BMXADOV",94,0) + S $P(Y,"|",3)=LDA +"RTN","BMXADOV",95,0) + S $P(X,U,1)=Y +"RTN","BMXADOV",96,0) + S @OUT@(1)=X +"RTN","BMXADOV",97,0) + Q +"RTN","BMXADOV",98,0) + ; +"RTN","BMXADOV",99,0) +IENS(DAS) ;EP - CONVERT DAS STRING TO IENS STRING +"RTN","BMXADOV",100,0) + N I,L,IENS +"RTN","BMXADOV",101,0) + S DAS=$G(DAS) +"RTN","BMXADOV",102,0) + S DAS=$TR(DAS,"+","") +"RTN","BMXADOV",103,0) + S DAS=$TR(DAS,"-","") +"RTN","BMXADOV",104,0) + I '$L(DAS) Q "," +"RTN","BMXADOV",105,0) + I DAS="," S DAS="" +"RTN","BMXADOV",106,0) + S L=$L(DAS,C) +"RTN","BMXADOV",107,0) + S IENS="" +"RTN","BMXADOV",108,0) + F I=L:-1:1 S IENS=IENS_$P(DAS,C,I)_C +"RTN","BMXADOV",109,0) + Q IENS +"RTN","BMXADOV",110,0) + ; +"RTN","BMXADOV",111,0) +IXFLD(FIEN,IX) ;EP - GIVEN AN FILE NUMMER AND INDEX NAME, RETURIN THE FIELD NUMBER, TYPE, AND DINUM SUBTYPE +"RTN","BMXADOV",112,0) + N FLD,TYPES,T,X,I +"RTN","BMXADOV",113,0) + I '$G(FIEN) Q "" +"RTN","BMXADOV",114,0) + I '$L($G(IX)) Q "" +"RTN","BMXADOV",115,0) + S FLD=$O(^DD(FIEN,0,"IX",IX,FIEN,0)) +"RTN","BMXADOV",116,0) + I 'FLD Q FLD +"RTN","BMXADOV",117,0) + S TYPES="DNSFWCPVM",T=$P($G(^DD(FIEN,FLD,0)),U,2) +"RTN","BMXADOV",118,0) + F I=1:1 S X=$E(TYPES,I) Q:'$L(X) I T[X Q +"RTN","BMXADOV",119,0) + I X="P" S X=X_U_+$P(T,"P",2) I $P(^DD(FIEN,FLD,0),U,5)["DINUM" S X=X_U_1 +"RTN","BMXADOV",120,0) + S FLD=FLD_U_X +"RTN","BMXADOV",121,0) + Q FLD +"RTN","BMXADOV",122,0) + ; +"RTN","BMXADOV1") +0^45^B71930345 +"RTN","BMXADOV1",1,0) +BMXADOV1 ; IHS/CIHA/GIS - RPC CALL: GENERATE DATA FOR AN ADO DATASET ; 12/7/10 4:12pm +"RTN","BMXADOV1",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXADOV1",3,0) + ; CONTINUATION FILE FOR BMXADOV +"RTN","BMXADOV1",4,0) + ; MANAGES ITERATION FOR INDIVIDUAL INDEX TYPES +"RTN","BMXADOV1",5,0) + ; ASSUMES CERTAIN LOCAL VARS: CREF,FIEN,IENS,DAS (<-THESE CAN'T BE NULL),START,STOP,MAX,TOT,NUM,IX +"RTN","BMXADOV1",6,0) + ; +"RTN","BMXADOV1",7,0) + ; Change Log +"RTN","BMXADOV1",8,0) + ; Sam Habiel 3101212 v. 2.21 +"RTN","BMXADOV1",9,0) + ; Change line 140 from: +"RTN","BMXADOV1",10,0) + ; I IX="AA" G AA to +"RTN","BMXADOV1",11,0) + ; I IX="AA" Q $$AA +"RTN","BMXADOV1",12,0) + ; to fix compilation error +"RTN","BMXADOV1",13,0) + ; +"RTN","BMXADOV1",14,0) + ; +"RTN","BMXADOV1",15,0) +DATA(IENS,DA,XCNT) ;EP - ADD DATA NODES TO ARRAY +"RTN","BMXADOV1",16,0) + ; ASSUMES THAT VSTG VARIABLES AND THE OUT ARRAY ARE PRESENT +"RTN","BMXADOV1",17,0) + I '$G(DA) Q +"RTN","BMXADOV1",18,0) + I '$L(IENS) Q +"RTN","BMXADOV1",19,0) + S $P(IENS,C)=DA +"RTN","BMXADOV1",20,0) + N STG,X,Y,%,FLD,STOP,VAL,CNT,FIEN,LINE,IFLAG,IDEP,TFLD,TNO,TEF +"RTN","BMXADOV1",21,0) + S STG=DA +"RTN","BMXADOV1",22,0) + I $G(DAS),$E(DAS,$L(DAS))="," S STG=$TR(DAS,",",U)_STG ; FIX FOR SUBFILE +"RTN","BMXADOV1",23,0) + S CNT=$L(IENS,",") ; START AFTER THE .001 FIELD +"RTN","BMXADOV1",24,0) + I $G(SUB) S STG=$P(IENS,C,2)_U_DA ; MAKE DAS FOR A SUBFILE. THIS WILL BE THE IST PIECE OF THE DATA STRING +"RTN","BMXADOV1",25,0) + I $G(XCNT) S CNT=XCNT ; USED WITH JOINS +"RTN","BMXADOV1",26,0) + F S CNT=$O(@OUT@(CNT)) Q:'CNT Q:$G(STOP) D I @OUT@(CNT)[$C(30) Q ; LOOP TO CREATE THE DATA STRING +"RTN","BMXADOV1",27,0) + . K IFLAG,IDEP +"RTN","BMXADOV1",28,0) + . S FIEN=+@OUT@(CNT) I '$D(^DD(FIEN,0)) S STOP=1 Q +"RTN","BMXADOV1",29,0) + . S FLD=$P(@OUT@(CNT),B,2) +"RTN","BMXADOV1",30,0) + . I FLD=".01ID" D Q ; PROCESS THE IDENTIFIER FIELD +"RTN","BMXADOV1",31,0) + .. I '$G(SIEN) Q +"RTN","BMXADOV1",32,0) + .. S %=$O(^BMXADO(SIEN,1,"B",".01ID",0)) I '% Q +"RTN","BMXADOV1",33,0) + .. S IDEP=$G(^BMXADO(SIEN,1,%,1)) I '$L(IDEP) Q +"RTN","BMXADOV1",34,0) + .. X ("S VAL=$$"_IDEP_"("_+STG_")") ; PASS THE DA TO THE IDENTIFIER EXTRINSIC FUNCTION, RETURN IDENTIFIERS +"RTN","BMXADOV1",35,0) + .. S VAL=$TR(VAL,"^",""),VAL=$TR(VAL,B,"") +"RTN","BMXADOV1",36,0) + .. S STG=STG_U_VAL +"RTN","BMXADOV1",37,0) + .. Q +"RTN","BMXADOV1",38,0) + . I $G(SIEN),FLD S %=$O(^BMXADO(SIEN,1,"B",FLD,0)) I %,$P($G(^BMXADO(SIEN,1,%,0)),U,9) S IFLAG=1 ; SCHEMA FILE SAYS FORCE INTERNAL VALUE FOR THIS FIELD +"RTN","BMXADOV1",39,0) + . K TFLD +"RTN","BMXADOV1",40,0) + . I FLD["TRIGGER" S TFLD=FLD,FLD=+FLD,IFLAG=1 +"RTN","BMXADOV1",41,0) + . I FLD["IEN" S FLD=+FLD,IFLAG=1 ; LOOKUP VALUE FIELD (IEN) +"RTN","BMXADOV1",42,0) + . I '$D(^DD(FIEN,FLD,0)),FLD'=.001 S STOP=1 Q +"RTN","BMXADOV1",43,0) + . I $D(TFLD),FLD=.001 S VAL=+IENS +"RTN","BMXADOV1",44,0) + . E S VAL=$$GET1^DIQ(FIEN,IENS,FLD,$S($G(IFLAG):"I",$G(TFLAG):"I",1:$G(FMT))) +"RTN","BMXADOV1",45,0) + . I $G(TFLD) D S STG=STG_U_VAL Q ; GENERATE A TRIGGERED VALUE FOR THIS FIELD +"RTN","BMXADOV1",46,0) + .. S TNO=$O(^BMXADO(SIEN,1,"B",TFLD,0)) I 'TNO S VAL="" Q +"RTN","BMXADOV1",47,0) + .. S TEF=$G(^BMXADO(SIEN,1,TNO,3)) I '$L(TEF) S VAL="" Q ; GET EXTR FUNCT THAT GENERATES A SECONDARY VALUE +"RTN","BMXADOV1",48,0) + .. X ("S VAL=$$"_TEF_"(VAL)") +"RTN","BMXADOV1",49,0) + .. Q +"RTN","BMXADOV1",50,0) + . I FLD=.01,VAL="" S STOP=1 Q ; INVALID FILEMAN ENTRY! SKIP IT +"RTN","BMXADOV1",51,0) + . S VAL=$TR(VAL,"^",""),VAL=$TR(VAL,B,"") +"RTN","BMXADOV1",52,0) + . S STG=STG_U_VAL +"RTN","BMXADOV1",53,0) + . Q +"RTN","BMXADOV1",54,0) + I $G(STOP) Q ; DON'T ADD NODE IF DD INFO IS INVALID +"RTN","BMXADOV1",55,0) + F S LINE=$E(STG,1,250),STG=$E(STG,251,999999) D I '$L(STG) Q ; PREVENTS DATA LENGTH FROM EXCEEDING 250 BYTES +"RTN","BMXADOV1",56,0) + . S TOT=TOT+1 +"RTN","BMXADOV1",57,0) + . I '$L(STG) S LINE=LINE_$C(30),NUM=NUM+1 ; END OF RECORD, RECORD TOTAL IS UPDATED +"RTN","BMXADOV1",58,0) + . S @OUT@(TOT)=LINE ; NODE IS ADDED +"RTN","BMXADOV1",59,0) + . Q +"RTN","BMXADOV1",60,0) + Q +"RTN","BMXADOV1",61,0) + ; +"RTN","BMXADOV1",62,0) +NUMIT(DA) ; EP-ITERATE BY NUMBER +"RTN","BMXADOV1",63,0) + N XIT,LDA +"RTN","BMXADOV1",64,0) + I IENS S DA=+IENS ; RE-ENTRY FROM SEED +"RTN","BMXADOV1",65,0) + I '$G(DA),$G(START) S DA=START-1 +"RTN","BMXADOV1",66,0) + I '$G(DA) S DA=0 +"RTN","BMXADOV1",67,0) + S LDA="" +"RTN","BMXADOV1",68,0) + F S DA=$O(@CREF@(DA)) D I $G(XIT) Q +"RTN","BMXADOV1",69,0) + . I 'DA S XIT=1,LDA="" Q ; NO MORE IENS - THE END OF THE LINE +"RTN","BMXADOV1",70,0) + . D DATA(IENS,DA,+$G(XCNT)) +"RTN","BMXADOV1",71,0) + . I $G(STOP),$O(@CREF@(DA))>STOP S LDA="",XIT=1 Q ; AS FAR AS YOU ARE ALLOWED TO GO FOR NUMBER ITERATION +"RTN","BMXADOV1",72,0) + . I NUM=MAX S LDA=DA,XIT=1 Q ; REACHED THE MAX TRANSACTION LIMIT - GET MORE NEXT TIME +"RTN","BMXADOV1",73,0) + . Q +"RTN","BMXADOV1",74,0) + I LDA,'$O(@CREF@(LDA)) S LDA="" ; END OF THE LINE SO SET LDA TO NULL +"RTN","BMXADOV1",75,0) + Q LDA +"RTN","BMXADOV1",76,0) + ; +"RTN","BMXADOV1",77,0) +LOOK(LIEN) ; EP-ITERATE BY A SINGLE STANDARD INDEX THAT IS A POINTER VALUE +"RTN","BMXADOV1",78,0) + N XIT,LDA +"RTN","BMXADOV1",79,0) + S DA=+IENS +"RTN","BMXADOV1",80,0) + F S DA=$O(@CREF@(IX,LIEN,DA)) D I $G(XIT) Q +"RTN","BMXADOV1",81,0) + . I 'DA S XIT=1,LDA="" Q ; NO MORE IENS - THE END OF THE LINE +"RTN","BMXADOV1",82,0) + . D DATA(IENS,DA,$G(XCNT)) +"RTN","BMXADOV1",83,0) + . I NUM=MAX S LDA=DA,XIT=1 Q ; REACHED THE MAX TRANSACTION LIMIT - GET MORE NEXT TIME +"RTN","BMXADOV1",84,0) + . Q +"RTN","BMXADOV1",85,0) + I '$O(@CREF@(IX,LIEN,DA)) Q "" +"RTN","BMXADOV1",86,0) + Q LDA +"RTN","BMXADOV1",87,0) + ; +"RTN","BMXADOV1",88,0) +LOOK1() ; EP-ITERATE USING A STANDARD INDEX +"RTN","BMXADOV1",89,0) + N XIT,LDA,VAL,DA,% +"RTN","BMXADOV1",90,0) + S DA=+IENS I 'DA G SCRATCH ; CHECK FOR RE-RENTRY +"RTN","BMXADOV1",91,0) +REENTER ; RE-ENTER STD ITERATION USING DA AS THE SEED +"RTN","BMXADOV1",92,0) + S %=$$IXVAL(FIEN,IX,DAS) I '$L(%) Q "" ; GET STARTUP INFO +"RTN","BMXADOV1",93,0) +LR S VAL=$P(%,B,3) +"RTN","BMXADOV1",94,0) + I VAL="" Q "" ; NO VAL FOUND FOR INITIAL ITERATION, SO QUIT +"RTN","BMXADOV1",95,0) + F S DA=$O(@CREF@(IX,VAL,DA)) Q:'DA D DATA(IENS,DA,+$G(XCNT)) I NUM=MAX S LDA=DA,XIT=1 Q ; SWEEP UP ALL THE REMAINING DAS UNDER THE CURRENT VALUE +"RTN","BMXADOV1",96,0) + I $G(XIT) Q:'$O(@CREF@(IX,VAL,LDA)) "" Q LDA ; IF NO MORE AFTER MAX, SET LDA = NULL +"RTN","BMXADOV1",97,0) + G LOOK1R ; SEED IS DEFINED +"RTN","BMXADOV1",98,0) +SCRATCH S VAL="" ; STD LOOKUP STARTING FROM SCRATCH +"RTN","BMXADOV1",99,0) + I $L(START) S VAL=$O(@CREF@(IX,START),-1) ; GET SEED FOR ITERATION +"RTN","BMXADOV1",100,0) +LOOK1R F S VAL=$O(@CREF@(IX,VAL)) D I $G(XIT) Q ; EP - RE-ENTRY POINT IF SEED IS DEFINED +"RTN","BMXADOV1",101,0) + . I VAL="" S LDA="",XIT=1 Q ; END OF THE LINE +"RTN","BMXADOV1",102,0) + . I STOP=+STOP,VAL=+VAL,VAL>STOP S LDA="",XIT=1 Q +"RTN","BMXADOV1",103,0) + . I $L(STOP),VAL]STOP S LDA="",XIT=1 Q ; LOOKUP LIMITS +"RTN","BMXADOV1",104,0) + . S DA=0 +"RTN","BMXADOV1",105,0) + . F S DA=$O(@CREF@(IX,VAL,DA)) Q:'DA D I $G(XIT) Q +"RTN","BMXADOV1",106,0) + .. D DATA(IENS,DA,+$G(XCNT)) +"RTN","BMXADOV1",107,0) + .. I NUM=MAX S LDA=DA,XIT=1 D ; TRANSACTION LIMIT ; CHECK FOR MORE +"RTN","BMXADOV1",108,0) + ... I $O(@CREF@(IX,VAL,DA)) Q +"RTN","BMXADOV1",109,0) + ... S %=$O(@CREF@(IX,VAL)) I %="" S LDA="" Q +"RTN","BMXADOV1",110,0) + ... I $L(STOP),%]STOP S LDA="" Q +"RTN","BMXADOV1",111,0) + ... I '$O(@CREF@(IX,%,0)) S LDA="" Q +"RTN","BMXADOV1",112,0) + ... Q +"RTN","BMXADOV1",113,0) + .. Q +"RTN","BMXADOV1",114,0) + . Q +"RTN","BMXADOV1",115,0) + Q LDA +"RTN","BMXADOV1",116,0) + ; +"RTN","BMXADOV1",117,0) +LOOK2(LFILE) ; EP-TEXT POINTER LOOKUP +"RTN","BMXADOV1",118,0) + ; CHANGE THE GLOBAL REFERENCE FOR THE LOOKUP TO THE POINTED-TO FILE BEFORE PROCEEDING +"RTN","BMXADOV1",119,0) + N XIT,LDA,OREF,CREF,VAL,DA +"RTN","BMXADOV1",120,0) + S OREF=$$ROOT^DILFD(LFILE,IENS) I '$L(OREF) Q "" +"RTN","BMXADOV1",121,0) + S CREF=$$CREF^DILF(OREF) I '$L(CREF) Q "" +"RTN","BMXADOV1",122,0) + S DA=+IENS +"RTN","BMXADOV1",123,0) + I '$G(DA) G SCRATCH ; START FROM SCRATCH +"RTN","BMXADOV1",124,0) + S %=$$IXVAL(LFILE,IX,DAS) I '$L(%) Q "" +"RTN","BMXADOV1",125,0) + G LR ; RE-ENTER +"RTN","BMXADOV1",126,0) + ; +"RTN","BMXADOV1",127,0) +IXVAL(FIEN,IX,DAS) ; GIVEN A FILE IEN, INDEX NAME, AND DAS STRING, RETURN THE VALUE USED IN THE INDEX +"RTN","BMXADOV1",128,0) + N DA,FLD,IENS,OREF,CREF,XREF,VAL,UP,LEV,L +"RTN","BMXADOV1",129,0) + I '$D(^DD(+$G(FIEN),0)) Q "" ; MISSING OR INVALID FILE NUMBER +"RTN","BMXADOV1",130,0) + I '$L($G(IX)) Q "" ; NO INDEX SPECIFIED +"RTN","BMXADOV1",131,0) + S UP=FIEN F LEV=1:1 S UP=$G(^DD(UP,0,"UP")) Q:'UP +"RTN","BMXADOV1",132,0) + I LEV'=$L(DAS,C) Q "" ; DAS LEVELS MUST MATCH FILE OR SUBFILE LEVEL +"RTN","BMXADOV1",133,0) + S IENS=$$IENS^BMXADOV($G(DAS)) I IENS=U Q "" +"RTN","BMXADOV1",134,0) + S OREF=$$ROOT^DILFD(FIEN,IENS) I '$L(OREF) Q "" +"RTN","BMXADOV1",135,0) + S CREF=$$CREF^DILF(OREF) I '$L(CREF) Q "" +"RTN","BMXADOV1",136,0) + I '$D(@CREF@(IX)) Q CREF_"||" ; NO INDEX VALUES TO CHECK +"RTN","BMXADOV1",137,0) + S XREF=OREF_IX_")" +"RTN","BMXADOV1",138,0) + S DA=+IENS I 'DA Q CREF_"||" +"RTN","BMXADOV1",139,0) + I '$D(@CREF@(DA)) Q CREF_"||" ; NO ENTRY EXISTS +"RTN","BMXADOV1",140,0) + I IX="AA" Q $$AA ; SMH v. 2.21 +"RTN","BMXADOV1",141,0) + S FLD=+$$IXFLD^BMXADOV(FIEN,IX) I 'FLD Q "" ; INVALID DD +"RTN","BMXADOV1",142,0) + S VAL=$$GET1^DIQ(FIEN,IENS,FLD,"I") I VAL="" Q "" ; VALUE IS NULL - NOTHING TO INDEX +"RTN","BMXADOV1",143,0) + I '$D(@CREF@(IX,VAL,DA)) Q "" ; INVALID INDEX +"RTN","BMXADOV1",144,0) + Q XREF_B_DA_B_VAL +"RTN","BMXADOV1",145,0) + ; +"RTN","BMXADOV1",146,0) +AA() ;EP - VISIT/V-FILE ITERATION USING THE 'AA' INDEX +"RTN","BMXADOV1",147,0) + N LDA,XIT,AAINFO,DA,%,X,Y,DFN,TYPE,ORD,ISTART,ISTOP,IDT,AAREF,%DT,DIC +"RTN","BMXADOV1",148,0) + S X=OREF_"""AA"")",%=$Q(@X) I %="" Q "" +"RTN","BMXADOV1",149,0) + S TYPE="" I $L(%,C)=5 S TYPE=$P(PARAM,B,2) I TYPE="" Q "" ; FOR CERTAIN V FILES, TYPE MUST BE DEFINED +"RTN","BMXADOV1",150,0) + I $E(TYPE)="`" S TYPE=$E(TYPE,2,99) I 'TYPE Q "" ; REMOVE ` FROM TYPE IEN +"RTN","BMXADOV1",151,0) + I $L(TYPE),'TYPE D I TYPE'>0 Q "" ; QUIT IF INVALID TYPE +"RTN","BMXADOV1",152,0) + . S %=$P($G(^DD(FIEN,.01,0)),U,2) +"RTN","BMXADOV1",153,0) + . S DIC=+$P(%,"P",2) I '$D(^DD(DIC,.01,0)) Q +"RTN","BMXADOV1",154,0) + . S X=TYPE,DIC(0)="M" D ^DIC I Y=-1 Q +"RTN","BMXADOV1",155,0) + . S TYPE=+Y +"RTN","BMXADOV1",156,0) + . Q +"RTN","BMXADOV1",157,0) + S DFN=+PARAM +"RTN","BMXADOV1",158,0) + I '$D(^DPT(DFN,0)) Q "" ; PATIENT DFN MUST BE DEFINED +"RTN","BMXADOV1",159,0) + I 'TYPE S AAREF=OREF_"""AA"","_DFN_")" +"RTN","BMXADOV1",160,0) + E S AAREF=OREF_"""AA"","_DFN_","_TYPE_")" +"RTN","BMXADOV1",161,0) + I '$D(@AAREF) Q "" ; IF NOTHING UNDER AA INDEX, DON'T BOTHER LOOKING +"RTN","BMXADOV1",162,0) + S ISTART=9999999 I START S X=START,%DT="P" D ^%DT S ISTART=9999999-Y +"RTN","BMXADOV1",163,0) + S ISTOP=0 I STOP S X=STOP,%DT="P" D ^%DT S ISTOP=9999999-Y +"RTN","BMXADOV1",164,0) + S ORD=-1 I $P(PARAM,B,$L(PARAM,B))="R" S ORD=1 ; SORT IN CHRONOLOGICAL OR REVERSE CHRONOLOGICAL ORDER +"RTN","BMXADOV1",165,0) + I ORD=-1 S X=$G(ISTART),Y=$G(ISTOP),ISTOP=X,ISTART=Y ; CHANGES REQUIRED TO PRESENT DATA IN CHRONOLIGICAL ORDER +"RTN","BMXADOV1",166,0) + S IDT=0,LDA="" +"RTN","BMXADOV1",167,0) + I ISTOP S IDT=ISTOP-.0000001 +"RTN","BMXADOV1",168,0) + S DA=+IENS +"RTN","BMXADOV1",169,0) + I DA S IDT=$$AAR I 'IDT Q LDA ; SWEEP UP REMAINING IENS FOR CURRENT IDT AND RESET IDT FOR RE-ENTRY +"RTN","BMXADOV1",170,0) + F S IDT=$O(@AAREF@(IDT),ORD) Q:'IDT D I $G(XIT) Q +"RTN","BMXADOV1",171,0) + . I ORD=1,IDT>ISTART S LDA="",XIT=1 Q +"RTN","BMXADOV1",172,0) + . I ORD=-1,IDTDATE S DATE=+X,MAX=DA +"RTN","BMXADOV2",16,0) + . Q +"RTN","BMXADOV2",17,0) + I 'MAX Q "" +"RTN","BMXADOV2",18,0) + S DA=MAX +"RTN","BMXADOV2",19,0) + D DATA^BMXADOV1(IENS,DA) +"RTN","BMXADOV2",20,0) + Q "" +"RTN","BMXADOV2",21,0) + ; +"RTN","BMXADOV2",22,0) +MCDIEN(DFN) ; EP-GIVEN A PATIENT IEN, RETRUN THE IEN OF THAT PT'S MOST RECENT RECORD IN MEDICAID ELIGIBILITY FILE +"RTN","BMXADOV2",23,0) + N MIEN,DA,DATE,MAX,X +"RTN","BMXADOV2",24,0) + S DFN=+$G(DFN),MAX="",DATE=0 +"RTN","BMXADOV2",25,0) + S MIEN=0 F S MIEN=$O(^AUPNMCD("B",DFN,MIEN)) Q:'MIEN D +"RTN","BMXADOV2",26,0) + . S DA=0 F S DA=$O(^AUPNMCD(MIEN,11,DA)) Q:'DA D +"RTN","BMXADOV2",27,0) + .. S X=+$P($G(^AUPNMCD(MIEN,11,DA,0)),U,2) +"RTN","BMXADOV2",28,0) + .. I X>DATE S DATE=X,MAX=MIEN +"RTN","BMXADOV2",29,0) + .. Q +"RTN","BMXADOV2",30,0) + . Q +"RTN","BMXADOV2",31,0) + Q MAX +"RTN","BMXADOV2",32,0) + ; +"RTN","BMXADOV2",33,0) +MEDICAID(PARAM,IENS,MAX,OUT,TOT) ; +"RTN","BMXADOV2",34,0) + ; NO PARAM REQUIRED BUT SINCE THIS IS A SUBFILE, THE PATIENT IEN MUST BE IH IENS +"RTN","BMXADOV2",35,0) + ; FETCHES THE MOST RECENT MEDICARE RECORD FOR THE PATIENT +"RTN","BMXADOV2",36,0) + N MIEN,DA,X,Y,%,LIM,DATE,MAX +"RTN","BMXADOV2",37,0) + S LIM=DT-10000,DA=0,DATE=0,MAX=0 +"RTN","BMXADOV2",38,0) + S MIEN=$P(IENS,C,2) I 'MIEN Q "" +"RTN","BMXADOV2",39,0) + F S DA=$O(^AUPNMCD(MIEN,11,DA)) Q:'DA D +"RTN","BMXADOV2",40,0) + . S X=$G(^AUPNMCD(MIEN,11,DA,0)) +"RTN","BMXADOV2",41,0) + . I +X>DATE S DATE=+X,MAX=DA +"RTN","BMXADOV2",42,0) + . Q +"RTN","BMXADOV2",43,0) + I 'MAX Q "" +"RTN","BMXADOV2",44,0) + S DA=MAX +"RTN","BMXADOV2",45,0) + D DATA^BMXADOV1(IENS,DA) +"RTN","BMXADOV2",46,0) + Q "" +"RTN","BMXADOV2",47,0) + ; +"RTN","BMXADOV2",48,0) +PT(VAL,IENS,MAX,OUT,TOT) ; EP - PATIENT LOOKUP ; GIVEN A LOOKUP VALUE, GENERATE A LIST OF PATIENTS +"RTN","BMXADOV2",49,0) + N DFN,BMXNOID,DA,X,Y,%,LIM,FILE,NUM,IXS,GBL,CNT,SS +"RTN","BMXADOV2",50,0) + I $G(VAL)="" Q "" +"RTN","BMXADOV2",51,0) + S BMXNOID=1 +"RTN","BMXADOV2",52,0) + I '$G(MAX) S MAX=999 +"RTN","BMXADOV2",53,0) + I $G(^DD("2","0","ID","IHS0"))="D ^AUPNLKID" S ^("IHS0")="D:'$G(BMXNOID) ^AUPNLKID" ; MUST BE A SILENT CALL +"RTN","BMXADOV2",54,0) + S SS="BMX DFN2",GBL=$NA(^TMP(SS,$J)) K @GBL +"RTN","BMXADOV2",55,0) + S CNT=0,DFN=0 +"RTN","BMXADOV2",56,0) + F S DFN=$O(^AUPNPAT("D",VAL,DFN)) Q:'DFN S CNT=CNT+1 S @GBL@("DILIST",2,CNT)=DFN ; FIRST, TRY TO MATCH CHART NUMBER +"RTN","BMXADOV2",57,0) + I CNT G PTIT +"RTN","BMXADOV2",58,0) + I VAL?3N1"-"2N1"-"4N S VAL=$TR(VAL,"-","") ; TRANSFORM SSN +"RTN","BMXADOV2",59,0) + I VAL?9N G PT1 +"RTN","BMXADOV2",60,0) + S %=$L(VAL),X=$E(VAL,%-1,%) +"RTN","BMXADOV2",61,0) + I X?2N S X=VAL,%DT="P" D ^%DT S VAL=Y ; TRANSFORM DATE TO INTERNAL VALUE +"RTN","BMXADOV2",62,0) +PT1 K @GBL S SS="BMX DFN1",GBL=$NA(^TMP(SS,$J)) K @GBL +"RTN","BMXADOV2",63,0) + D FIND^DIC(2,"","","",VAL,999,"B^ADOB^SSN","","",GBL,"") +"RTN","BMXADOV2",64,0) + I '$D(^TMP(SS,$J,"DILIST",2)) Q "" ; UNSUCCESSFUL LOOKUP +"RTN","BMXADOV2",65,0) +PTIT ; ITERATE +"RTN","BMXADOV2",66,0) + S CNT=0,NUM=0 +"RTN","BMXADOV2",67,0) + F S CNT=$O(^TMP(SS,$J,"DILIST",2,CNT)) Q:'CNT S DA=^(CNT) I DA D DATA^BMXADOV1(IENS,DA) +"RTN","BMXADOV2",68,0) + I $G(^DD("2","0","ID","IHS0"))="D:'$G(BMXNOID) ^AUPNLKID" S ^("IHS0")="D ^AUPNLKID" ; RESTORE DD NODE +"RTN","BMXADOV2",69,0) + ; K @GBL ; CLEANUP +"RTN","BMXADOV2",70,0) + Q "" +"RTN","BMXADOV2",71,0) + ; +"RTN","BMXADOV2",72,0) +HRN(DFN) ; EP - GIVEN A PATIENT DFN, RETURN THE LOCAL CHART NUMBER +"RTN","BMXADOV2",73,0) + Q $P($G(^AUPNPAT(+$G(DFN),41,+$G(DUZ(2)),0)),U,2) +"RTN","BMXADOV2",74,0) + ; +"RTN","BMXADOV2",75,0) +PVTINS ; +"RTN","BMXADOV2",76,0) + ; NO PARAM REQUIRED BUT SINCE THIS IS A SUBFILE, THE PATIENT IEN MUST BE IH IENS +"RTN","BMXADOV2",77,0) + N DFN,DA,X,Y,%,LIM +"RTN","BMXADOV2",78,0) + S LIM=DT-10000,DA=0 +"RTN","BMXADOV2",79,0) + S DFN=$P(IENS,C,2) I 'DFN Q "" +"RTN","BMXADOV2",80,0) + F S DA=$O(^AUPNPRVT(DFN,11,DA)) Q:'DA D +"RTN","BMXADOV2",81,0) + . S X=$G(^AUPNPRVT(DFN,11,DA,0)) +"RTN","BMXADOV2",82,0) + . I '$L(X) Q +"RTN","BMXADOV2",83,0) + . S %=$P(X,U,7) +"RTN","BMXADOV2",84,0) + . I '%!(%>LIM) D DATA^BMXADOV1(IENS,DA) +"RTN","BMXADOV2",85,0) + . Q +"RTN","BMXADOV2",86,0) + Q "" +"RTN","BMXADOV2",87,0) + ; +"RTN","BMXADOV2",88,0) +DUPV(PARAM,IENS,MAX,OUT,TOT) ; EP - DUPLICATE VISIT ITERATION +"RTN","BMXADOV2",89,0) + ; PARAM: 'DFN|VISIT TIMESTAMP|TYPE|LOCATION|CATEGORY +"RTN","BMXADOV2",90,0) + ; PATIENT DFN AND VISIT TIMESTAMP (EXTERNAL DATE FORMAT) MUST EXIST. +"RTN","BMXADOV2",91,0) + ; THE OTHER 3 DUP PARAMETERS WILL BE CHECKED ONLY IF THEY ARE DEFINED. +"RTN","BMXADOV2",92,0) + ; ALL DUPS ARE RETURNED. MAX,START,STOP ARE IGNORED +"RTN","BMXADOV2",93,0) + N DFN,TIME,TYPE,LOC,CAT,IDT,VIEN,DAY,X,PATIENT,Y,%DT,FMTIME,DA,IENS +"RTN","BMXADOV2",94,0) + S DFN=+PARAM,TIME=$P(PARAM,B,2),TYPE=$P(PARAM,B,3),LOC=$P(PARAM,B,4),CAT=$P(PARAM,B,5) +"RTN","BMXADOV2",95,0) + I $D(^DPT(+$G(DFN),0)),$L($G(TIME)) +"RTN","BMXADOV2",96,0) + E Q "" +"RTN","BMXADOV2",97,0) + S X=TIME,%DT="T" D ^%DT I Y=-1 Q +"RTN","BMXADOV2",98,0) + S FMTIME=Y +"RTN","BMXADOV2",99,0) + S (IDT,DAY)=9999999-(FMTIME\1),IDT=IDT-.0000001 +"RTN","BMXADOV2",100,0) + F S IDT=$O(^AUPNVSIT("AA",DFN,IDT)) Q:$E(IDT,1,7)'=DAY S VIEN=999999999999 F S VIEN=$O(^AUPNVSIT("AA",DFN,IDT,VIEN),-1) Q:'VIEN D +"RTN","BMXADOV2",101,0) + . S X=$G(^AUPNVSIT(VIEN,0)) I '$L(X) Q ; VISIT DATA MUST EXIT +"RTN","BMXADOV2",102,0) + . I $P(X,U,11) Q ; MUST BE AN 'ACTIVE' VISIT - NOT 'DELETED' +"RTN","BMXADOV2",103,0) + . I $L(TYPE),TYPE'=$P(X,U,3) Q +"RTN","BMXADOV2",104,0) + . I $L(LOC),LOC'=$P(X,U,6) Q +"RTN","BMXADOV2",105,0) + . I $L(CAT),CAT'=$P(X,U,7) Q +"RTN","BMXADOV2",106,0) + . S DA=VIEN,IENS=DA_C +"RTN","BMXADOV2",107,0) + . D DATA^BMXADOV1(IENS,DA) +"RTN","BMXADOV2",108,0) + . Q +"RTN","BMXADOV2",109,0) + Q "" +"RTN","BMXADOV2",110,0) + ; +"RTN","BMXADOV2",111,0) +DAIT(DSTG,IENS,MAX,OUT,TOT) ; EP - SET OF IENS ITERATION. +"RTN","BMXADOV2",112,0) + ; THE DSTG CONTAINS A "|" SET OF DAS STRINGS +"RTN","BMXADOV2",113,0) + ; ALL VALUES ARE RETURNED. MAX IS NOT CHECKED. START AND STOP ARE IRRELEVANT +"RTN","BMXADOV2",114,0) + N PCE,DA,XIT,IENS,L,DAS +"RTN","BMXADOV2",115,0) + S L=$L(DSTG,B) +"RTN","BMXADOV2",116,0) + F PCE=1:1:L S DAS=$P(DSTG,B,PCE) D I $G(XIT) Q +"RTN","BMXADOV2",117,0) + . I 'DAS S XIT=1 Q ; NO MORE IENS - THE END OF THE LINE +"RTN","BMXADOV2",118,0) + . I DAS'[C S IENS=DAS_C +"RTN","BMXADOV2",119,0) + . E S IENS=$$IENS^BMXADOV(DAS) +"RTN","BMXADOV2",120,0) + . S DA=+IENS +"RTN","BMXADOV2",121,0) + . D DATA^BMXADOV1(IENS,DA) +"RTN","BMXADOV2",122,0) + . Q +"RTN","BMXADOV2",123,0) + Q "" +"RTN","BMXADOV2",124,0) + ; +"RTN","BMXADOV2",125,0) +APRV(PARAM,IENS,MAX,OUT,TOT) ; EP - RETURN A LIST OF ALL ACTIVE PROVIDERS +"RTN","BMXADOV2",126,0) + ; ALL VALUES ARE RETURNED. MAX IS NOT CHECKED. START AND STOP ARE IRRELEVANT +"RTN","BMXADOV2",127,0) + N NAME,DA,STG +"RTN","BMXADOV2",128,0) + S NAME="" +"RTN","BMXADOV2",129,0) + F S NAME=$O(^VA(200,"B",NAME)) Q:NAME="" D +"RTN","BMXADOV2",130,0) + . S DA=0 +"RTN","BMXADOV2",131,0) + . F S DA=$O(^VA(200,"B",NAME,DA)) Q:'DA D +"RTN","BMXADOV2",132,0) + .. I $P($G(^VA(200,DA,"PS")),U,4) Q ; CHECK INACTIVE DATE FIELD +"RTN","BMXADOV2",133,0) + .. D DATA^BMXADOV1(IENS,DA) +"RTN","BMXADOV2",134,0) + .. Q +"RTN","BMXADOV2",135,0) + . Q +"RTN","BMXADOV2",136,0) + Q "" +"RTN","BMXADOV2",137,0) + ; +"RTN","BMXADOVJ") +0^73^B8677686 +"RTN","BMXADOVJ",1,0) +BMXADOVJ ; IHS/CIHA/GIS - RPC CALL: GENERATE DATA FOR AN ADO DATASET ; +"RTN","BMXADOVJ",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXADOVJ",3,0) + ; THIS ROUTINE MANAGES THE JOINS +"RTN","BMXADOVJ",4,0) + ; +"RTN","BMXADOVJ",5,0) + ; +"RTN","BMXADOVJ",6,0) + ; +"RTN","BMXADOVJ",7,0) + ; THE FIFTH PARAMETER OF SS^BMXADO CONTAINS THE JOIN INSTRUCTIONS +"RTN","BMXADOVJ",8,0) + ; SYNTAX: DESCENDANT SCHEMA IEN (DETAILS FILE), JOIN FIELD FROM MASTER FILE +"RTN","BMXADOVJ",9,0) + ; THE FIRST "," PIECE STATES THAT THE MASTER FILE IS JOINED BY ITS .02 FIELD TO THE DETAILS FILE +"RTN","BMXADOVJ",10,0) + ; THE SECOND "," PIECE STARTES THAT THE DETAILS FILE IS DEFINED BY SCHEMA #6 +"RTN","BMXADOVJ",11,0) + ; AN OPTIONAL 3RD "," PIECE MAY CONTAIN A SECONDARY VSTG TO MORE PRECISELY DEFINE JOIN ITERATION +"RTN","BMXADOVJ",12,0) + ; E.G., "...~6.,.02,AA~1/1/2004~2/1/2004~~~~~|WT|R" +"RTN","BMXADOVJ",13,0) + ; IN THIS CASE, THE SECONDARY VSTG SPECIFIES THAT THE AA INDEX BE USED TO CONTROL THE ITERATOR +"RTN","BMXADOVJ",14,0) + ; THE START AND STOP DATES ARE IN EFFECT BUT MAX IS IGNORED/IRRELEVANT +"RTN","BMXADOVJ",15,0) + ; THE 1ST "|" PIECE OF THE PARAM SECTION WILL BE AUTOMATICALLY STUFFED WITH PATEINT DFN(S) DURING ITERATION +"RTN","BMXADOVJ",16,0) + ; IF MULTIPLE JOINS ARE REQUESTED, THEY ARE SPARATED BY THE '@JOIN@' DELIMTER +"RTN","BMXADOVJ",17,0) + ; "E.G., 6,.02@JOIN@1,.03@JOIN@2,.02@JOIN@9,SUB" +"RTN","BMXADOVJ",18,0) + ; IN THIS EXAPLE THE MASTER FILE IS JOIND TO THE DETAILS FILES ASSOCIATED WITH SCHEMAS 6, 1, AND 9 +"RTN","BMXADOVJ",19,0) + ; NOTE THAT THE 3RD JOIN DEINED IN THE STRING SPECIFIES A SUBFILE REALTION RATHER THAN A "POINTER" RELATION +"RTN","BMXADOVJ",20,0) + ; IF A SECOND RECORD SET IS CREATED TO FULFILL A JOIN REQUEST, IT WILL ONLY CONTAIN THE ROWS NECESSARY TO COMPLETE THE JOIN +"RTN","BMXADOVJ",21,0) + ; +"RTN","BMXADOVJ",22,0) +JOIN(SMASTER,JSTG) ;EP - APPEND ADDITIONAL ANRS TO FULFILL JOIN REQUESTS +"RTN","BMXADOVJ",23,0) + N TMP,JOIN,JINST,FMASTER +"RTN","BMXADOVJ",24,0) + I '$L($G(JSTG)) Q ; JOIN STRING MUST NOT BE NULL +"RTN","BMXADOVJ",25,0) + S FMASTER=$P($G(^BMXADO(+$G(SMASTER),0)),U,2) I 'FMASTER Q ; MASTER SCHEMA & FILE MUST EXIST +"RTN","BMXADOVJ",26,0) + S TMP=$NA(^TMP("BMX JOIN",$J)) K @TMP ; JOIN INFO TEMP STORAGE ARRAY +"RTN","BMXADOVJ",27,0) + S @TMP@(0,SMASTER)=$$RANGE ; GET DATA NODE RANGE FOR THE MASTER ANR +"RTN","BMXADOVJ",28,0) + I '$D(@TMP@(0)) Q ; DATA MUST EXIST IN THE MASTER FILE OR QUIT +"RTN","BMXADOVJ",29,0) + F JOIN=1:1 S JINST=$P(JSTG,"@JOIN@",JOIN) Q:JINST="" D J(SMASTER,JINST) ; MAIN LOOP FOR DOING JOINS +"RTN","BMXADOVJ",30,0) + K @TMP +"RTN","BMXADOVJ",31,0) + Q +"RTN","BMXADOVJ",32,0) + ; +"RTN","BMXADOVJ",33,0) +RANGE() ; GET DATA NODE RANGE FOR LAST SCHEMA ENTERED +"RTN","BMXADOVJ",34,0) + N X,FIRST,LAST,Y +"RTN","BMXADOVJ",35,0) + S (X,LAST)=$O(@OUT@(999999999),-1) +"RTN","BMXADOVJ",36,0) + F S X=$O(@OUT@(X),-1) Q:'X S Y=@OUT@(X) Q:Y'[$C(30) S FIRST=X +"RTN","BMXADOVJ",37,0) + I '$G(FIRST) Q "" +"RTN","BMXADOVJ",38,0) + S FIRST=FIRST+1 +"RTN","BMXADOVJ",39,0) + Q (FIRST_U_LAST) +"RTN","BMXADOVJ",40,0) + ; +"RTN","BMXADOVJ",41,0) +J(SMASTER,JSTG) ; JOIN DETAILS FILE TO MASTER FILE +"RTN","BMXADOVJ",42,0) + ; SMASTER=MASTER SCHMA IEN, SDETAIL=DETAILS SCHEMA IEN +"RTN","BMXADOVJ",43,0) + N JARR,SEC,ERR,JIEN,SUB,IX,PARENT,JFLD,DFLD,NODE,X,STOP,VSTG2,SDETAIL,JFLD +"RTN","BMXADOVJ",44,0) + S SDETAIL=$P(JSTG,C),JFLD=$P(JSTG,C,2),DFLD=$P(JSTG,C,3),VSTG2=$P(JSTG,C,4,999) +"RTN","BMXADOVJ",45,0) + I JFLD="SUB" S JFLD=.001,DFLD=.0001 +"RTN","BMXADOVJ",46,0) + I JFLD=.001,DFLD=.0001 S SUB=1,VSTG2="~~~~~SIT~BMXADOVJ~" ; MAKE SUBFILE ITERATOR VSTG +"RTN","BMXADOVJ",47,0) + D IEN(SMASTER,SDETAIL,JFLD) ; GET A LIST OF JOIN IENS FROM THE MASTER FILE +"RTN","BMXADOVJ",48,0) + I '$D(@TMP@(1)) Q ; NO MASTER FILE IENS FOR JOINS, SO QUIT +"RTN","BMXADOVJ",49,0) + N FIEN,DAS,SIEN,VSTG,JSTG +"RTN","BMXADOVJ",50,0) + S DAS="",SIEN=SDETAIL,VSTG=VSTG2 +"RTN","BMXADOVJ",51,0) + S FIEN=$P($G(^BMXADO(SIEN,0)),U,2) I 'FIEN Q +"RTN","BMXADOVJ",52,0) + D JEP^BMXADO ; BUILD THE JOIN ANR +"RTN","BMXADOVJ",53,0) + Q +"RTN","BMXADOVJ",54,0) + ; +"RTN","BMXADOVJ",55,0) +IEN(SMASTER,SDETAIL,JFLD) ; GET THE MASTER FILE IENS FOR BUILDING THE JOIN DATA SET +"RTN","BMXADOVJ",56,0) + N FIEN,%,FIRST,LAST,NODE,DA,IEN +"RTN","BMXADOVJ",57,0) + I JFLD["IEN" S JFLD=+JFLD +"RTN","BMXADOVJ",58,0) + S FIEN=$P($G(^BMXADO(SMASTER,0)),U,2) I 'FIEN Q +"RTN","BMXADOVJ",59,0) + S %=$G(@TMP@(0,SMASTER)) I '$L(%) Q +"RTN","BMXADOVJ",60,0) + S FIRST=+%,LAST=$P(%,U,2),NODE=FIRST-.1 +"RTN","BMXADOVJ",61,0) + F S NODE=$O(@OUT@(NODE)) Q:'NODE Q:NODE>LAST D +"RTN","BMXADOVJ",62,0) + . S DA=+@OUT@(NODE) +"RTN","BMXADOVJ",63,0) + . I 'DA Q +"RTN","BMXADOVJ",64,0) + . I JFLD=.001 S @TMP@(1,SDETAIL,DA)="" Q +"RTN","BMXADOVJ",65,0) + . S IEN=$$GET1^DIQ(FIEN,(DA_C),JFLD,"I") I 'IEN Q +"RTN","BMXADOVJ",66,0) + . S @TMP@(1,SDETAIL,IEN)="" +"RTN","BMXADOVJ",67,0) + . Q +"RTN","BMXADOVJ",68,0) + Q +"RTN","BMXADOVJ",69,0) + ; +"RTN","BMXADOVJ",70,0) +JFLD ; EP-STUFF JOIN FIELD IDS INTO THE INTRO SEGMENT OF THE SCHEMA +"RTN","BMXADOVJ",71,0) + N NODE,% +"RTN","BMXADOVJ",72,0) + S NODE=999999999999 +"RTN","BMXADOVJ",73,0) + F S NODE=$O(@OUT@(NODE),-1) Q:'NODE I ^(NODE)["@@@meta@@@" Q +"RTN","BMXADOVJ",74,0) + I 'NODE Q +"RTN","BMXADOVJ",75,0) + S %=$P(@OUT@(NODE),U),$P(%,"|",4)=$G(JFLD),$P(%,"|",5)=$G(DFLD) +"RTN","BMXADOVJ",76,0) + S @OUT@(NODE)=%_U +"RTN","BMXADOVJ",77,0) + Q +"RTN","BMXADOVJ",78,0) + ; +"RTN","BMXADOX") +0^74^B208011638 +"RTN","BMXADOX",1,0) +BMXADOX ; IHS/CIHA/GIS - RPC CALL: GENERATE AN ADO SCHEMA STRING AND DATA SET ; +"RTN","BMXADOX",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXADOX",3,0) + ; EXMAPLES OF RPMS SCHEMAE GENERATION +"RTN","BMXADOX",4,0) + ; +"RTN","BMXADOX",5,0) + ; +"RTN","BMXADOX",6,0) +DISP(OUT) ;EP - TEMP DISPLAY +"RTN","BMXADOX",7,0) + N I,X +"RTN","BMXADOX",8,0) + S I=0 W ! +"RTN","BMXADOX",9,0) + F S I=$O(@OUT@(I)) Q:'I S X=@OUT@(I) S X=$TR(X,$C(30),"}") S X=$TR(X,$C(31),"{") W !,X +"RTN","BMXADOX",10,0) + Q +"RTN","BMXADOX",11,0) + ; +"RTN","BMXADOX",12,0) +SCHEMA(NAME) ; GIVEN SCHEMA NAME, RETURN THE IEN +"RTN","BMXADOX",13,0) + N IEN +"RTN","BMXADOX",14,0) + S IEN=$O(^BMXADO("B",NAME,0)) +"RTN","BMXADOX",15,0) + Q IEN +"RTN","BMXADOX",16,0) + ; +"RTN","BMXADOX",17,0) +NEXTNUM(DFN,LOC) ; RETURN THE NEXT PROBLEM NUMBER FOR A PATIENT +"RTN","BMXADOX",18,0) + N X,LAST,MAX,NUM +"RTN","BMXADOX",19,0) + S NUM=0,MAX="" +"RTN","BMXADOX",20,0) + F S NUM=$O(^AUPNPROB("AA",DFN,LOC,NUM)) Q:NUM="" S X=$E(NUM,2,99) I +X>MAX S MAX=+X +"RTN","BMXADOX",21,0) + I 'MAX Q 1 +"RTN","BMXADOX",22,0) + S X=X+1 S X=X\1 +"RTN","BMXADOX",23,0) + Q X +"RTN","BMXADOX",24,0) + ; +"RTN","BMXADOX",25,0) +DEMOG ; VIEW DEMOGRAPHICS +"RTN","BMXADOX",26,0) + N OUT,%,DFN,MAX,SIEN +"RTN","BMXADOX",27,0) + S DFN=1,MAX=1000 +"RTN","BMXADOX",28,0) + S SIEN=$$SCHEMA("UPDATE PATIENT DEMOGRAPHICS") +"RTN","BMXADOX",29,0) + D SS^BMXADO(.OUT,SIEN,"",("~"_DFN_"~"_DFN_"~"_MAX)) +"RTN","BMXADOX",30,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",31,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",32,0) + Q +"RTN","BMXADOX",33,0) + ; +"RTN","BMXADOX",34,0) +MEDICARE ; UPDATE MEDICARE DATES/INFO +"RTN","BMXADOX",35,0) + N OUT,%,DAS,PIEN,JIEN,DFN,MAX +"RTN","BMXADOX",36,0) + S DFN=1,MAX=1000 +"RTN","BMXADOX",37,0) + S DAS=DFN_"," +"RTN","BMXADOX",38,0) + S PIEN=$$SCHEMA("UPDATE MEDICARE DATES") +"RTN","BMXADOX",39,0) + S JIEN=$$SCHEMA("UPDATE MEDICARE INFO") +"RTN","BMXADOX",40,0) + D SS^BMXADO(.OUT,PIEN,DAS,("~"_DFN_"~"_DFN_"~"_MAX_"~~"_"MEDICARE~BMXADOV2~~"_JIEN_",PARENT")) +"RTN","BMXADOX",41,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",42,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",43,0) + Q +"RTN","BMXADOX",44,0) + ; +"RTN","BMXADOX",45,0) +MEDICAID ; VIEW MEDICAID DATES/INFO +"RTN","BMXADOX",46,0) + N OUT,%,DAS,PIEN,JIEN,DFN,DA +"RTN","BMXADOX",47,0) + S DFN=3 +"RTN","BMXADOX",48,0) + S DA(1)=$$MCDIEN^BMXADOV2(DFN) I 'DA(1) Q +"RTN","BMXADOX",49,0) + S DAS=DA(1)_"," +"RTN","BMXADOX",50,0) + S PIEN=$$SCHEMA("UPDATE MEDICAID DATES") +"RTN","BMXADOX",51,0) + S JIEN=$$SCHEMA("UPDATE MEDICAID INFO") +"RTN","BMXADOX",52,0) + D SS^BMXADO(.OUT,PIEN,DAS,("~~~~~MEDICAID~BMXADOV2~~"_JIEN_",PARENT")) +"RTN","BMXADOX",53,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",54,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",55,0) + Q +"RTN","BMXADOX",56,0) + ; +"RTN","BMXADOX",57,0) +PVTINS ; VIEW PRIVATE INSURANCE DATES/INFO +"RTN","BMXADOX",58,0) + N OUT,%,DAS,SIEN,DFN +"RTN","BMXADOX",59,0) + S DFN=1 +"RTN","BMXADOX",60,0) + S DAS=DFN_"," +"RTN","BMXADOX",61,0) + S SIEN=$$SCHEMA("UPDATE PVT INSURANCE INFO") +"RTN","BMXADOX",62,0) + D SS^BMXADO(.OUT,SIEN,DAS,"~~~~~PVTINS~BMXADOV2~~") +"RTN","BMXADOX",63,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",64,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",65,0) + Q +"RTN","BMXADOX",66,0) + ; +"RTN","BMXADOX",67,0) +VISIT ; VIEW VISITS +"RTN","BMXADOX",68,0) + N OUT,%,SIEN,DFN +"RTN","BMXADOX",69,0) + S DFN=1 +"RTN","BMXADOX",70,0) + S SIEN=$$SCHEMA("VISITS") +"RTN","BMXADOX",71,0) + D SS^BMXADO(.OUT,SIEN,"","AA~3/21/1985~6/4/1986~100~~~~1|R") +"RTN","BMXADOX",72,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",73,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",74,0) + Q +"RTN","BMXADOX",75,0) + ; +"RTN","BMXADOX",76,0) +DUPVIS ; DISPLAY POSSIBLE DUPLICATE VISITS +"RTN","BMXADOX",77,0) + N OUT,%,SIEN,DFN +"RTN","BMXADOX",78,0) + S DFN=1 +"RTN","BMXADOX",79,0) + S SIEN=$$SCHEMA("VISITS") +"RTN","BMXADOX",80,0) + D SS^BMXADO(.OUT,SIEN,"","~~~~~DUPV~BMXADOV2~1|4/19/04@1PM|I|4585|A~") +"RTN","BMXADOX",81,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",82,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",83,0) + Q +"RTN","BMXADOX",84,0) + ; +"RTN","BMXADOX",85,0) +ADDVIS ; ADD A NEW VISIT +"RTN","BMXADOX",86,0) + N OUT,%,SIEN,DFN,NODE +"RTN","BMXADOX",87,0) + S DFN=3 +"RTN","BMXADOX",88,0) + S SIEN=$$SCHEMA("VISITS") +"RTN","BMXADOX",89,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOX",90,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOX",91,0) + S ^TMP("BMX ADO",$J,NODE)="^JUN 03, 2004@09:32^I^`3^`4585^A^`1"_$C(30) +"RTN","BMXADOX",92,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",93,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) +"RTN","BMXADOX",94,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",95,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) +"RTN","BMXADOX",96,0) + Q +"RTN","BMXADOX",97,0) + ; +"RTN","BMXADOX",98,0) +POV ; DISPLAY POVS +"RTN","BMXADOX",99,0) + N OUT,%,SIEN,DFN +"RTN","BMXADOX",100,0) + S DFN=1 +"RTN","BMXADOX",101,0) + S SIEN=$$SCHEMA("VIEW POVS") +"RTN","BMXADOX",102,0) + D SS^BMXADO(.OUT,SIEN,"","AA~3/21/1985~6/4/1986~100~~~~1|C") +"RTN","BMXADOX",103,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",104,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",105,0) + Q +"RTN","BMXADOX",106,0) + ; +"RTN","BMXADOX",107,0) +FLDS ; GET FILEMAN FIELDS +"RTN","BMXADOX",108,0) + N OUT,%,SIEN,DFN +"RTN","BMXADOX",109,0) + S SIEN=$$SCHEMA("FIELDS") +"RTN","BMXADOX",110,0) + D SS^BMXADO(.OUT,SIEN,"","~~~~~FLDIT~BMXADOS1~3.7~") +"RTN","BMXADOX",111,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",112,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",113,0) + Q +"RTN","BMXADOX",114,0) + ; +"RTN","BMXADOX",115,0) +FINFO ; GET FILEMAN FILEINFO +"RTN","BMXADOX",116,0) + N OUT,%,SIEN,DFN +"RTN","BMXADOX",117,0) + S SIEN=$$SCHEMA("FILEMAN FILEINFO") +"RTN","BMXADOX",118,0) + D SS^BMXADO(.OUT,SIEN,"","~~~~~FNIT~BMXADOS1~3.7~") +"RTN","BMXADOX",119,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",120,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",121,0) + Q +"RTN","BMXADOX",122,0) + ; +"RTN","BMXADOX",123,0) +ADDPOV ; ADD A POV TO AN EXISITING VISIT +"RTN","BMXADOX",124,0) + N OUT,%,SIEN,DFN,NODE +"RTN","BMXADOX",125,0) + S DFN=1 +"RTN","BMXADOX",126,0) + S SIEN=$$SCHEMA("UPDATE POVS") +"RTN","BMXADOX",127,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOX",128,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOX",129,0) + S ^TMP("BMX ADO",$J,NODE)="^`8718^`1^`71164^DM II ON NEW MEDS^2^P"_$C(30) +"RTN","BMXADOX",130,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",131,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) +"RTN","BMXADOX",132,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",133,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) +"RTN","BMXADOX",134,0) + Q +"RTN","BMXADOX",135,0) + ; +"RTN","BMXADOX",136,0) +EDITPOV ; ADD A POV TO AN EXISITING VISIT +"RTN","BMXADOX",137,0) + N OUT,%,SIEN,DFN,NODE +"RTN","BMXADOX",138,0) + S DFN=1 +"RTN","BMXADOX",139,0) + S SIEN=$$SCHEMA("UPDATE POVS") +"RTN","BMXADOX",140,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOX",141,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOX",142,0) + S ^TMP("BMX ADO",$J,NODE)="100123^`8718^`1^`71164^DM II ON SPECIAL MEDS^2^P"_$C(30) +"RTN","BMXADOX",143,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",144,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) +"RTN","BMXADOX",145,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",146,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) +"RTN","BMXADOX",147,0) + Q +"RTN","BMXADOX",148,0) + ; +"RTN","BMXADOX",149,0) +PROB ; DISPLAY PROBLEMS +"RTN","BMXADOX",150,0) + N OUT,%,SIEN,DFN +"RTN","BMXADOX",151,0) + S DFN=1 +"RTN","BMXADOX",152,0) + S SIEN=$$SCHEMA("VIEW PROBLEMS") +"RTN","BMXADOX",153,0) + D SS^BMXADO(.OUT,SIEN,"","AA~"_DFN_"~"_DFN_"~~~~~") +"RTN","BMXADOX",154,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",155,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",156,0) + Q +"RTN","BMXADOX",157,0) + ; +"RTN","BMXADOX",158,0) +ADDPROB ; ADD A PROBLEM TO THE PROBLEM LIST +"RTN","BMXADOX",159,0) + N OUT,%,SIEN,DFN,NODE,NUM,LOC,ICD,TEXT,AIR,IEN +"RTN","BMXADOX",160,0) + S ICD=2477 +"RTN","BMXADOX",161,0) + S TEXT="HYPERTENSION ON SPECIAL MEDS" +"RTN","BMXADOX",162,0) + S DFN=1,LOC=DUZ(2),AIR="A" +"RTN","BMXADOX",163,0) + S SIEN=$$SCHEMA("UPDATE PROBLEMS") +"RTN","BMXADOX",164,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOX",165,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOX",166,0) + S ^TMP("BMX ADO",$J,NODE)=U_"`"_ICD_U_"`"_DFN_U_DT_U_U_TEXT_U_"`"_LOC_U_DT_$C(30) +"RTN","BMXADOX",167,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",168,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) +"RTN","BMXADOX",169,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",170,0) + S IEN=+$P(OUT(1),"|",2) I '$D(^AUPNPROB(IEN,0)) Q +"RTN","BMXADOX",171,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) +"RTN","BMXADOX",172,0) + K OUT +"RTN","BMXADOX",173,0) + S NUM=$$NEXTNUM(DFN,LOC) I 'NUM Q ; PROBLEM NUMBER & STATUS MUST BE ADDED SEPARATELY +"RTN","BMXADOX",174,0) + S SIEN=$$SCHEMA("UPDATE PROBLEM NUMBER") +"RTN","BMXADOX",175,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOX",176,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOX",177,0) + S ^TMP("BMX ADO",$J,NODE)=IEN_U_NUM_U_"A"_$C(30) +"RTN","BMXADOX",178,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",179,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) +"RTN","BMXADOX",180,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",181,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) +"RTN","BMXADOX",182,0) + Q +"RTN","BMXADOX",183,0) + ; +"RTN","BMXADOX",184,0) +MEAS ; DISPLAY MEASUREMENTS +"RTN","BMXADOX",185,0) + N OUT,%,SIEN,DFN +"RTN","BMXADOX",186,0) + S DFN=1 +"RTN","BMXADOX",187,0) + S SIEN=$$SCHEMA("VIEW MEASUREMENTS") +"RTN","BMXADOX",188,0) + D SS^BMXADO(.OUT,SIEN,"","AA~3/21/1985~6/4/1986~10~~~~"_DFN_"|WT|C") +"RTN","BMXADOX",189,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",190,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",191,0) + Q +"RTN","BMXADOX",192,0) + ; +"RTN","BMXADOX",193,0) +ADDMEAS ; UPDATE V MEASUREMENT FILE +"RTN","BMXADOX",194,0) + N OUT,%,SIEN,DFN,NODE +"RTN","BMXADOX",195,0) + S DFN=1 +"RTN","BMXADOX",196,0) + S SIEN=$$SCHEMA("UPDATE MEASUREMENTS") +"RTN","BMXADOX",197,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOX",198,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOX",199,0) + S ^TMP("BMX ADO",$J,NODE)="^`2^`"_DFN_"^`71164^177.5^`6"_$C(30) +"RTN","BMXADOX",200,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",201,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) +"RTN","BMXADOX",202,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",203,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) +"RTN","BMXADOX",204,0) + Q +"RTN","BMXADOX",205,0) + ; +"RTN","BMXADOX",206,0) +MEDS ; DISPLAY MEDS +"RTN","BMXADOX",207,0) + N OUT,%,SIEN,DFN +"RTN","BMXADOX",208,0) + S DFN=3 +"RTN","BMXADOX",209,0) + S SIEN=$$SCHEMA("VIEW MEDS") +"RTN","BMXADOX",210,0) + D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1989~12/31/1990~10~~~~"_DFN_"|C") +"RTN","BMXADOX",211,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",212,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",213,0) + Q +"RTN","BMXADOX",214,0) + ; +"RTN","BMXADOX",215,0) +ADDMEDS ; UPDATE V MED FILE +"RTN","BMXADOX",216,0) + N OUT,%,SIEN,DFN,NODE +"RTN","BMXADOX",217,0) + S DFN=3 +"RTN","BMXADOX",218,0) + S SIEN=$$SCHEMA("UPDATE MEDS") +"RTN","BMXADOX",219,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOX",220,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOX",221,0) + S ^TMP("BMX ADO",$J,NODE)="^`305^`"_DFN_"^`71164^T1T QID^40"_$C(30) +"RTN","BMXADOX",222,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",223,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) +"RTN","BMXADOX",224,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",225,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) +"RTN","BMXADOX",226,0) + Q +"RTN","BMXADOX",227,0) + ; +"RTN","BMXADOX",228,0) +LAB ; DISPLAY LAB TEST RESULTS +"RTN","BMXADOX",229,0) + N OUT,%,SIEN,DFN +"RTN","BMXADOX",230,0) + S DFN=1 +"RTN","BMXADOX",231,0) + S SIEN=$$SCHEMA("VIEW LABS") +"RTN","BMXADOX",232,0) + D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1985~12/31/1987~10~~~~"_DFN_"|175|C") +"RTN","BMXADOX",233,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",234,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",235,0) + Q +"RTN","BMXADOX",236,0) + ; +"RTN","BMXADOX",237,0) +ADDLAB ; UPDATE V LAB +"RTN","BMXADOX",238,0) + N OUT,%,SIEN,DFN,NODE +"RTN","BMXADOX",239,0) + S DFN=1 +"RTN","BMXADOX",240,0) + S SIEN=$$SCHEMA("UPDATE LABS") +"RTN","BMXADOX",241,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOX",242,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOX",243,0) + S ^TMP("BMX ADO",$J,NODE)="^`175^`"_DFN_"^`71164^216"_$C(30) +"RTN","BMXADOX",244,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",245,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) +"RTN","BMXADOX",246,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",247,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) +"RTN","BMXADOX",248,0) + Q +"RTN","BMXADOX",249,0) + ; +"RTN","BMXADOX",250,0) +EXAMS ; DISPLAY EXAMS +"RTN","BMXADOX",251,0) + N OUT,%,SIEN,DFN +"RTN","BMXADOX",252,0) + S DFN=1 +"RTN","BMXADOX",253,0) + S SIEN=$$SCHEMA("VIEW EXAMS") +"RTN","BMXADOX",254,0) + D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1986~12/31/1990~10~~~~"_DFN_"|6|C") +"RTN","BMXADOX",255,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",256,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",257,0) + Q +"RTN","BMXADOX",258,0) + ; +"RTN","BMXADOX",259,0) +ADDEXAMS ; UPDATE V EXAM +"RTN","BMXADOX",260,0) + S DFN=1 +"RTN","BMXADOX",261,0) + S SIEN=$$SCHEMA("UPDATE EXAMS") +"RTN","BMXADOX",262,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOX",263,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOX",264,0) + S ^TMP("BMX ADO",$J,NODE)="^`6^`"_DFN_"^`71164^NORMAL"_$C(30) +"RTN","BMXADOX",265,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",266,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) +"RTN","BMXADOX",267,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",268,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) +"RTN","BMXADOX",269,0) + Q +"RTN","BMXADOX",270,0) + ; +"RTN","BMXADOX",271,0) +IMM ; DISPLAY IMMUNIZATIONS +"RTN","BMXADOX",272,0) + N OUT,%,SIEN,DFN +"RTN","BMXADOX",273,0) + S DFN=2 +"RTN","BMXADOX",274,0) + S SIEN=$$SCHEMA("VIEW IMM") +"RTN","BMXADOX",275,0) + D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1986~12/31/1988~10~~~~"_DFN_"|12|C") +"RTN","BMXADOX",276,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",277,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",278,0) + Q +"RTN","BMXADOX",279,0) + ; +"RTN","BMXADOX",280,0) +ADDIMM ; UPDATE V IMMUNIZATION FILE +"RTN","BMXADOX",281,0) + S DFN=2 +"RTN","BMXADOX",282,0) + S SIEN=$$SCHEMA("UPDATE IMM") +"RTN","BMXADOX",283,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOX",284,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOX",285,0) + S ^TMP("BMX ADO",$J,NODE)="^`12^`"_DFN_"^`71164^2"_$C(30) +"RTN","BMXADOX",286,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",287,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) +"RTN","BMXADOX",288,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",289,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) +"RTN","BMXADOX",290,0) + Q +"RTN","BMXADOX",291,0) + ; +"RTN","BMXADOX",292,0) +PROV ; DISPLAY PROVIDERS FOR A VISIT +"RTN","BMXADOX",293,0) + N OUT,%,SIEN,VIEN +"RTN","BMXADOX",294,0) + S VIEN=11 +"RTN","BMXADOX",295,0) + S SIEN=$$SCHEMA("VIEW PROV") +"RTN","BMXADOX",296,0) + D SS^BMXADO(.OUT,SIEN,"","AD~"_VIEN_"~"_VIEN_"~10~~~~") +"RTN","BMXADOX",297,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",298,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",299,0) + Q +"RTN","BMXADOX",300,0) + ; +"RTN","BMXADOX",301,0) +ADDPROV ; UPDATE V PROVIDER FILE +"RTN","BMXADOX",302,0) + N OUT,%,SIEN,NODE,PIEN,DFN +"RTN","BMXADOX",303,0) + S PIEN=5,DFN=1 +"RTN","BMXADOX",304,0) + I $P(^DD(9000010.06,.01,0),U,3)["DIC(6" S PIEN=$P(^VA(200,PIEN,0),U,16) ; CONVERT FILE 200 TO FILE 16 IF NECESS. +"RTN","BMXADOX",305,0) + S SIEN=$$SCHEMA("UPDATE PROV") +"RTN","BMXADOX",306,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOX",307,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOX",308,0) + S ^TMP("BMX ADO",$J,NODE)="^`"_PIEN_"^`"_DFN_"^`71164^P"_$C(30) +"RTN","BMXADOX",309,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",310,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) +"RTN","BMXADOX",311,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",312,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) +"RTN","BMXADOX",313,0) + Q +"RTN","BMXADOX",314,0) + ; +"RTN","BMXADOX",315,0) +PROC ; DISPLAY PROCEDURES +"RTN","BMXADOX",316,0) + N OUT,%,SIEN,DFN +"RTN","BMXADOX",317,0) + S DFN=4 +"RTN","BMXADOX",318,0) + S SIEN=$$SCHEMA("VIEW PROCEDURES") +"RTN","BMXADOX",319,0) + D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1985~12/31/1985~10~~~~"_DFN_"|C") +"RTN","BMXADOX",320,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",321,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",322,0) + Q +"RTN","BMXADOX",323,0) + ; +"RTN","BMXADOX",324,0) +ADDPROC ; UPDATE V PROCEDURES FILE +"RTN","BMXADOX",325,0) + N OUT,%,SIEN,DFN,NODE +"RTN","BMXADOX",326,0) + S DFN=1 +"RTN","BMXADOX",327,0) + S SIEN=$$SCHEMA("UPDATE PROCEDURES") +"RTN","BMXADOX",328,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOX",329,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOX",330,0) + S ^TMP("BMX ADO",$J,NODE)="^`2198^`"_DFN_"^`71164^`8718"_$C(30) +"RTN","BMXADOX",331,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",332,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) +"RTN","BMXADOX",333,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",334,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) +"RTN","BMXADOX",335,0) + Q +"RTN","BMXADOX",336,0) + ; +"RTN","BMXADOX",337,0) +CPT ; DISPLAY CPT CODES +"RTN","BMXADOX",338,0) + N OUT,%,SIEN,DFN +"RTN","BMXADOX",339,0) + S VIEN=71164 +"RTN","BMXADOX",340,0) + S SIEN=$$SCHEMA("VIEW CPT") +"RTN","BMXADOX",341,0) + D SS^BMXADO(.OUT,SIEN,"","AD~"_VIEN_"~"_VIEN_"~10~~~~") +"RTN","BMXADOX",342,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",343,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",344,0) + Q +"RTN","BMXADOX",345,0) + ; +"RTN","BMXADOX",346,0) +ADDCPT ; UPDATE V CPT FILE +"RTN","BMXADOX",347,0) + N OUT,%,SIEN,DFN,NODE +"RTN","BMXADOX",348,0) + S DFN=1 +"RTN","BMXADOX",349,0) + S SIEN=$$SCHEMA("UPDATE CPT") +"RTN","BMXADOX",350,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOX",351,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOX",352,0) + S ^TMP("BMX ADO",$J,NODE)="^`10000^`"_DFN_"^`71164^WOUND CARE"_$C(30) +"RTN","BMXADOX",353,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",354,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) +"RTN","BMXADOX",355,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",356,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) +"RTN","BMXADOX",357,0) + Q +"RTN","BMXADOX",358,0) + ; +"RTN","BMXADOX",359,0) +PH ; DISPLAY PERSONAL HISTORY +"RTN","BMXADOX",360,0) + N OUT,%,SIEN,DFN +"RTN","BMXADOX",361,0) + S DFN=632 +"RTN","BMXADOX",362,0) + S SIEN=$$SCHEMA("VIEW PERSONAL HISTORY") +"RTN","BMXADOX",363,0) + D SS^BMXADO(.OUT,SIEN,"","AC~"_DFN_"~"_DFN_"~~~~~") +"RTN","BMXADOX",364,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",365,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",366,0) + Q +"RTN","BMXADOX",367,0) + ; +"RTN","BMXADOX",368,0) +ADDPH ; UPDATE PERSONAL HX +"RTN","BMXADOX",369,0) + N OUT,%,SIEN,DFN,NODE,ICD,TEXT +"RTN","BMXADOX",370,0) + S ICD=2477 +"RTN","BMXADOX",371,0) + S TEXT="PERSONAL HISTORY OF SERIOUS PROBLEMS" +"RTN","BMXADOX",372,0) + S DFN=632 +"RTN","BMXADOX",373,0) + S SIEN=$$SCHEMA("UPDATE PERSONAL HISTORY") +"RTN","BMXADOX",374,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOX",375,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOX",376,0) + S ^TMP("BMX ADO",$J,NODE)="^`11353^`"_DFN_"^2851219^"_TEXT_"^2810303"_$C(30) +"RTN","BMXADOX",377,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",378,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) +"RTN","BMXADOX",379,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",380,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) +"RTN","BMXADOX",381,0) + Q +"RTN","BMXADOX",382,0) + ; +"RTN","BMXADOX",383,0) +FH ; DISPLAY FAMILY HX +"RTN","BMXADOX",384,0) + N OUT,%,SIEN,DFN +"RTN","BMXADOX",385,0) + S DFN=631 +"RTN","BMXADOX",386,0) + S SIEN=$$SCHEMA("VIEW FAMILY HISTORY") +"RTN","BMXADOX",387,0) + D SS^BMXADO(.OUT,SIEN,"","AC~"_DFN_"~"_DFN_"~~~~~") +"RTN","BMXADOX",388,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",389,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",390,0) + Q +"RTN","BMXADOX",391,0) + ; +"RTN","BMXADOX",392,0) +ADDFH ; UPDATE FAMILY HISTORY +"RTN","BMXADOX",393,0) + N OUT,%,SIEN,DFN,NODE,ICD,TEXT +"RTN","BMXADOX",394,0) + S ICD=2477 +"RTN","BMXADOX",395,0) + S TEXT="FAMILY HISTORY OF SERIOUS PROBLEMS" +"RTN","BMXADOX",396,0) + S DFN=631 +"RTN","BMXADOX",397,0) + S SIEN=$$SCHEMA("UPDATE FAMILY HISTORY") +"RTN","BMXADOX",398,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOX",399,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOX",400,0) + S ^TMP("BMX ADO",$J,NODE)="^`7571^`"_DFN_"^2851219^"_TEXT_$C(30) +"RTN","BMXADOX",401,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",402,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) +"RTN","BMXADOX",403,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",404,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) +"RTN","BMXADOX",405,0) + Q +"RTN","BMXADOX",406,0) + ; +"RTN","BMXADOX",407,0) +HF ; DISPLAY HEALTH FACTORS +"RTN","BMXADOX",408,0) + N OUT,%,SIEN,DFN +"RTN","BMXADOX",409,0) + S DFN=1 +"RTN","BMXADOX",410,0) + S SIEN=$$SCHEMA("VIEW HEALTH FACTORS") +"RTN","BMXADOX",411,0) + D SS^BMXADO(.OUT,SIEN,"","AC"_"~"_DFN_"~"_DFN_"~~~~~") +"RTN","BMXADOX",412,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",413,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",414,0) + Q +"RTN","BMXADOX",415,0) + ; +"RTN","BMXADOX",416,0) +ADDHF ; UPDATE HEALTH FACTORS FILE +"RTN","BMXADOX",417,0) + N OUT,%,SIEN,DFN,NODE +"RTN","BMXADOX",418,0) + S DFN=1 +"RTN","BMXADOX",419,0) + S SIEN=$$SCHEMA("UPDATE HEALTH FACTORS") +"RTN","BMXADOX",420,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOX",421,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOX",422,0) + S ^TMP("BMX ADO",$J,NODE)="^`3^`"_DFN_U_DT_$C(30) +"RTN","BMXADOX",423,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",424,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) +"RTN","BMXADOX",425,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",426,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) +"RTN","BMXADOX",427,0) + Q +"RTN","BMXADOX",428,0) + ; +"RTN","BMXADOX",429,0) +REPRO ; DISPLAY REPRODUCTIVE FACTORS +"RTN","BMXADOX",430,0) + N OUT,%,SIEN,DFN +"RTN","BMXADOX",431,0) + S DFN=5 +"RTN","BMXADOX",432,0) + S SIEN=$$SCHEMA("VIEW REPRODUCTIVE FACTORS") +"RTN","BMXADOX",433,0) + D SS^BMXADO(.OUT,SIEN,"","B"_"~"_DFN_"~"_DFN_"~~~~~") +"RTN","BMXADOX",434,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",435,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",436,0) + Q +"RTN","BMXADOX",437,0) + ; +"RTN","BMXADOX",438,0) +ADDREPRO ; UPDATE REPRODUCTIVE FACTORS +"RTN","BMXADOX",439,0) + ; THE .O1 FIELD IS DINUMED +"RTN","BMXADOX",440,0) + ; THEREFORE, THE FILER WILL AUTOMATICALLY SWITCH TO MOD MODE IF A RECORD ALREADY EXISTS FOR THIS PATIENT +"RTN","BMXADOX",441,0) + N OUT,%,SIEN,DFN,NODE +"RTN","BMXADOX",442,0) + S DFN=5 +"RTN","BMXADOX",443,0) + ; I $D(^AUPNREP(DFN)) G ERF +"RTN","BMXADOX",444,0) + S SIEN=$$SCHEMA("ADD REPRODUCTIVE FACTORS") +"RTN","BMXADOX",445,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOX",446,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOX",447,0) + S ^TMP("BMX ADO",$J,NODE)="^`"_DFN_"^G5P4LC3SA1TA0^"_DT_"^2^3040101^"_DT_$C(30) +"RTN","BMXADOX",448,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",449,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) +"RTN","BMXADOX",450,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",451,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) +"RTN","BMXADOX",452,0) + Q +"RTN","BMXADOX",453,0) + ; +"RTN","BMXADOX",454,0) + ; ---------------------------------- GRIDS --------------------------------------------- +"RTN","BMXADOX",455,0) + ; +"RTN","BMXADOX",456,0) +GRID ; POPULATE THE INTRO GRID +"RTN","BMXADOX",457,0) + N OUT,%,SIEN,NODE,NEXT +"RTN","BMXADOX",458,0) + S NEXT="70470;0" +"RTN","BMXADOX",459,0) + S SIEN=$$SCHEMA("VEN MOJO DE INTRO") +"RTN","BMXADOX",460,0) + D SS^BMXADO(.OUT,SIEN,"","ASEG~"_NEXT_"~"_NEXT) ; GET SCHEMA +"RTN","BMXADOX",461,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",462,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",463,0) + Q +"RTN","BMXADOX",464,0) + ; +"RTN","BMXADOX",465,0) +MGRID ; POPULATE THE MEASUREMENT GRID +"RTN","BMXADOX",466,0) + N OUT,%,SIEN,NODE,NEXT,START,STOP +"RTN","BMXADOX",467,0) + S NEXT="70470;2" +"RTN","BMXADOX",468,0) + S SIEN=$$SCHEMA("VEN MOJO DE MEASUREMENT") +"RTN","BMXADOX",469,0) + ; D SS^BMXADO(.OUT,SIEN,"","~~~~~GRIDIT~VENPCCTG~"_NEXT) ; GET SCHEMA +"RTN","BMXADOX",470,0) + D SS^BMXADO(.OUT,SIEN,"","ASEG~"_NEXT_"~"_NEXT) ; GET SCHEMA +"RTN","BMXADOX",471,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",472,0) + ; K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",473,0) + Q +"RTN","BMXADOX",474,0) + ; +"RTN","BMXADOX",475,0) +PRVGRID ; POPULATE THE PROVIDER GRID +"RTN","BMXADOX",476,0) + N OUT,%,SIEN,NODE,NEXT +"RTN","BMXADOX",477,0) + S NEXT="70470;4" +"RTN","BMXADOX",478,0) + S SIEN=$$SCHEMA("VEN MOJO DE PROVIDER") +"RTN","BMXADOX",479,0) + D SS^BMXADO(.OUT,SIEN,"","ASEG~"_NEXT_"~"_NEXT) ; GET SCHEMA +"RTN","BMXADOX",480,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",481,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",482,0) + Q +"RTN","BMXADOX",483,0) + ; +"RTN","BMXADOX",484,0) +CLGRID ; POPULATE THE CLINIC GRID +"RTN","BMXADOX",485,0) + N OUT,%,SIEN,NODE,NEXT +"RTN","BMXADOX",486,0) + S NEXT="70470;8" +"RTN","BMXADOX",487,0) + S SIEN=$$SCHEMA("VEN MOJO DE CLINIC") +"RTN","BMXADOX",488,0) + D SS^BMXADO(.OUT,SIEN,"","ASEG~"_NEXT_"~"_NEXT) ; GET SCHEMA +"RTN","BMXADOX",489,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",490,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",491,0) + Q +"RTN","BMXADOX",492,0) + ; +"RTN","BMXADOX",493,0) +DXGRID ; POPULATE THE DX GRID +"RTN","BMXADOX",494,0) + N OUT,%,SIEN,NODE,NEXT +"RTN","BMXADOX",495,0) + S NEXT="70470;1" +"RTN","BMXADOX",496,0) + S SIEN=$$SCHEMA("VEN MOJO DE DX DXHX") +"RTN","BMXADOX",497,0) + D SS^BMXADO(.OUT,SIEN,"","ASEG~"_NEXT_"~"_NEXT) ; GET SCHEMA +"RTN","BMXADOX",498,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX",499,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX",500,0) + Q +"RTN","BMXADOX",501,0) + ; +"RTN","BMXADOX1") +0^75^B84889528 +"RTN","BMXADOX1",1,0) +BMXADOX1 ; IHS/CIHA/GIS - RPC CALL: GENERATE AN ADO SCHEMA STRING AND DATA SET ; +"RTN","BMXADOX1",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXADOX1",3,0) + ; EXMAPLES OF FILEMAN SCHEMA GENERATION +"RTN","BMXADOX1",4,0) + ; +"RTN","BMXADOX1",5,0) + ; +"RTN","BMXADOX1",6,0) + ; N OUT,DAX,% S DAX=0 D SS^BMXADO(.OUT,1,DAX,"^^^5^I^^^^3,XSUB,2160010.03") D DISP(OUT) Q ; TEST EXTENDED SUBJOIN +"RTN","BMXADOX1",7,0) + ; +"RTN","BMXADOX1",8,0) +DISP(OUT) ; +"RTN","BMXADOX1",9,0) + D DISP^BMXADOX(OUT) +"RTN","BMXADOX1",10,0) + Q +"RTN","BMXADOX1",11,0) + ; +"RTN","BMXADOX1",12,0) +SCHEMA(NAME) ; GIVEN SCHEMA NAME, RETURN THE IEN +"RTN","BMXADOX1",13,0) + N IEN +"RTN","BMXADOX1",14,0) + S IEN=$O(^BMXADO("B",NAME,0)) +"RTN","BMXADOX1",15,0) + Q IEN +"RTN","BMXADOX1",16,0) + ; +"RTN","BMXADOX1",17,0) +NUM ; ITERATE BY IEN +"RTN","BMXADOX1",18,0) + ; IX="",START WITH IEN=1, STOP AFTER IEN=20, MAX # RECORDS RETURNED = 5 +"RTN","BMXADOX1",19,0) + ; TO VIEW INTERNAL VALUES SET VSTG="~1~20~5~I" +"RTN","BMXADOX1",20,0) + N OUT,%,SIEN +"RTN","BMXADOX1",21,0) + S SIEN=$$SCHEMA("IHS PATIENT") +"RTN","BMXADOX1",22,0) + D SS^BMXADO(.OUT,SIEN,"","~1~20~5") +"RTN","BMXADOX1",23,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX1",24,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX1",25,0) + Q +"RTN","BMXADOX1",26,0) + ; +"RTN","BMXADOX1",27,0) +IX ; ITERATE BY INDEX +"RTN","BMXADOX1",28,0) + ; ITERATE USING THE "B" INDEX +"RTN","BMXADOX1",29,0) + ; START WITH PT NAME "C", STOP AFTER PATIENT NAME = "D", MAX # RECORDS RETURNED = 5 +"RTN","BMXADOX1",30,0) + N OUT,%,SIEN +"RTN","BMXADOX1",31,0) + S SIEN=$$SCHEMA("IHS PATIENT") +"RTN","BMXADOX1",32,0) + D SS^BMXADO(.OUT,SIEN,"","B~C~D~5") +"RTN","BMXADOX1",33,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX1",34,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX1",35,0) + Q +"RTN","BMXADOX1",36,0) + ; +"RTN","BMXADOX1",37,0) +VCN ; SHOW VALUES FOR A SINGLE VISIT THAT AS A DEFINED VCN +"RTN","BMXADOX1",38,0) + N OUT,%,SIEN +"RTN","BMXADOX1",39,0) + S SIEN=$$SCHEMA("BMXADO DATA ENTRY IDENTIFIERS") +"RTN","BMXADOX1",40,0) + D SS^BMXADO(.OUT,SIEN,"","VCN~1.242A~1.242A~") +"RTN","BMXADOX1",41,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX1",42,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX1",43,0) + Q +"RTN","BMXADOX1",44,0) + ; +"RTN","BMXADOX1",45,0) +MT ; MEASUREMNT TYPES +"RTN","BMXADOX1",46,0) + N OUT,%,SIEN +"RTN","BMXADOX1",47,0) + S SIEN=$$SCHEMA("BMXADO MEASUREMENT TYPES") +"RTN","BMXADOX1",48,0) + D SS^BMXADO(.OUT,SIEN,"","B~~") +"RTN","BMXADOX1",49,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX1",50,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX1",51,0) + Q +"RTN","BMXADOX1",52,0) + ; +"RTN","BMXADOX1",53,0) +PROB ; PATIENT PROBLEMS +"RTN","BMXADOX1",54,0) + N OUT,%,SIEN +"RTN","BMXADOX1",55,0) + S SIEN=$$SCHEMA("BMXADO PROBLEMS") +"RTN","BMXADOX1",56,0) + D SS^BMXADO(.OUT,SIEN,"","AA~53~53") +"RTN","BMXADOX1",57,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX1",58,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX1",59,0) + Q +"RTN","BMXADOX1",60,0) + ; +"RTN","BMXADOX1",61,0) +PB1 ; ALT PROB RETRIEVAL TEST +"RTN","BMXADOX1",62,0) + N OUT,%,SIEN +"RTN","BMXADOX1",63,0) + S SIEN=$$SCHEMA("BMXADO PROBLEMS") +"RTN","BMXADOX1",64,0) + D SS^BMXADO(.OUT,SIEN,"","~221~221~") +"RTN","BMXADOX1",65,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX1",66,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX1",67,0) + Q +"RTN","BMXADOX1",68,0) + ; +"RTN","BMXADOX1",69,0) +POV ; RETURN THE POV SCHEMA +"RTN","BMXADOX1",70,0) + N OUT,%,SIEN +"RTN","BMXADOX1",71,0) + S SIEN=$$SCHEMA("BMXADO ADD POV") +"RTN","BMXADOX1",72,0) + D SS^BMXADO(.OUT,SIEN,"","") +"RTN","BMXADOX1",73,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX1",74,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX1",75,0) + Q +"RTN","BMXADOX1",76,0) + ; +"RTN","BMXADOX1",77,0) +NOTES ; RETURN NOTES FOR A SPECIFIC PATIENT PROBLEMS +"RTN","BMXADOX1",78,0) + N OUT,%,SIEN +"RTN","BMXADOX1",79,0) + S SIEN=$$SCHEMA("BMXADO NOTES") +"RTN","BMXADOX1",80,0) + D SS^BMXADO(.OUT,SIEN,"","~~~~~NOTES~BMXADOFD~53") +"RTN","BMXADOX1",81,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX1",82,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX1",83,0) + Q +"RTN","BMXADOX1",84,0) + ; +"RTN","BMXADOX1",85,0) +RENT ; ITERATE IN CHUNKS +"RTN","BMXADOX1",86,0) + ; RE-ITERATE USING THE "B" INDEX +"RTN","BMXADOX1",87,0) + ; START WITH PT IEN 5 AS THE "SEED", STOP AFTER PATIENT NAME = "D", MAX # RECORDS RETURNED = 5 +"RTN","BMXADOX1",88,0) + N OUT,%,SIEN,SEED,LSEED,X,Y +"RTN","BMXADOX1",89,0) + S SEED=0,LSEED="" +"RTN","BMXADOX1",90,0) + S SIEN=$$SCHEMA("IHS PATIENT") +"RTN","BMXADOX1",91,0) +RIT F D I '$G(SEED) Q +"RTN","BMXADOX1",92,0) + . ; D SS^BMXADO(.OUT,SIEN,SEED,"B~CA~CB~5") +"RTN","BMXADOX1",93,0) + . D SS^BMXADO(.OUT,SIEN,SEED,"~~~5") +"RTN","BMXADOX1",94,0) + . D DISP(OUT) R %:$G(DTIME,60) E S SEED="" Q +"RTN","BMXADOX1",95,0) + . I %?1"^" S SEED="" Q +"RTN","BMXADOX1",96,0) + . S X=$P(@OUT@(1),U,1) +"RTN","BMXADOX1",97,0) + . S SEED=$P(X,"|",3) +"RTN","BMXADOX1",98,0) + . I SEED=LSEED S SEED="" Q +"RTN","BMXADOX1",99,0) + . S LSEED=SEED +"RTN","BMXADOX1",100,0) + . K ^TMP("BMX ADO",$J) +"RTN","BMXADOX1",101,0) + . Q +"RTN","BMXADOX1",102,0) + Q +"RTN","BMXADOX1",103,0) + ; +"RTN","BMXADOX1",104,0) +SUB ; SUBFILE ITERATION +"RTN","BMXADOX1",105,0) + ; THE SCHEMA IS ATTACHED TO THE MEDICARE ELIGIBILITY FILE/ELIG DATE SUBFILE +"RTN","BMXADOX1",106,0) + ; THE DA STRING HAS A VALUE OF '1,',: THE IEN IN THE PARENT FILE. +"RTN","BMXADOX1",107,0) + ; NOTE THE COMMA IN THE DA STRING. THIS INDICATES THAT THE FILE IEN IS 1 BUT THE SUBFILE IEN IS UNSPECIFIED +"RTN","BMXADOX1",108,0) + N OUT,%,SIEN +"RTN","BMXADOX1",109,0) + S SIEN=$$SCHEMA("UPDATE MEDICARE DATES") +"RTN","BMXADOX1",110,0) + D SS^BMXADO(.OUT,SIEN,"1,","~~~") +"RTN","BMXADOX1",111,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX1",112,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX1",113,0) + Q +"RTN","BMXADOX1",114,0) + ; +"RTN","BMXADOX1",115,0) +DINUM ; DINUMED POINTER ITERATION +"RTN","BMXADOX1",116,0) + ; THE SCHEMA IS ATTACHED TO THE IHS PATIENT FILE (9000001) +"RTN","BMXADOX1",117,0) + ; THE IHS PATIENT FILE IS DINUM'D AND ITS .01 FIELD POINTS TO THE VA PATIENT FILE (2) +"RTN","BMXADOX1",118,0) + ; BECAUSE OF THE SPECIAL RELATIONSHIP BETWEEN THE FILES, WE CAN USE THE B INDEX OF FILE 2 TO ITERATE FILE 9000001. +"RTN","BMXADOX1",119,0) + N OUT,%,SIEN +"RTN","BMXADOX1",120,0) + S SIEN=$$SCHEMA("IHS PATIENT") +"RTN","BMXADOX1",121,0) + D SS^BMXADO(.OUT,SIEN,"","B~A~B~5") +"RTN","BMXADOX1",122,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX1",123,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX1",124,0) + Q +"RTN","BMXADOX1",125,0) + ; +"RTN","BMXADOX1",126,0) +IXP ; INDEXED POINTER ITERATION +"RTN","BMXADOX1",127,0) + ; THE SCHEMA IS ATTACHED TO THE V POV FILE +"RTN","BMXADOX1",128,0) + ; THE AC CROSS REFERENCE INDEXES THE PATIENT FIELD +"RTN","BMXADOX1",129,0) + ; BY STARTING AND STOPING WITH PATIENT 1 (MAX=5) WE COLLECT THE FIRST 5 POVS FOR PATIENT 1 IN THE FILE +"RTN","BMXADOX1",130,0) + N OUT,%,SIEN +"RTN","BMXADOX1",131,0) + S SIEN=$$SCHEMA("VIEW POVS") +"RTN","BMXADOX1",132,0) + D SS^BMXADO(.OUT,SIEN,"","AC~1~1~5") +"RTN","BMXADOX1",133,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX1",134,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX1",135,0) + Q +"RTN","BMXADOX1",136,0) + ; +"RTN","BMXADOX1",137,0) +AA ; ITERATE USING AA INDEX +"RTN","BMXADOX1",138,0) + ; INDEX IS 'AA" THE START AND STOP DATES ARE SPECIFIED IN EXTERNAL FORMAT. MAX=10 +"RTN","BMXADOX1",139,0) + ; THE FOLLOWING FILTERS ARE SPECIFIED IN THE LAST PARAMETER ("1|WT|C"): +"RTN","BMXADOX1",140,0) + ; 1=PATIENT DFN #1 +"RTN","BMXADOX1",141,0) + ; WT=RETURN ONLY WEIGHTS. MEASUREMENT TYPE MUST BE SPECIFIED WITH A VALID, UNAMBIGUOUS LOOKUP VALUE. +"RTN","BMXADOX1",142,0) + ; C=RETRUN VALUES IN CHRONOLOGICAL ORDER USE 'R' INSTEAD OF 'C' FOR REVERSE CHRONOLOGICAL ORDER. DEFAULT=C +"RTN","BMXADOX1",143,0) + ; THE SEED PARAMTER IS SET AND CAN BE USED TO RETURN DATA IN CHUNKS +"RTN","BMXADOX1",144,0) + N OUT,%,SIEN +"RTN","BMXADOX1",145,0) + S SIEN=$$SCHEMA("VIEW MEASUREMENTS") +"RTN","BMXADOX1",146,0) + D SS^BMXADO(.OUT,SIEN,"","AA~3/21/1985~6/4/1986~5~~~~1|WT|C") +"RTN","BMXADOX1",147,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX1",148,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX1",149,0) + Q +"RTN","BMXADOX1",150,0) + ; +"RTN","BMXADOX1",151,0) +AA2 ; ITERATE USING AA INDEX +"RTN","BMXADOX1",152,0) + ; THIS SCHEMA IS ATTACHED TO THE VISIT FILE (9000010) +"RTN","BMXADOX1",153,0) + ; IN THIS CASE THERE IS NO ATTRIBUTE TYPE SO THE FILTER PARAM HAS ONLY 2 PIECES "1|R" +"RTN","BMXADOX1",154,0) + ; 1=PATIENT DFN +"RTN","BMXADOX1",155,0) + ; R=RETURN DATA IN REVERSE CHRONOLOGICAL ORDER +"RTN","BMXADOX1",156,0) + N OUT,%,SIEN +"RTN","BMXADOX1",157,0) + S SIEN=$$SCHEMA("VISITS") +"RTN","BMXADOX1",158,0) + D SS^BMXADO(.OUT,SIEN,"","AA~3/21/1985~6/4/1986~5~~~~1|R") +"RTN","BMXADOX1",159,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX1",160,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX1",161,0) + Q +"RTN","BMXADOX1",162,0) + ; +"RTN","BMXADOX1",163,0) +CIT ; CUSTOM ITERATOR +"RTN","BMXADOX1",164,0) + ; IF COMPLEX OR UNUSUAL SORTING/FILTERING IS REQUITED, USE A CUSTOM ITERATOR +"RTN","BMXADOX1",165,0) + ; THE CUSTOM ITERATOR IS DEFINED BY 6TH, 7TH AND 8TH PIECES IN THE VSTG +"RTN","BMXADOX1",166,0) + ; PIECE 8=TAG, PIECE 9=ROUTINE, PIECE 8=A PARAMETER PASSED TO THE ENTRY POINT +"RTN","BMXADOX1",167,0) + ; THE 9TH PIECE CONTAINS PT DFN, TIMESTAMP, VISIT TYPE, LOC IEN, AND SERVICE CATEGORY IN A "|" DELIMTED STRING +"RTN","BMXADOX1",168,0) + ; THE ITERATOR CALL TAG^ROUTINE(PARAM) TO GENERATE IENS +"RTN","BMXADOX1",169,0) + ; IN THIS CASE THE SCHEMA IS ATTACHED TO THE VISIT FILE. +"RTN","BMXADOX1",170,0) + ; GIVEN THE INFORMATION IN THE PARAMETER, THE CUSTOM ITERATOR RETURNS POSSIBLE DUPLICATE VISITS +"RTN","BMXADOX1",171,0) + N OUT,%,SIEN +"RTN","BMXADOX1",172,0) + S SIEN=$$SCHEMA("VISITS") +"RTN","BMXADOX1",173,0) + D SS^BMXADO(.OUT,SIEN,"","~~~~~DUPV~BMXADOV2~1|4/19/04@1PM|I|4585|A~") +"RTN","BMXADOX1",174,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX1",175,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX1",176,0) + Q +"RTN","BMXADOX1",177,0) + ; +"RTN","BMXADOX1",178,0) +TRIGGER ; TEXT TRIGGER FUNCTION +"RTN","BMXADOX1",179,0) + N OUT,%,SIEN +"RTN","BMXADOX1",180,0) + S SIEN=$$SCHEMA("PATIENT DEMOGRAPHICS") +"RTN","BMXADOX1",181,0) + D SS^BMXADO(.OUT,SIEN,"","~1~5") +"RTN","BMXADOX1",182,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX1",183,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX1",184,0) + Q +"RTN","BMXADOX1",185,0) + ; +"RTN","BMXADOX1",186,0) +ID ; IDENTIFIER FIELD +"RTN","BMXADOX1",187,0) + ; THE SCHEMA IS ATTACHED TO THE VA PATIENT FILE (2) +"RTN","BMXADOX1",188,0) + ; THE SCHEMA HAS A BUILT IN FIELD (.01ID) THAT RETURNS THE IDENTIFIERS +"RTN","BMXADOX1",189,0) + ; THE ENTRY POINT THAT GENERATES THE IDETIFIERS IS STORED IN THE BMX ADO SCHEMA FILE +"RTN","BMXADOX1",190,0) + N OUT,%,SIEN +"RTN","BMXADOX1",191,0) + S SIEN=$$SCHEMA("UPDATE PATIENT DEMOGRAPHICS") +"RTN","BMXADOX1",192,0) + D SS^BMXADO(.OUT,SIEN,"","~1~1~") +"RTN","BMXADOX1",193,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX1",194,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX1",195,0) + Q +"RTN","BMXADOX1",196,0) + ; +"RTN","BMXADOX1",197,0) +JMD ; JOIN MASTER TO DETAIL +"RTN","BMXADOX1",198,0) + N OUT,%,SIEN1,SIEN2,VSTG,SIEN3,JSTG +"RTN","BMXADOX1",199,0) + S SIEN1=$$SCHEMA("PATIENT DEMOGRAPHICS") +"RTN","BMXADOX1",200,0) + S SIEN2=$$SCHEMA("VIEW MEASUREMENTS") +"RTN","BMXADOX1",201,0) + S SIEN3=$$SCHEMA("VIEW MEDS") +"RTN","BMXADOX1",202,0) + S VSTG="~1~5" ; INSTRUCTIONS FOR GATHERING DATA SET FOR PTS 1-5 FROM THE MASTER FILE +"RTN","BMXADOX1",203,0) + S JSTG=SIEN3_",.001,.02IEN,AA~1/1/1960~6/30/2004~~~~~|C" ; + INSTRUCTIONS FOR 1ST JOIN TO GET MEDS +"RTN","BMXADOX1",204,0) + S JSTG=JSTG_"@JOIN@"_SIEN2_",.001,.02IEN,AA~1/1/1988~12/31/1988~~~~~|WT|R" ; + INSTRUCTIONS FOR 2ND JOIN TO GET MSRMNTS +"RTN","BMXADOX1",205,0) + D SS^BMXADO(.OUT,SIEN1,"",VSTG,JSTG) +"RTN","BMXADOX1",206,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX1",207,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX1",208,0) + Q +"RTN","BMXADOX1",209,0) + ; +"RTN","BMXADOX1",210,0) +JVPT ; JOIN PT DEMOG TO VISIT +"RTN","BMXADOX1",211,0) + N OUT,%,SIEN1,SIEN2,VSTG,JSTG +"RTN","BMXADOX1",212,0) + S SIEN1=$$SCHEMA("PATIENT DEMOGRAPHICS") +"RTN","BMXADOX1",213,0) + S SIEN2=$$SCHEMA("VISITS") +"RTN","BMXADOX1",214,0) + S VSTG="~1~1" ; INSTRUCTIONS FOR GATHERING DATA SET FOR PT 5 FROM THE MASTER FILE +"RTN","BMXADOX1",215,0) + S JSTG=SIEN2_",.05IEN,.001,AC" ; + INSTRUCTIONS FOR 1ST JOIN TO GET VISIT INFO +"RTN","BMXADOX1",216,0) + D SS^BMXADO(.OUT,SIEN1,"",VSTG,JSTG) +"RTN","BMXADOX1",217,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX1",218,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX1",219,0) + Q +"RTN","BMXADOX1",220,0) + ; +"RTN","BMXADOX1",221,0) +JAC ; TEST AC INDEX +"RTN","BMXADOX1",222,0) + N OUT,%,SIEN1,SIEN2 +"RTN","BMXADOX1",223,0) + S SIEN1=$$SCHEMA("PATIENT DEMOGRAPHICS") +"RTN","BMXADOX1",224,0) + S SIEN2=$$SCHEMA("VIEW LABS") +"RTN","BMXADOX1",225,0) + S SIEN3=$$SCHEMA("VIEW MEASUREMENTS") +"RTN","BMXADOX1",226,0) + D SS^BMXADO(.OUT,SIEN1,"","~3~5~~~~~~"_SIEN2_",.001,.02IEN,AC@JOIN@"_SIEN3_",.001,.02IEN,AC") +"RTN","BMXADOX1",227,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX1",228,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX1",229,0) + Q +"RTN","BMXADOX1",230,0) + ; +"RTN","BMXADOX1",231,0) +JPB ; TEST AA INDEX JOINS FOR PROBLEM LIST +"RTN","BMXADOX1",232,0) + N OUT,%,SIEN1,SIEN2 +"RTN","BMXADOX1",233,0) + S SIEN1=$$SCHEMA("PATIENT DEMOGRAPHICS") +"RTN","BMXADOX1",234,0) + S SIEN2=$$SCHEMA("VIEW PROBLEMS") +"RTN","BMXADOX1",235,0) + D SS^BMXADO(.OUT,SIEN1,"","~1~5~~~~~~"_SIEN2_",.001,.02IEN,AA") +"RTN","BMXADOX1",236,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX1",237,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX1",238,0) + Q +"RTN","BMXADOX1",239,0) + ; +"RTN","BMXADOX1",240,0) +JSUB ; SUBFILE JOIN +"RTN","BMXADOX1",241,0) + ; IN THIS CASE THE RECORDS IN A PARENT FILE ARE "JOINED" TO THE RECORDS IN ONE OF ITS SUB FILES +"RTN","BMXADOX1",242,0) + ; THE SCHEMA IS ATTACHED TO THE "MEDICARE ELIGIBLE" FILE +"RTN","BMXADOX1",243,0) + ; IT IS JOINED TO ITS SUBFILE, "ELIG DATES", VIA THE UPDATE MEDICARE DATES SCHEMA +"RTN","BMXADOX1",244,0) + N OUT,%,SIEN1,SIEN2 +"RTN","BMXADOX1",245,0) + S SIEN1=$$SCHEMA("UPDATE MEDICARE INFO") +"RTN","BMXADOX1",246,0) + S SIEN2=$$SCHEMA("UPDATE MEDICARE DATES") +"RTN","BMXADOX1",247,0) + D SS^BMXADO(.OUT,SIEN1,"","~1~5~~~~~~"_SIEN2_",SUB") +"RTN","BMXADOX1",248,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX1",249,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX1",250,0) + Q +"RTN","BMXADOX1",251,0) + ; +"RTN","BMXADOX1",252,0) +ADD ; ADD A NEW ENTRY +"RTN","BMXADOX1",253,0) + ; THIS IS A 2 STEP PROCESS: +"RTN","BMXADOX1",254,0) + ; FIRST GET THE SCHEMA FOR THE FILE YOU WISH TO UPDATE +"RTN","BMXADOX1",255,0) + ; THIS SCHEMA TYPICALLY BEGINS WITH THE WORD "UPDATE" +"RTN","BMXADOX1",256,0) + ; IT CONTAINS NO ID IR IEN FIELDS +"RTN","BMXADOX1",257,0) + ; SECOND ADD THE DATA NODE TO THE ARRAY +"RTN","BMXADOX1",258,0) + ; IT HAS THE SAME FORMAT AS A DATA STRING ASSOCIATED WITH THE SCHEMA EXCEPT THE FIRST "^" PIECE IS NULL +"RTN","BMXADOX1",259,0) + ; THIS PIECE CORRESPONDS TO THE IEN OF THE RECORD. SINCE THE RECORD HASNOT BEEN ADDED YET, IT IS NULL. +"RTN","BMXADOX1",260,0) + ; IN THE DATA STRING, ALL POINTER VALUES ARE PRECEDED BY THE '`' CHARACTER AND EA. STRING ENDS IN $C(30) +"RTN","BMXADOX1",261,0) + ; MULTIPLE DATA STRINGS CAN BE APPENDED AS NEW NODES AT THE BOTTOM OF THE ARRAY +"RTN","BMXADOX1",262,0) + ; IN THIS CASE WE ARE ADDING A RECORD TO THE V MEASUREMENT FILE +"RTN","BMXADOX1",263,0) + ; DATA STRING="^MEASUREMENT TYPE IEN^PATIENT DFN^VISIT IEN^RESULT"_$C(30) +"RTN","BMXADOX1",264,0) + ; THERE ARE 2 INPUT PARAMS: +"RTN","BMXADOX1",265,0) + ; THE CLOSED REF WHERE THE INPUT ARRAY IS STORED +"RTN","BMXADOX1",266,0) + ; SINCE IT IS PASSED BY REFERENCE "OUT" CAN BE NULL OR UNDEFIEND. +"RTN","BMXADOX1",267,0) + ; OUT WILL BE DEFINED AT THE CONCLUSION OF THE TRANSACTION. +"RTN","BMXADOX1",268,0) + ; THE OUTPUT IS IN THE OUT ARRAY +"RTN","BMXADOX1",269,0) + ; OUT(1)="OK|ien" WHERE ien IS THE IEN OF THE RECORD THAT HAS BEE ADDED. +"RTN","BMXADOX1",270,0) + ; IF THE TRANSACTION FAILED, AN ERROR MSG WILL BE IN THE OUT ARRAY +"RTN","BMXADOX1",271,0) + ; +"RTN","BMXADOX1",272,0) + N OUT,%,SIEN,NODE +"RTN","BMXADOX1",273,0) + S SIEN=$$SCHEMA("UPDATE MEASUREMENTS") +"RTN","BMXADOX1",274,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOX1",275,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOX1",276,0) + S ^TMP("BMX ADO",$J,NODE)="^`2^`1^`71164^175.75"_$C(30) +"RTN","BMXADOX1",277,0) + D DISP(OUT) R %:$G(DTIME,60) ; DISPLAY THE INPUT ARRAY BEFORE UPDATING THE RECORD +"RTN","BMXADOX1",278,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) ; EP FOR UPDAING THE RECORD +"RTN","BMXADOX1",279,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX1",280,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) ; SEND BACK AN ACKNOWLEDGEMENT OR ERROR MSG +"RTN","BMXADOX1",281,0) + Q +"RTN","BMXADOX1",282,0) + ; +"RTN","BMXADOX1",283,0) +DELREC ; DELETE AN ENTRY +"RTN","BMXADOX1",284,0) + ; THE SIMPLEST WAY TO DELETE AN ENTRY IS TO PUT THE RECORD IEN IN THE DA STRING PRECEDED BY A MINUS SIGN +"RTN","BMXADOX1",285,0) + ; YOU CAN ALSO SET THE VALUE OF THE .01 FIELD TO "@" +"RTN","BMXADOX1",286,0) + ; IF THE VALUE OF THE .01 FIELD IS NULL AND THE DA STRING IS NOT PRECEDED BY A MINUS SIGN, THE TRANSACTION WILL BE CANCELLED +"RTN","BMXADOX1",287,0) + ; IF THE DA STRING IS NULL, THE TRANSACTION WILL BE CANCELLED +"RTN","BMXADOX1",288,0) + N OUT,%,SIEN,NODE,DEL +"RTN","BMXADOX1",289,0) + S DEL=51385 +"RTN","BMXADOX1",290,0) + S SIEN=$$SCHEMA("UPDATE MEASUREMENTS") +"RTN","BMXADOX1",291,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOX1",292,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOX1",293,0) + S ^TMP("BMX ADO",$J,NODE)="-"_DEL_$C(30) +"RTN","BMXADOX1",294,0) + D DISP(OUT) R %:$G(DTIME,60) ; DISPLAY THE INPUT ARRAY BEFORE UPDATING THE RECORD +"RTN","BMXADOX1",295,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) ; EP FOR UPDAING THE RECORD +"RTN","BMXADOX1",296,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX1",297,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) ; SEND BACK AN ACKNOWLEDGEMENT OR ERROR MSG +"RTN","BMXADOX1",298,0) + Q +"RTN","BMXADOX1",299,0) + ; +"RTN","BMXADOX1",300,0) +EDIT ; EDIT AN EXISTING ENTRY +"RTN","BMXADOX1",301,0) + ; SIMILAR TO ABOVE EXCEPT THAT THE FIRST "^" PIECE OF THE DATA NODE IS THE IEN OF THE RECORD TO BE EDITIED +"RTN","BMXADOX1",302,0) + ; NOTE THAT THERE IS NO '`' IN FRONT OF THE FIRST PIECE. IT IS A PURE INTEGER +"RTN","BMXADOX1",303,0) + N OUT,%,SIEN,NODE +"RTN","BMXADOX1",304,0) + S SIEN=$$SCHEMA("UPDATE MEASUREMENTS") +"RTN","BMXADOX1",305,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOX1",306,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOX1",307,0) + S ^TMP("BMX ADO",$J,NODE)="51385^^^^176^`6"_$C(30) +"RTN","BMXADOX1",308,0) + D DISP(OUT) R %:$G(DTIME,60) ; DISPLAY THE INPUT ARRAY BEFORE UPDATING THE RECORD +"RTN","BMXADOX1",309,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) ; EP FOR UPDAING THE RECORD +"RTN","BMXADOX1",310,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX1",311,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) ; SEND BACK AN ACKNOWLEDGEMENT OR ERROR MSG +"RTN","BMXADOX1",312,0) + Q +"RTN","BMXADOX1",313,0) + ; +"RTN","BMXADOX1",314,0) +DELVAL ; DELETE A VALUE IN A FIELD +"RTN","BMXADOX1",315,0) + ; SIMILAR TO EDIT EXCEPT THE VALUE IS "@" +"RTN","BMXADOX1",316,0) + N OUT,%,SIEN,NODE +"RTN","BMXADOX1",317,0) + S SIEN=$$SCHEMA("UPDATE MEASUREMENTS") +"RTN","BMXADOX1",318,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOX1",319,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOX1",320,0) + S ^TMP("BMX ADO",$J,NODE)="51385^^^^^@"_$C(30) +"RTN","BMXADOX1",321,0) + D DISP(OUT) R %:$G(DTIME,60) ; DISPLAY THE INPUT ARRAY BEFORE UPDATING THE RECORD +"RTN","BMXADOX1",322,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) ; EP FOR UPDAING THE RECORD +"RTN","BMXADOX1",323,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX1",324,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) ; SEND BACK AN ACKNOWLEDGEMENT OR ERROR MSG +"RTN","BMXADOX1",325,0) + Q +"RTN","BMXADOX2") +0^76^B11989229 +"RTN","BMXADOX2",1,0) +BMXADOX2 ; IHS/CIHA/GIS - RPC CALL: GENERATE AN ADO SCHEMA STRING AND DATA SET ; +"RTN","BMXADOX2",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXADOX2",3,0) + ; EXMAPLES OF FILEMAN SCHEMA GENERATION +"RTN","BMXADOX2",4,0) + ; +"RTN","BMXADOX2",5,0) +DISP(OUT) ; +"RTN","BMXADOX2",6,0) + D DISP^BMXADOX(OUT) +"RTN","BMXADOX2",7,0) + Q +"RTN","BMXADOX2",8,0) + ; +"RTN","BMXADOX2",9,0) +SCHEMA(NAME) ; GIVEN SCHEMA NAME, RETURN THE IEN +"RTN","BMXADOX2",10,0) + N IEN +"RTN","BMXADOX2",11,0) + S IEN=$O(^BMXADO("B",NAME,0)) +"RTN","BMXADOX2",12,0) + Q IEN +"RTN","BMXADOX2",13,0) + ; +"RTN","BMXADOX2",14,0) + ; ---------------------------------------- LISTS ------------------------------------------ +"RTN","BMXADOX2",15,0) + ; +"RTN","BMXADOX2",16,0) +FIFOLIST N OUT,%,SIEN,NODE,NEXT +"RTN","BMXADOX2",17,0) + S NEXT="70470;8" +"RTN","BMXADOX2",18,0) + S SIEN=$$SCHEMA("VEN MOJO LIST DE FIFO") +"RTN","BMXADOX2",19,0) + D SS^BMXADO(.OUT,SIEN,"","~~~") ; GET ENCOUNTER LIST TO BE PROCESSED BY DATA ENTRY +"RTN","BMXADOX2",20,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX2",21,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX2",22,0) + Q +"RTN","BMXADOX2",23,0) + ; +"RTN","BMXADOX2",24,0) +PROBLIST ; LIST PROBLEMS +"RTN","BMXADOX2",25,0) + S SIEN=$$SCHEMA("VEN MOJO DE DX PROBLEM") +"RTN","BMXADOX2",26,0) + D SS^BMXADO(.OUT,SIEN,"","AC~5~5~") ; GET PROBLEM LIST TO BE PROCESSED BY DATA ENTRY +"RTN","BMXADOX2",27,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX2",28,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX2",29,0) + Q +"RTN","BMXADOX2",30,0) + ; +"RTN","BMXADOX2",31,0) +PTLIST ; LIST PATIENT WITH A SPECIFIC LOOKUP VALUE +"RTN","BMXADOX2",32,0) + N VAL +"RTN","BMXADOX2",33,0) + R "PATIENT: ",VAL:DTIME E Q +"RTN","BMXADOX2",34,0) + I '$L(VAL) Q +"RTN","BMXADOX2",35,0) + I VAL?1."^" Q +"RTN","BMXADOX2",36,0) + S SIEN=$$SCHEMA("VEN MOJO LIST PATIENTS") +"RTN","BMXADOX2",37,0) + D SS^BMXADO(.OUT,SIEN,"","~~~~~PT~BMXADOV2~"_VAL) +"RTN","BMXADOX2",38,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX2",39,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX2",40,0) + Q +"RTN","BMXADOX2",41,0) + ; +"RTN","BMXADOX2",42,0) +CLINLIST ; LIST CLINICS +"RTN","BMXADOX2",43,0) + S SIEN=$$SCHEMA("VEN MOJO LIST CLINICS") +"RTN","BMXADOX2",44,0) + D SS^BMXADO(.OUT,SIEN,"","B~~~") ; GET PROBLEM LIST TO BE PROCESSED BY DATA ENTRY +"RTN","BMXADOX2",45,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX2",46,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX2",47,0) + Q +"RTN","BMXADOX2",48,0) + ; +"RTN","BMXADOX2",49,0) +SEGLIST ; LIST DE SEGMENTS +"RTN","BMXADOX2",50,0) + S SIEN=$$SCHEMA("VEN MOJO DE SEGMENT") +"RTN","BMXADOX2",51,0) + D SS^BMXADO(.OUT,SIEN,"","~~~") ; GET PROBLEM LIST TO BE PROCESSED BY DATA ENTRY +"RTN","BMXADOX2",52,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX2",53,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX2",54,0) + Q +"RTN","BMXADOX2",55,0) + ; +"RTN","BMXADOX2",56,0) +NOTELIST ; LIST NOTES +"RTN","BMXADOX2",57,0) + ;N SIEN +"RTN","BMXADOX2",58,0) + ;D NOTELIST^VENPCCTG(.OUT,"70470") +"RTN","BMXADOX2",59,0) + ;D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX2",60,0) + ;K ^TMP("BMX ADO",$J) +"RTN","BMXADOX2",61,0) + Q +"RTN","BMXADOX2",62,0) + ; +"RTN","BMXADOX2",63,0) +PRVLIST ; PROVIDER LIST +"RTN","BMXADOX2",64,0) + N SIEN,OUT +"RTN","BMXADOX2",65,0) + S SIEN=$$SCHEMA("VEN MOJO LIST PROVIDERS") +"RTN","BMXADOX2",66,0) + D SS^BMXADO(.OUT,SIEN,"","B~~~5000") ; GET NOTE LIST TO BE PROCESSED BY DATA ENTRY +"RTN","BMXADOX2",67,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX2",68,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX2",69,0) + Q +"RTN","BMXADOX2",70,0) + ; +"RTN","BMXADOX2",71,0) +MLIST ; LIST MEASUREMNTS +"RTN","BMXADOX2",72,0) + S SIEN=$$SCHEMA("VEN MOJO LIST MEASUREMENTS") +"RTN","BMXADOX2",73,0) + D SS^BMXADO(.OUT,SIEN,"","B~~~") ; GET PROBLEM LIST TO BE PROCESSED BY DATA ENTRY +"RTN","BMXADOX2",74,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX2",75,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX2",76,0) + Q +"RTN","BMXADOX2",77,0) + ; +"RTN","BMXADOX2",78,0) +RXLIST ; A RX LIST FOR A PATIENT +"RTN","BMXADOX2",79,0) + N SIEN,OUT +"RTN","BMXADOX2",80,0) + S SIEN=$$SCHEMA("VEN MOJO RX LIST") +"RTN","BMXADOX2",81,0) + D SS^BMXADO(.OUT,SIEN,"","~~~~~MED~MOJORX~3") ; GET RX LIST +"RTN","BMXADOX2",82,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX2",83,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX2",84,0) + Q +"RTN","BMXADOX2",85,0) + ; +"RTN","BMXADOX2",86,0) +TQLIST ; TABLET QUEUE LIST +"RTN","BMXADOX2",87,0) + N SIEN,OUT +"RTN","BMXADOX2",88,0) + S SIEN=$$SCHEMA("VEN MOJO LIST TABLET QUEUE") +"RTN","BMXADOX2",89,0) + D SS^BMXADO(.OUT,SIEN,"","ATS~~~") ; GET PATIENT LIST +"RTN","BMXADOX2",90,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX2",91,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX2",92,0) + Q +"RTN","BMXADOX2",93,0) + ; +"RTN","BMXADOX2",94,0) +UHCLIST ; LIST HIDDEN COLUMNS +"RTN","BMXADOX2",95,0) + N SIEN,OUT +"RTN","BMXADOX2",96,0) + ; S SIEN=$$SCHEMA("VEN MOJO DE GFMT UHC") +"RTN","BMXADOX2",97,0) + D SS^BMXADO(.OUT,"VEN MOJO DE FMT GRID","","~~~") ; GET RX LIST +"RTN","BMXADOX2",98,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX2",99,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX2",100,0) + Q +"RTN","BMXADOX2",101,0) + ; +"RTN","BMXADOX2",102,0) +GSEGLIST ; LIST GRID PROPERTIES FOR SEGMENTS +"RTN","BMXADOX2",103,0) + N SIEN,OUT +"RTN","BMXADOX2",104,0) + D SS^BMXADO(.OUT,"VEN MOJO DE GRID FMT","","B~~~") ; GET RX LIST +"RTN","BMXADOX2",105,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX2",106,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX2",107,0) + Q +"RTN","BMXADOX2",108,0) + ; +"RTN","BMXADOX2",109,0) +ICDLIST ; LIST ICD CODE MATCHES +"RTN","BMXADOX2",110,0) + ;N NARR,OUT +"RTN","BMXADOX2",111,0) + ;W !,"Provider narrative: " R NARR:60 E Q +"RTN","BMXADOX2",112,0) + ;I '$L(NARR) Q +"RTN","BMXADOX2",113,0) + ;D ICDMATCH^VENPCCTP(.OUT,NARR) W !! +"RTN","BMXADOX2",114,0) + ;D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX2",115,0) + ;K ^TMP("BMX ADO",$J) +"RTN","BMXADOX2",116,0) + Q +"RTN","BMXADOX2",117,0) + ; +"RTN","BMXADOX2",118,0) +IMAGE ; LIST SEGMENT IMAGE CONTROL PARAMETERS +"RTN","BMXADOX2",119,0) + N SIEN,OUT +"RTN","BMXADOX2",120,0) + D SS^BMXADO(.OUT,"VEN MOJO DE SEG IMAGE","1,","~~~") ; GET RX LIST +"RTN","BMXADOX2",121,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOX2",122,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOX2",123,0) + Q +"RTN","BMXADOXX") +0^77^B166011930 +"RTN","BMXADOXX",1,0) +BMXADOXX ; IHS/CIHA/GIS - RPC CALL: GENERATE AN ADO SCHEMA STRING AND DATA SET ; +"RTN","BMXADOXX",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXADOXX",3,0) + ; EXMAPLES OF RPMS SCHEMAE GENERATION +"RTN","BMXADOXX",4,0) + ; +"RTN","BMXADOXX",5,0) + ; +"RTN","BMXADOXX",6,0) +ADDPAT ; +"RTN","BMXADOXX",7,0) + N OUT,%,SIEN,DFN,NODE +"RTN","BMXADOXX",8,0) + ;S DFN=9285 +"RTN","BMXADOXX",9,0) + S SIEN=$$SCHEMA("UPDATE VA PATIENT") +"RTN","BMXADOXX",10,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOXX",11,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOXX",12,0) + S ^TMP("BMX ADO",$J,NODE)="^KANGAROO,KAP^M^1-1-83^151515555"_$C(30) +"RTN","BMXADOXX",13,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",14,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) +"RTN","BMXADOXX",15,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",16,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) +"RTN","BMXADOXX",17,0) + ; +"RTN","BMXADOXX",18,0) + Q +"RTN","BMXADOXX",19,0) + ; +"RTN","BMXADOXX",20,0) +DISP(OUT) ; TEMP DISPLAY +"RTN","BMXADOXX",21,0) + N I,X +"RTN","BMXADOXX",22,0) + S I=0 W ! +"RTN","BMXADOXX",23,0) + F S I=$O(@OUT@(I)) Q:'I S X=@OUT@(I) S X=$TR(X,$C(30),"}") S X=$TR(X,$C(31),"{") W !,X +"RTN","BMXADOXX",24,0) + Q +"RTN","BMXADOXX",25,0) + ; +"RTN","BMXADOXX",26,0) +SCHEMA(NAME) ; GIVEN SCHEMA NAME, RETURN THE IEN +"RTN","BMXADOXX",27,0) + N IEN +"RTN","BMXADOXX",28,0) + S IEN=$O(^BMXADO("B",NAME,0)) +"RTN","BMXADOXX",29,0) + Q IEN +"RTN","BMXADOXX",30,0) + ; +"RTN","BMXADOXX",31,0) +NEXTNUM(DFN,LOC) ; RETURN THE NEXT PROBLEM NUMBER FOR A PATIENT +"RTN","BMXADOXX",32,0) + N X,LAST,MAX,NUM +"RTN","BMXADOXX",33,0) + S NUM=0,MAX="" +"RTN","BMXADOXX",34,0) + F S NUM=$O(^AUPNPROB("AA",DFN,LOC,NUM)) Q:NUM="" S X=$E(NUM,2,99) I +X>MAX S MAX=+X +"RTN","BMXADOXX",35,0) + I 'MAX Q 1 +"RTN","BMXADOXX",36,0) + S X=X+1 S X=X\1 +"RTN","BMXADOXX",37,0) + Q X +"RTN","BMXADOXX",38,0) + ; +"RTN","BMXADOXX",39,0) +DEMOG ; VIEW DEMOGRAPHICS +"RTN","BMXADOXX",40,0) + N OUT,%,DFN,MAX,SIEN +"RTN","BMXADOXX",41,0) + S DFN=1373,MAX=1000 +"RTN","BMXADOXX",42,0) + S SIEN=$$SCHEMA("UPDATE PATIENT DEMOGRAPHICS") +"RTN","BMXADOXX",43,0) + D SS^BMXADO(.OUT,SIEN,"",("~"_DFN_"~"_DFN_"~"_MAX)) +"RTN","BMXADOXX",44,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",45,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",46,0) + Q +"RTN","BMXADOXX",47,0) + ; +"RTN","BMXADOXX",48,0) +MEDICARE ; UPDATE MEDICARE DATES/INFO +"RTN","BMXADOXX",49,0) + N OUT,%,DAS,PIEN,JIEN,DFN,MAX +"RTN","BMXADOXX",50,0) + S DFN=1,MAX=1000 +"RTN","BMXADOXX",51,0) + S DAS=DFN_"," +"RTN","BMXADOXX",52,0) + S PIEN=$$SCHEMA("UPDATE MEDICARE DATES") +"RTN","BMXADOXX",53,0) + S JIEN=$$SCHEMA("UPDATE MEDICARE INFO") +"RTN","BMXADOXX",54,0) + D SS^BMXADO(.OUT,PIEN,DAS,("~"_DFN_"~"_DFN_"~"_MAX_"~~"_"MEDICARE~BMXADOV2~~"_JIEN_",PARENT")) +"RTN","BMXADOXX",55,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",56,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",57,0) + Q +"RTN","BMXADOXX",58,0) + ; +"RTN","BMXADOXX",59,0) +MEDICAID ; VIEW MEDICAID DATES/INFO +"RTN","BMXADOXX",60,0) + N OUT,%,DAS,PIEN,JIEN,DFN,DA +"RTN","BMXADOXX",61,0) + S DFN=322 +"RTN","BMXADOXX",62,0) + S DA(1)=$$MCDIEN^BMXADOV2(DFN) I 'DA(1) Q +"RTN","BMXADOXX",63,0) + S DAS=DA(1)_"," +"RTN","BMXADOXX",64,0) + S PIEN=$$SCHEMA("UPDATE MEDICAID DATES") +"RTN","BMXADOXX",65,0) + S JIEN=$$SCHEMA("UPDATE MEDICAID INFO") +"RTN","BMXADOXX",66,0) + D SS^BMXADO(.OUT,PIEN,DAS,("~~~~~MEDICAID~BMXADOV2~~"_JIEN_",PARENT")) +"RTN","BMXADOXX",67,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",68,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",69,0) + Q +"RTN","BMXADOXX",70,0) + ; +"RTN","BMXADOXX",71,0) +PVTINS ; VIEW PRIVATE INSURANCE DATES/INFO +"RTN","BMXADOXX",72,0) + N OUT,%,DAS,SIEN,DFN +"RTN","BMXADOXX",73,0) + S DFN=96 +"RTN","BMXADOXX",74,0) + S DAS=DFN_"," +"RTN","BMXADOXX",75,0) + S SIEN=$$SCHEMA("UPDATE PVT INSURANCE INFO") +"RTN","BMXADOXX",76,0) + D SS^BMXADO(.OUT,SIEN,DAS,"~~~~~PVTINS~BMXADOV2~~") +"RTN","BMXADOXX",77,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",78,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",79,0) + Q +"RTN","BMXADOXX",80,0) + ; +"RTN","BMXADOXX",81,0) +VISIT ; VIEW VISITS +"RTN","BMXADOXX",82,0) + N OUT,%,SIEN,DFN +"RTN","BMXADOXX",83,0) + S DFN=9285 +"RTN","BMXADOXX",84,0) + S SIEN=$$SCHEMA("VISITS") +"RTN","BMXADOXX",85,0) + D SS^BMXADO(.OUT,SIEN,"","AA~3/21/1968~6/4/2004~100~~~~9285|C") +"RTN","BMXADOXX",86,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",87,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",88,0) + Q +"RTN","BMXADOXX",89,0) + ; +"RTN","BMXADOXX",90,0) +DUPVIS ; DISPLAY POSSIBLE DUPLICATE VISITS +"RTN","BMXADOXX",91,0) + N OUT,%,SIEN,DFN +"RTN","BMXADOXX",92,0) + S DFN=9285 +"RTN","BMXADOXX",93,0) + S SIEN=$$SCHEMA("VISITS") +"RTN","BMXADOXX",94,0) + D SS^BMXADO(.OUT,SIEN,"","~~~~~DUPV~BMXADOV2~9285|5/24/04@1PM|I|516|~") +"RTN","BMXADOXX",95,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",96,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",97,0) + Q +"RTN","BMXADOXX",98,0) + ; +"RTN","BMXADOXX",99,0) +ADDVIS ; ADD A NEW VISIT +"RTN","BMXADOXX",100,0) + N OUT,%,SIEN,DFN,NODE +"RTN","BMXADOXX",101,0) + S DFN=9285 +"RTN","BMXADOXX",102,0) + S SIEN=$$SCHEMA("VISITS") +"RTN","BMXADOXX",103,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOXX",104,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOXX",105,0) + S ^TMP("BMX ADO",$J,NODE)="^JUN 03, 2004@01:32^I^`9285^`516^A^`2"_$C(30) +"RTN","BMXADOXX",106,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",107,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) +"RTN","BMXADOXX",108,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",109,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) +"RTN","BMXADOXX",110,0) + Q +"RTN","BMXADOXX",111,0) + ; +"RTN","BMXADOXX",112,0) +POV ; DISPLAY POVS +"RTN","BMXADOXX",113,0) + N OUT,%,SIEN,DFN +"RTN","BMXADOXX",114,0) + S DFN=9285 +"RTN","BMXADOXX",115,0) + S SIEN=$$SCHEMA("VIEW POVS") +"RTN","BMXADOXX",116,0) + D SS^BMXADO(.OUT,SIEN,"","AA~3/21/1965~6/4/2004~100~~~~9285|C") +"RTN","BMXADOXX",117,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",118,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",119,0) + Q +"RTN","BMXADOXX",120,0) + ; +"RTN","BMXADOXX",121,0) +ADDPOV ; ADD A POV TO AN EXISITING VISIT +"RTN","BMXADOXX",122,0) + N OUT,%,SIEN,DFN,NODE +"RTN","BMXADOXX",123,0) + S DFN=9285 +"RTN","BMXADOXX",124,0) + S SIEN=$$SCHEMA("UPDATE POVS") +"RTN","BMXADOXX",125,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOXX",126,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOXX",127,0) + S ^TMP("BMX ADO",$J,NODE)="^`8718^`9285^`8337^DM II ON EXPMTL MEDS^2^P"_$C(30) +"RTN","BMXADOXX",128,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",129,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) +"RTN","BMXADOXX",130,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",131,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) +"RTN","BMXADOXX",132,0) + Q +"RTN","BMXADOXX",133,0) + ; +"RTN","BMXADOXX",134,0) +EDITPOV ; ADD A POV TO AN EXISITING VISIT +"RTN","BMXADOXX",135,0) + N OUT,%,SIEN,DFN,NODE +"RTN","BMXADOXX",136,0) + S DFN=1 +"RTN","BMXADOXX",137,0) + S SIEN=$$SCHEMA("UPDATE POVS") +"RTN","BMXADOXX",138,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOXX",139,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOXX",140,0) + S ^TMP("BMX ADO",$J,NODE)="2815^`8718^`9285^`8337^DM II ON SPECIAL MEDS^2^P"_$C(30) +"RTN","BMXADOXX",141,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",142,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) +"RTN","BMXADOXX",143,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",144,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) +"RTN","BMXADOXX",145,0) + Q +"RTN","BMXADOXX",146,0) + ; +"RTN","BMXADOXX",147,0) +PROB ; DISPLAY PROBLEMS +"RTN","BMXADOXX",148,0) + N OUT,%,SIEN,DFN +"RTN","BMXADOXX",149,0) + S DFN=1373 +"RTN","BMXADOXX",150,0) + S SIEN=$$SCHEMA("VIEW PROBLEMS") +"RTN","BMXADOXX",151,0) + D SS^BMXADO(.OUT,SIEN,"","AA~"_DFN_"~"_DFN_"~~~~~") +"RTN","BMXADOXX",152,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",153,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",154,0) + Q +"RTN","BMXADOXX",155,0) + ; +"RTN","BMXADOXX",156,0) +ADDPROB ; ADD A PROBLEM TO THE PROBLEM LIST +"RTN","BMXADOXX",157,0) + N OUT,%,SIEN,DFN,NODE,NUM,LOC,ICD,TEXT,AIR,IEN +"RTN","BMXADOXX",158,0) + S ICD=2477 +"RTN","BMXADOXX",159,0) + S TEXT="HYPERTENSION ON SPECIAL MEDS" +"RTN","BMXADOXX",160,0) + S DFN=1373,LOC=DUZ(2) +"RTN","BMXADOXX",161,0) + S SIEN=$$SCHEMA("UPDATE PROBLEMS") +"RTN","BMXADOXX",162,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOXX",163,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOXX",164,0) + S ^TMP("BMX ADO",$J,NODE)=U_"`"_ICD_U_"`"_DFN_U_DT_U_U_TEXT_U_"`"_LOC_U_DT_U_$C(30) +"RTN","BMXADOXX",165,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",166,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) +"RTN","BMXADOXX",167,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",168,0) + S IEN=+$P(OUT(1),"|",2) I '$D(^AUPNPROB(IEN,0)) Q +"RTN","BMXADOXX",169,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) +"RTN","BMXADOXX",170,0) + K OUT +"RTN","BMXADOXX",171,0) + S NUM=$$NEXTNUM(DFN,LOC) I 'NUM Q +"RTN","BMXADOXX",172,0) + S SIEN=$$SCHEMA("UPDATE PROBLEM NUMBER") +"RTN","BMXADOXX",173,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOXX",174,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOXX",175,0) + S ^TMP("BMX ADO",$J,NODE)=IEN_U_NUM_U_"A"_$C(30) +"RTN","BMXADOXX",176,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",177,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) +"RTN","BMXADOXX",178,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",179,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) +"RTN","BMXADOXX",180,0) + Q +"RTN","BMXADOXX",181,0) + ; +"RTN","BMXADOXX",182,0) +MEAS ; DISPLAY MEASUREMENTS +"RTN","BMXADOXX",183,0) + N OUT,%,SIEN,DFN +"RTN","BMXADOXX",184,0) + S DFN=2 +"RTN","BMXADOXX",185,0) + S SIEN=$$SCHEMA("VIEW MEASUREMENTS") +"RTN","BMXADOXX",186,0) + D SS^BMXADO(.OUT,SIEN,"","AA~3/21/1965~6/4/2004~10~~~~"_DFN_"|WT|C") +"RTN","BMXADOXX",187,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",188,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",189,0) + Q +"RTN","BMXADOXX",190,0) + ; +"RTN","BMXADOXX",191,0) +ADDMEAS ; UPDATE V MEASUREMENT FILE +"RTN","BMXADOXX",192,0) + N OUT,%,SIEN,DFN,NODE +"RTN","BMXADOXX",193,0) + S DFN=2 +"RTN","BMXADOXX",194,0) + S SIEN=$$SCHEMA("UPDATE MEASUREMENTS") +"RTN","BMXADOXX",195,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOXX",196,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOXX",197,0) + S ^TMP("BMX ADO",$J,NODE)="^`2^`"_DFN_"^`7806^172.75"_$C(30) +"RTN","BMXADOXX",198,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",199,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) +"RTN","BMXADOXX",200,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",201,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) +"RTN","BMXADOXX",202,0) + Q +"RTN","BMXADOXX",203,0) + ; +"RTN","BMXADOXX",204,0) +MEDS ; DISPLAY MEDS +"RTN","BMXADOXX",205,0) + N OUT,%,SIEN,DFN +"RTN","BMXADOXX",206,0) + S DFN=152 +"RTN","BMXADOXX",207,0) + S SIEN=$$SCHEMA("VIEW MEDS") +"RTN","BMXADOXX",208,0) + D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1969~12/31/2004~10~~~~"_DFN_"|C") +"RTN","BMXADOXX",209,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",210,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",211,0) + Q +"RTN","BMXADOXX",212,0) + ; +"RTN","BMXADOXX",213,0) +ADDMEDS ; UPDATE V MED FILE +"RTN","BMXADOXX",214,0) + N OUT,%,SIEN,DFN,NODE +"RTN","BMXADOXX",215,0) + S DFN=2 +"RTN","BMXADOXX",216,0) + S SIEN=$$SCHEMA("UPDATE MEDS") +"RTN","BMXADOXX",217,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOXX",218,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOXX",219,0) + S ^TMP("BMX ADO",$J,NODE)="^`305^`"_DFN_"^`7806^T1T QID^40"_$C(30) +"RTN","BMXADOXX",220,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",221,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) +"RTN","BMXADOXX",222,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",223,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) +"RTN","BMXADOXX",224,0) + Q +"RTN","BMXADOXX",225,0) + ; +"RTN","BMXADOXX",226,0) +LAB ; DISPLAY LAB TEST RESULTS +"RTN","BMXADOXX",227,0) + N OUT,%,SIEN,DFN +"RTN","BMXADOXX",228,0) + S DFN=280 +"RTN","BMXADOXX",229,0) + S SIEN=$$SCHEMA("VIEW LABS") +"RTN","BMXADOXX",230,0) + D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1965~12/31/2003~10~~~~"_DFN_"|175|C") +"RTN","BMXADOXX",231,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",232,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",233,0) + Q +"RTN","BMXADOXX",234,0) + ; +"RTN","BMXADOXX",235,0) +ADDLAB ; UPDATE V LAB +"RTN","BMXADOXX",236,0) + N OUT,%,SIEN,DFN,NODE +"RTN","BMXADOXX",237,0) + S DFN=2 +"RTN","BMXADOXX",238,0) + S SIEN=$$SCHEMA("UPDATE LABS") +"RTN","BMXADOXX",239,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOXX",240,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOXX",241,0) + S ^TMP("BMX ADO",$J,NODE)="^`175^`"_DFN_"^`7806^216"_$C(30) +"RTN","BMXADOXX",242,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",243,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) +"RTN","BMXADOXX",244,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",245,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) +"RTN","BMXADOXX",246,0) + Q +"RTN","BMXADOXX",247,0) + ; +"RTN","BMXADOXX",248,0) +EXAMS ; DISPLAY EXAMS +"RTN","BMXADOXX",249,0) + N OUT,%,SIEN,DFN +"RTN","BMXADOXX",250,0) + S DFN=1373 +"RTN","BMXADOXX",251,0) + S SIEN=$$SCHEMA("VIEW EXAMS") +"RTN","BMXADOXX",252,0) + D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1966~12/31/2003~10~~~~"_DFN_"|6|C") +"RTN","BMXADOXX",253,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",254,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",255,0) + Q +"RTN","BMXADOXX",256,0) + ; +"RTN","BMXADOXX",257,0) +ADDEXAMS ; UPDATE V EXAM +"RTN","BMXADOXX",258,0) + S DFN=2 +"RTN","BMXADOXX",259,0) + S SIEN=$$SCHEMA("UPDATE EXAMS") +"RTN","BMXADOXX",260,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOXX",261,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOXX",262,0) + S ^TMP("BMX ADO",$J,NODE)="^`6^`"_DFN_"^`7806^NORMAL"_$C(30) +"RTN","BMXADOXX",263,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",264,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) +"RTN","BMXADOXX",265,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",266,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) +"RTN","BMXADOXX",267,0) + Q +"RTN","BMXADOXX",268,0) + ; +"RTN","BMXADOXX",269,0) +IMM ; DISPLAY IMMUNIZATIONS +"RTN","BMXADOXX",270,0) + N OUT,%,SIEN,DFN +"RTN","BMXADOXX",271,0) + S DFN=54 +"RTN","BMXADOXX",272,0) + S SIEN=$$SCHEMA("VIEW IMM") +"RTN","BMXADOXX",273,0) + D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1966~12/31/2003~10~~~~"_DFN_"|101|C") +"RTN","BMXADOXX",274,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",275,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",276,0) + Q +"RTN","BMXADOXX",277,0) + ; +"RTN","BMXADOXX",278,0) +PROV ; DISPLAY PROVIDERS FOR A VISIT +"RTN","BMXADOXX",279,0) + N OUT,%,SIEN,VIEN +"RTN","BMXADOXX",280,0) + S VIEN=4703 +"RTN","BMXADOXX",281,0) + S SIEN=$$SCHEMA("VIEW PROV") +"RTN","BMXADOXX",282,0) + D SS^BMXADO(.OUT,SIEN,"","AD~"_VIEN_"~"_VIEN_"~10~~~~") +"RTN","BMXADOXX",283,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",284,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",285,0) + Q +"RTN","BMXADOXX",286,0) + ; +"RTN","BMXADOXX",287,0) +ADDPROV ; UPDATE V PROVIDER FILE +"RTN","BMXADOXX",288,0) + N OUT,%,SIEN,NODE,PIEN,DFN +"RTN","BMXADOXX",289,0) + S PIEN=DUZ,DFN=2 +"RTN","BMXADOXX",290,0) + I $P(^DD(9000010.06,.01,0),U,3)["DIC(6" S PIEN=$P(^VA(200,PIEN,0),U,16) ; CONVERT FILE 200 TO FILE 16 IF NECESS. +"RTN","BMXADOXX",291,0) + S SIEN=$$SCHEMA("UPDATE PROV") +"RTN","BMXADOXX",292,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOXX",293,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOXX",294,0) + S ^TMP("BMX ADO",$J,NODE)="^`"_PIEN_"^`"_DFN_"^`7806^P"_$C(30) +"RTN","BMXADOXX",295,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",296,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) +"RTN","BMXADOXX",297,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",298,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) +"RTN","BMXADOXX",299,0) + Q +"RTN","BMXADOXX",300,0) + ; +"RTN","BMXADOXX",301,0) +PROC ; DISPLAY PROCEDURES +"RTN","BMXADOXX",302,0) + N OUT,%,SIEN,DFN +"RTN","BMXADOXX",303,0) + S DFN=235 +"RTN","BMXADOXX",304,0) + S SIEN=$$SCHEMA("VIEW PROCEDURES") +"RTN","BMXADOXX",305,0) + D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1965~12/31/2003~10~~~~"_DFN_"|C") +"RTN","BMXADOXX",306,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",307,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",308,0) + Q +"RTN","BMXADOXX",309,0) + ; +"RTN","BMXADOXX",310,0) +ADDPROC ; UPDATE V PROCEDURES FILE +"RTN","BMXADOXX",311,0) + N OUT,%,SIEN,DFN,NODE +"RTN","BMXADOXX",312,0) + S DFN=2 +"RTN","BMXADOXX",313,0) + S SIEN=$$SCHEMA("UPDATE PROCEDURES") +"RTN","BMXADOXX",314,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOXX",315,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOXX",316,0) + S ^TMP("BMX ADO",$J,NODE)="^`2198^`"_DFN_"^`7806^`8718"_$C(30) +"RTN","BMXADOXX",317,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",318,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) +"RTN","BMXADOXX",319,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",320,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) +"RTN","BMXADOXX",321,0) + Q +"RTN","BMXADOXX",322,0) + ; +"RTN","BMXADOXX",323,0) +CPT ; DISPLAY CPT CODES +"RTN","BMXADOXX",324,0) + N OUT,%,SIEN,DFN +"RTN","BMXADOXX",325,0) + S VIEN=8082 +"RTN","BMXADOXX",326,0) + S SIEN=$$SCHEMA("VIEW CPT") +"RTN","BMXADOXX",327,0) + D SS^BMXADO(.OUT,SIEN,"","AD~"_VIEN_"~"_VIEN_"~10~~~~") +"RTN","BMXADOXX",328,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",329,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",330,0) + Q +"RTN","BMXADOXX",331,0) + ; +"RTN","BMXADOXX",332,0) +ADDCPT ; UPDATE V CPT FILE +"RTN","BMXADOXX",333,0) + N OUT,%,SIEN,DFN,NODE +"RTN","BMXADOXX",334,0) + S DFN=2 +"RTN","BMXADOXX",335,0) + S SIEN=$$SCHEMA("UPDATE CPT") +"RTN","BMXADOXX",336,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOXX",337,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOXX",338,0) + S ^TMP("BMX ADO",$J,NODE)="^`10000^`"_DFN_"^`7806"_$C(30) +"RTN","BMXADOXX",339,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",340,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) +"RTN","BMXADOXX",341,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",342,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) +"RTN","BMXADOXX",343,0) + Q +"RTN","BMXADOXX",344,0) + ; +"RTN","BMXADOXX",345,0) +PH ; DISPLAY PERSONAL HISTORY +"RTN","BMXADOXX",346,0) + N OUT,%,SIEN,DFN +"RTN","BMXADOXX",347,0) + S DFN=1373 +"RTN","BMXADOXX",348,0) + S SIEN=$$SCHEMA("VIEW PERSONAL HISTORY") +"RTN","BMXADOXX",349,0) + D SS^BMXADO(.OUT,SIEN,"","AC~"_DFN_"~"_DFN_"~~~~~") +"RTN","BMXADOXX",350,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",351,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",352,0) + Q +"RTN","BMXADOXX",353,0) + ; +"RTN","BMXADOXX",354,0) +ADDPH ; UPDATE PERSONAL HX +"RTN","BMXADOXX",355,0) + N OUT,%,SIEN,DFN,NODE,ICD,TEXT +"RTN","BMXADOXX",356,0) + S ICD=2477 +"RTN","BMXADOXX",357,0) + S TEXT="PERSONAL HISTORY OF SERIOUS PROBLEMS" +"RTN","BMXADOXX",358,0) + S DFN=2 +"RTN","BMXADOXX",359,0) + S SIEN=$$SCHEMA("UPDATE PERSONAL HISTORY") +"RTN","BMXADOXX",360,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOXX",361,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOXX",362,0) + S ^TMP("BMX ADO",$J,NODE)="^`11353^`"_DFN_"^2851219^"_TEXT_"^2810303"_$C(30) +"RTN","BMXADOXX",363,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",364,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) +"RTN","BMXADOXX",365,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",366,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) +"RTN","BMXADOXX",367,0) + Q +"RTN","BMXADOXX",368,0) + ; +"RTN","BMXADOXX",369,0) +FH ; DISPLAY FAMILY HX +"RTN","BMXADOXX",370,0) + N OUT,%,SIEN,DFN +"RTN","BMXADOXX",371,0) + S DFN=631 +"RTN","BMXADOXX",372,0) + S SIEN=$$SCHEMA("VIEW FAMILY HISTORY") +"RTN","BMXADOXX",373,0) + D SS^BMXADO(.OUT,SIEN,"","AC~"_DFN_"~"_DFN_"~~~~~") +"RTN","BMXADOXX",374,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",375,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",376,0) + Q +"RTN","BMXADOXX",377,0) + ; +"RTN","BMXADOXX",378,0) +ADDFH ; UPDATE FAMILY HISTORY +"RTN","BMXADOXX",379,0) + N OUT,%,SIEN,DFN,NODE,ICD,TEXT +"RTN","BMXADOXX",380,0) + S ICD=2477 +"RTN","BMXADOXX",381,0) + S TEXT="FAMILY HISTORY OF SERIOUS PROBLEMS" +"RTN","BMXADOXX",382,0) + S DFN=2 +"RTN","BMXADOXX",383,0) + S SIEN=$$SCHEMA("UPDATE FAMILY HISTORY") +"RTN","BMXADOXX",384,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOXX",385,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOXX",386,0) + S ^TMP("BMX ADO",$J,NODE)="^`7571^`"_DFN_"^2851219^"_TEXT_$C(30) +"RTN","BMXADOXX",387,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",388,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) +"RTN","BMXADOXX",389,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",390,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) +"RTN","BMXADOXX",391,0) + Q +"RTN","BMXADOXX",392,0) + ; +"RTN","BMXADOXX",393,0) +HF ; DISPLAY HEALTH FACTORS +"RTN","BMXADOXX",394,0) + N OUT,%,SIEN,DFN +"RTN","BMXADOXX",395,0) + S DFN=2390 +"RTN","BMXADOXX",396,0) + S SIEN=$$SCHEMA("VIEW HEALTH FACTORS") +"RTN","BMXADOXX",397,0) + D SS^BMXADO(.OUT,SIEN,"","AC"_"~"_DFN_"~"_DFN_"~~~~~") +"RTN","BMXADOXX",398,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",399,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",400,0) + Q +"RTN","BMXADOXX",401,0) + ; +"RTN","BMXADOXX",402,0) +ADDHF ; UPDATE HEALTH FACTORS FILE +"RTN","BMXADOXX",403,0) + N OUT,%,SIEN,DFN,NODE +"RTN","BMXADOXX",404,0) + S DFN=2 +"RTN","BMXADOXX",405,0) + S SIEN=$$SCHEMA("UPDATE HEALTH FACTORS") +"RTN","BMXADOXX",406,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOXX",407,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOXX",408,0) + S ^TMP("BMX ADO",$J,NODE)="^`3^`"_DFN_U_DT_$C(30) +"RTN","BMXADOXX",409,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",410,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) +"RTN","BMXADOXX",411,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",412,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) +"RTN","BMXADOXX",413,0) + Q +"RTN","BMXADOXX",414,0) + ; +"RTN","BMXADOXX",415,0) +REPRO ; DISPLAY REPRODUCTIVE FACTORS +"RTN","BMXADOXX",416,0) + N OUT,%,SIEN,DFN +"RTN","BMXADOXX",417,0) + S DFN=1373 +"RTN","BMXADOXX",418,0) + S SIEN=$$SCHEMA("VIEW REPRODUCTIVE FACTORS") +"RTN","BMXADOXX",419,0) + D SS^BMXADO(.OUT,SIEN,"","B"_"~"_DFN_"~"_DFN_"~~~~~") +"RTN","BMXADOXX",420,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",421,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",422,0) + Q +"RTN","BMXADOXX",423,0) + ; +"RTN","BMXADOXX",424,0) +ADDREPRO ; UPDATE REPRODUCTIVE FACTORS +"RTN","BMXADOXX",425,0) + ; THE .O1 FIELD IS DINUMED +"RTN","BMXADOXX",426,0) + ; THEREFORE, THE FILER WILL AUTOMATICALLY SWITCH TO MOD MODE IF A RECORD ALREADY EXISTS FOR THIS PATIENT +"RTN","BMXADOXX",427,0) + N OUT,%,SIEN,DFN,NODE +"RTN","BMXADOXX",428,0) + S DFN=2 +"RTN","BMXADOXX",429,0) + ; I $D(^AUPNREP(DFN)) G ERF +"RTN","BMXADOXX",430,0) + S SIEN=$$SCHEMA("UPDATE REPRODUCTIVE FACTORS") +"RTN","BMXADOXX",431,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOXX",432,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOXX",433,0) + S ^TMP("BMX ADO",$J,NODE)="^`"_DFN_"^G5P4LC3SA1TA0^"_DT_"^2^3040101^"_DT_$C(30) +"RTN","BMXADOXX",434,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXX",435,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) +"RTN","BMXADOXX",436,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXX",437,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) +"RTN","BMXADOXX",438,0) + Q +"RTN","BMXADOXX",439,0) + ; +"RTN","BMXADOXY") +0^78^B61093377 +"RTN","BMXADOXY",1,0) +BMXADOXY ; IHS/CIHA/GIS - RPC CALL: GENERATE AN ADO SCHEMA STRING AND DATA SET ; +"RTN","BMXADOXY",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXADOXY",3,0) + ; EXMAPLES OF FILEMAN SCHEMA GENERATION +"RTN","BMXADOXY",4,0) + ; +"RTN","BMXADOXY",5,0) + ; +"RTN","BMXADOXY",6,0) + ; +"RTN","BMXADOXY",7,0) +DISP(OUT) ; TEMP DISPLAY OF THE ANR +"RTN","BMXADOXY",8,0) + N I,X +"RTN","BMXADOXY",9,0) + S I=0 W ! +"RTN","BMXADOXY",10,0) + F S I=$O(@OUT@(I)) Q:'I S X=@OUT@(I) S X=$TR(X,$C(30),"}") S X=$TR(X,$C(31),"{") W !,X +"RTN","BMXADOXY",11,0) + Q +"RTN","BMXADOXY",12,0) + ; +"RTN","BMXADOXY",13,0) +SCHEMA(NAME) ; GIVEN SCHEMA NAME, RETURN THE IEN +"RTN","BMXADOXY",14,0) + N IEN +"RTN","BMXADOXY",15,0) + S IEN=$O(^BMXADO("B",NAME,0)) +"RTN","BMXADOXY",16,0) + Q IEN +"RTN","BMXADOXY",17,0) + ; +"RTN","BMXADOXY",18,0) +NUM ; ITERATE BY IEN +"RTN","BMXADOXY",19,0) + ; IX="",START WITH IEN=1, STOP AFTER IEN=20, MAX # RECORDS RETURNED = 5 +"RTN","BMXADOXY",20,0) + ; TO VIEW INTERNAL VALUES SET VSTG="~1~20~5~I" +"RTN","BMXADOXY",21,0) + N OUT,%,SIEN +"RTN","BMXADOXY",22,0) + S SIEN=$$SCHEMA("IHS PATIENT") +"RTN","BMXADOXY",23,0) + D SS^BMXADO(.OUT,SIEN,"","~1~20~5") +"RTN","BMXADOXY",24,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXY",25,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXY",26,0) + Q +"RTN","BMXADOXY",27,0) + ; +"RTN","BMXADOXY",28,0) +IX ; ITERATE BY INDEX +"RTN","BMXADOXY",29,0) + ; ITERATE USING THE "B" INDEX +"RTN","BMXADOXY",30,0) + ; START WITH PT NAME "C", STOP AFTER PATIENT NAME = "D", MAX # RECORDS RETURNED = 5 +"RTN","BMXADOXY",31,0) + N OUT,%,SIEN +"RTN","BMXADOXY",32,0) + S SIEN=$$SCHEMA("IHS PATIENT") +"RTN","BMXADOXY",33,0) + D SS^BMXADO(.OUT,SIEN,"","B~C~D~5") +"RTN","BMXADOXY",34,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXY",35,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXY",36,0) + Q +"RTN","BMXADOXY",37,0) + ; +"RTN","BMXADOXY",38,0) +RENT ; ITERATE IN CHUNKS +"RTN","BMXADOXY",39,0) + ; RE-ITERATE USING THE "B" INDEX +"RTN","BMXADOXY",40,0) + ; START WITH PT IEN 5 AS THE "SEED", STOP AFTER PATIENT NAME = "D", MAX # RECORDS RETURNED = 5 +"RTN","BMXADOXY",41,0) + N OUT,%,SIEN,SEED,LSEED,X,Y +"RTN","BMXADOXY",42,0) + S SEED=0,LSEED="" +"RTN","BMXADOXY",43,0) + S SIEN=$$SCHEMA("IHS PATIENT") +"RTN","BMXADOXY",44,0) +RIT F D I '$G(SEED) Q +"RTN","BMXADOXY",45,0) + . D SS^BMXADO(.OUT,SIEN,SEED,"B~CA~CB~5") +"RTN","BMXADOXY",46,0) + . D DISP(OUT) R %:$G(DTIME,60) E S SEED="" Q +"RTN","BMXADOXY",47,0) + . I %?1"^" S SEED="" Q +"RTN","BMXADOXY",48,0) + . S X=$P(@OUT@(1),U,1) +"RTN","BMXADOXY",49,0) + . S SEED=$P(X,"|",3) +"RTN","BMXADOXY",50,0) + . I SEED=LSEED S SEED="" Q +"RTN","BMXADOXY",51,0) + . S LSEED=SEED +"RTN","BMXADOXY",52,0) + . K ^TMP("BMX ADO",$J) +"RTN","BMXADOXY",53,0) + . Q +"RTN","BMXADOXY",54,0) + Q +"RTN","BMXADOXY",55,0) + ; +"RTN","BMXADOXY",56,0) +SUB ; SUBFILE ITERATION +"RTN","BMXADOXY",57,0) + ; THE SCHEMA IS ATTACHED TO THE MEDICARE ELIGIBILITY FILE/ELIG DATE SUBFILE +"RTN","BMXADOXY",58,0) + ; THE DA STRING HAS A VALUE OF '4,',: THE IEN IN THE PARENT FILE (PATIENT DFN). +"RTN","BMXADOXY",59,0) + ; NOTE THE COMMA IN THE DA STRING. THIS INDICATES THAT THE FILE IEN IS 4 BUT THE SUBFILE IEN IS UNSPECIFIED +"RTN","BMXADOXY",60,0) + N OUT,%,SIEN +"RTN","BMXADOXY",61,0) + S SIEN=$$SCHEMA("UPDATE MEDICARE DATES") +"RTN","BMXADOXY",62,0) + ;D SS^BMXADO(.OUT,SIEN,"1,","~~~") +"RTN","BMXADOXY",63,0) + D SS^BMXADO(.OUT,18,"1,","~~~") +"RTN","BMXADOXY",64,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXY",65,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXY",66,0) + Q +"RTN","BMXADOXY",67,0) + ; +"RTN","BMXADOXY",68,0) +DINUM ; DINUMED POINTER ITERATION +"RTN","BMXADOXY",69,0) + ; THE SCHEMA IS ATTACHED TO THE PATIENT FILE (9000001) +"RTN","BMXADOXY",70,0) + ; THE PATIENT FILE IS DINUM'D AND ITS .01 FIELD POINTS TO THE VA PATIENT FILE (2) +"RTN","BMXADOXY",71,0) + ; BECAUSE OF THE SPECIAL RELATIONSHIP BETWEEN THE FILES, WE CAN USE THE B INDEX OF FILE 2 TO ITERATE FILE 9000001. +"RTN","BMXADOXY",72,0) + N OUT,%,SIEN +"RTN","BMXADOXY",73,0) + S SIEN=$$SCHEMA("IHS PATIENT") +"RTN","BMXADOXY",74,0) + D SS^BMXADO(.OUT,SIEN,"","B~A~B~5") +"RTN","BMXADOXY",75,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXY",76,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXY",77,0) + Q +"RTN","BMXADOXY",78,0) + ; +"RTN","BMXADOXY",79,0) +IXP ; INDEXED POINTER ITERATION +"RTN","BMXADOXY",80,0) + ; THE SCHEMA IS ATTACHED TO THE V POV FILE +"RTN","BMXADOXY",81,0) + ; THE AC CROSS REFERENCE INDEXES THE PATIENT FIELD +"RTN","BMXADOXY",82,0) + ; BY STARTING AND STOPING WITH PATIENT 235 (MAX=5) WE COLLECT THE FIRST 5 POVS FOR PATIENT 235 IN THE FILE +"RTN","BMXADOXY",83,0) + N OUT,%,SIEN +"RTN","BMXADOXY",84,0) + S SIEN=$$SCHEMA("VIEW POVS") +"RTN","BMXADOXY",85,0) + D SS^BMXADO(.OUT,SIEN,"","AC~235~235~5") +"RTN","BMXADOXY",86,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXY",87,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXY",88,0) + Q +"RTN","BMXADOXY",89,0) + ; +"RTN","BMXADOXY",90,0) +AA ; ITERATE USING AA INDEX +"RTN","BMXADOXY",91,0) + ; INDEX IS 'AA" THE START AND STOP DATES ARE SPECIFIED IN EXTERNAL FORMAT. MAX=10 +"RTN","BMXADOXY",92,0) + ; THE FOLLOWING FILTERS ARE SPECIFIED IN THE LAST PARAMETER ("235|WT|C"): +"RTN","BMXADOXY",93,0) + ; 235=PATIENT DFN #235 +"RTN","BMXADOXY",94,0) + ; WT=RETURN ONLY WEIGHTS. MEASUREMENT TYPE MUST BE SPECIFIED WITH A VALID, UNAMBIGUOUS LOOKUP VALUE. +"RTN","BMXADOXY",95,0) + ; C=RETRUN VALUES IN CHRONOLOGICAL ORDER USE 'R' INSTEAD OF 'C' FOR REVERSE CHRONOLOGICAL ORDER. DEFAULT=C +"RTN","BMXADOXY",96,0) + ; THE SEED PARAMTER IS SET AND CAN BE USED TO RETURN DATA IN CHUNKS +"RTN","BMXADOXY",97,0) + N OUT,%,SIEN +"RTN","BMXADOXY",98,0) + S SIEN=$$SCHEMA("VIEW MEASUREMENTS") +"RTN","BMXADOXY",99,0) + D SS^BMXADO(.OUT,SIEN,"","AA~3/21/1965~6/4/2004~5~~~~235|WT|C") +"RTN","BMXADOXY",100,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXY",101,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXY",102,0) + Q +"RTN","BMXADOXY",103,0) + ; +"RTN","BMXADOXY",104,0) +AA2 ; ITERATE USING AA INDEX +"RTN","BMXADOXY",105,0) + ; THIS SCHEMA IS ATTACHED TO THE VISIT FILE (9000010) +"RTN","BMXADOXY",106,0) + ; IN THIS CASE THERE IS NO ATTRIBUTE TYPE SO THE FILTER PARAM HAS ONLY 2 PIECES "1|R" +"RTN","BMXADOXY",107,0) + ; 235=PATIENT DFN +"RTN","BMXADOXY",108,0) + ; R=RETURN DATA IN REVERSE CHRONOLOGICAL ORDER +"RTN","BMXADOXY",109,0) + N OUT,%,SIEN +"RTN","BMXADOXY",110,0) + S SIEN=$$SCHEMA("VISITS") ;12 +"RTN","BMXADOXY",111,0) + D SS^BMXADO(.OUT,SIEN,"","AA~3/21/1965~6/4/2004~5~~~~235|R") +"RTN","BMXADOXY",112,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXY",113,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXY",114,0) + Q +"RTN","BMXADOXY",115,0) + ; +"RTN","BMXADOXY",116,0) +CIT ; CUSTOM ITERATOR +"RTN","BMXADOXY",117,0) + ; IF COMPLEX OR UNUSUAL SORTING/FILTERING IS REQUITED, USE A CUSTOM ITERATOR +"RTN","BMXADOXY",118,0) + ; THE CUSTOM ITERATOR IS DEFINED BY 6TH, 7TH AND 8TH PIECES IN THE VSTG +"RTN","BMXADOXY",119,0) + ; PIECE 8=TAG, PIECE 9=ROUTINE, PIECE 8=A PARAMETER PASSED TO THE ENTRY POINT +"RTN","BMXADOXY",120,0) + ; THE 9TH PIECE CONTAINS PT DFN, TIMESTAMP, VISIT TYPE, LOC IEN, AND SERVICE CATEGORY IN A "|" DELIMTED STRING +"RTN","BMXADOXY",121,0) + ; THE ITERATOR CALL TAG^ROUTINE(PARAM) TO GENERATE IENS +"RTN","BMXADOXY",122,0) + ; IN THIS CASE THE SCHEMA IS ATTACHED TO THE VISIT FILE. +"RTN","BMXADOXY",123,0) + ; GIVEN THE INFORMATION IN THE PARAMETER, THE CUSTOM ITERATOR RETURNS POSSIBLE DUPLICATE VISITS +"RTN","BMXADOXY",124,0) + N OUT,%,SIEN +"RTN","BMXADOXY",125,0) + S SIEN=$$SCHEMA("VISITS") +"RTN","BMXADOXY",126,0) + D SS^BMXADO(.OUT,SIEN,"","~~~~~DUPV~BMXADOV2~9285|5/24/04@1PM|I|516|~") +"RTN","BMXADOXY",127,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXY",128,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXY",129,0) + Q +"RTN","BMXADOXY",130,0) + ; +"RTN","BMXADOXY",131,0) +ID ; IDENTIFIER FIELD +"RTN","BMXADOXY",132,0) + ; THE SCHEMA IS ATTACHED TO THE VA PATIENT FILE (2) +"RTN","BMXADOXY",133,0) + ; THE SCHEMA HAS A BUILT IN FIELD (.01ID) THAT RETURNS THE IDENTIFIERS +"RTN","BMXADOXY",134,0) + ; THE ENTRY POINT THAT GENERATES THE IDETIFIERS IS STORED IN THE BMX ADO SCHEMA FILE +"RTN","BMXADOXY",135,0) + ; PATIENT DFN=235 +"RTN","BMXADOXY",136,0) + N OUT,%,SIEN +"RTN","BMXADOXY",137,0) + S SIEN=$$SCHEMA("UPDATE PATIENT DEMOGRAPHICS") +"RTN","BMXADOXY",138,0) + D SS^BMXADO(.OUT,SIEN,"","~235~235~") +"RTN","BMXADOXY",139,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXY",140,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXY",141,0) + Q +"RTN","BMXADOXY",142,0) + ; +"RTN","BMXADOXY",143,0) +JSTD ; STANDARD JOIN +"RTN","BMXADOXY",144,0) + ; BY SPECIFYING A JOIN IN THE VSTG, MULTIPLE SCHEMAE AND DATA SETS ARE RETURNED IN ONE PASS +"RTN","BMXADOXY",145,0) + ; THE SCHEMA IS ATTACHED TO THE V MEASUREMENT FILE +"RTN","BMXADOXY",146,0) + ; THIS IS JOINED TO A SECOND FILE, THE VA PATIENT FILE VIA A JOIN +"RTN","BMXADOXY",147,0) + ; THE JOIN IS BASTED ON THE FACT THAT THE PATIENT FIELD (.02) IN THE V MEASUREMENT FILE POINTS TO THE VA PATIENT FILE +"RTN","BMXADOXY",148,0) + ; THE JOIN PARAMETER IS THE 9TH PIECE OF THE VSTG. IT CONSISTS OF 2 PIECES DELIMITED BY A "," +"RTN","BMXADOXY",149,0) + ; PIECE 1 IS THE SCHEMA THAT YOU ARE JOINING TO +"RTN","BMXADOXY",150,0) + ; PIECE 2 IS THE FIELD IN THE PRIMARY FILE THAT ENABLES THE JOIN +"RTN","BMXADOXY",151,0) + ; THE DATA SET FROM THE SECOND (JOIN) FILE CONTAINS ONLY THOSE RECORDS NECESSARY TO COMPLETE THE JOIN +"RTN","BMXADOXY",152,0) + ; PATIENT DFN=235, INDEX=AA, MAX=5, START=3/21/65, STOP=6/4/04 +"RTN","BMXADOXY",153,0) + N OUT,%,SIEN1,SIEN2 +"RTN","BMXADOXY",154,0) + S SIEN2=$$SCHEMA("VIEW MEASUREMENTS") +"RTN","BMXADOXY",155,0) + S SIEN1=$$SCHEMA("PATIENT DEMOGRAPHICS") +"RTN","BMXADOXY",156,0) + ;SIEN1=23, SIEN2=11 +"RTN","BMXADOXY",157,0) + ;D SS^BMXADO(.OUT,SIEN1,"","AA~3/21/1965~6/4/2004~5~~~~234|WT|C~"_SIEN2_",.02") +"RTN","BMXADOXY",158,0) + D SS^BMXADO(.OUT,SIEN1,"","~234~236~~~~~~"_SIEN2_",.01") +"RTN","BMXADOXY",159,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXY",160,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXY",161,0) + Q +"RTN","BMXADOXY",162,0) + ; +"RTN","BMXADOXY",163,0) +HWSTD ; +"RTN","BMXADOXY",164,0) + ; PATIENT DFN=235, INDEX=AA, MAX=5, START=3/21/65, STOP=6/4/04 +"RTN","BMXADOXY",165,0) + N OUT,%,SIEN1,SIEN2 +"RTN","BMXADOXY",166,0) + S SIEN1=$$SCHEMA("PATIENT DEMOGRAPHICS") +"RTN","BMXADOXY",167,0) + S SIEN2=$$SCHEMA("VIEW MEASUREMENTS") +"RTN","BMXADOXY",168,0) + ;SIEN2=23, SIEN1=11 +"RTN","BMXADOXY",169,0) + D SS^BMXADO(.OUT,SIEN1,"","~235~250~~~~~~"_SIEN2_",.01") +"RTN","BMXADOXY",170,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXY",171,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXY",172,0) + Q +"RTN","BMXADOXY",173,0) + ; +"RTN","BMXADOXY",174,0) +JMD ;JOIN MASTER TO DETAIL +"RTN","BMXADOXY",175,0) + N OUT,%,SIEN1,SIEN2,SIEN3,VSTG +"RTN","BMXADOXY",176,0) + S SIEN1=$$SCHEMA("PATIENT DEMOGRAPHICS") +"RTN","BMXADOXY",177,0) + S SIEN2=$$SCHEMA("VIEW MEASUREMENTS") +"RTN","BMXADOXY",178,0) + S SIEN3=$$SCHEMA("VIEW MEDS") +"RTN","BMXADOXY",179,0) + S VSTG="~1~5~~~~~~" +"RTN","BMXADOXY",180,0) + ;S VSTG=VSTG_SIEN3_",.001,.02IEN,AA~1/1/1960~6/30/2004~~~~~|C" +"RTN","BMXADOXY",181,0) + S VSTG=VSTG_SIEN3_",.001,.02IEN,AA~1/1/1960~6/30/2004~~~~~|C" +"RTN","BMXADOXY",182,0) + ;S VSTG="~1~5~~~~~~23,.001,.02IEN,AA~1/1/1960~6/30/2004~~~~~|WT|C" +"RTN","BMXADOXY",183,0) + ;BMX ADO SS^11^^~1~5~~~~~~23,.001,.02IEN,AA~1/1/1960~6/30/2004~~~~~|WT|C +"RTN","BMXADOXY",184,0) + ;BMX ADO SS^11^^~1~5~~~~~~25,.001,.02IEN,AA~1/1/1960~6/30/2004~~~~~|C +"RTN","BMXADOXY",185,0) + D SS^BMXADO(.OUT,SIEN1,"",VSTG) +"RTN","BMXADOXY",186,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXY",187,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXY",188,0) + Q +"RTN","BMXADOXY",189,0) + ; +"RTN","BMXADOXY",190,0) +JSUB ; SUBFILE JOIN +"RTN","BMXADOXY",191,0) + ; IN THIS CASE THE RECORDS IN A PARENT FILE ARE "JOINED" TO THE RECORDS IN ONE OF ITS SUB FILES +"RTN","BMXADOXY",192,0) + ; THE SCHEMA IS ATTACHED TO THE "MEDICARE ELIGIBLE" FILE +"RTN","BMXADOXY",193,0) + ; IT IS JOINED TO ITS SUBFILE, "ELIG DATES", VIA THE UPDATE MEDICARE DATES SCHEMA +"RTN","BMXADOXY",194,0) + ; THE SYNTAX FOR THE JOIN PIECE IS "sien2,SUB" WHERE sien2=IEN OF SECOND SCHEMA +"RTN","BMXADOXY",195,0) + ; PATIENT DFN=4 +"RTN","BMXADOXY",196,0) + N OUT,%,SIEN1,SIEN2 +"RTN","BMXADOXY",197,0) + S SIEN1=$$SCHEMA("UPDATE MEDICARE INFO") ;17 +"RTN","BMXADOXY",198,0) + S SIEN2=$$SCHEMA("UPDATE MEDICARE DATES") ;18 +"RTN","BMXADOXY",199,0) + ;BMX ADO SS^17^^~4~5~~~~~~18,SUB +"RTN","BMXADOXY",200,0) + D SS^BMXADO(.OUT,SIEN1,"","~4~5~~~~~~"_SIEN2_",SUB") +"RTN","BMXADOXY",201,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXY",202,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXY",203,0) + Q +"RTN","BMXADOXY",204,0) + ; +"RTN","BMXADOXY",205,0) +JPAR ; PARENT FILE JOIN +"RTN","BMXADOXY",206,0) + ; SIMILAR TO A SUBFILE JOIN EXCEPT THE SUB-FILE IS TREATED AS THE PRIMARY FILE AND IT IS JOINED TO ITS PARENT +"RTN","BMXADOXY",207,0) + ; BECAUSE WE ARE STARTING IN A SUBFILE, THE DA STRING CONTAINS THE IEN OF THE PARENT FILE ("4," +"RTN","BMXADOXY",208,0) + ; THE SYNTAX OF THE 9TH PIECE IS "sien2,PARENT" WHERE sien2 IS THE IEN OF THE SECONDARY SCHEMA +"RTN","BMXADOXY",209,0) + ; PATIENT DFN=4 +"RTN","BMXADOXY",210,0) + N OUT,%,SIEN1,SIEN2 +"RTN","BMXADOXY",211,0) + S SIEN1=$$SCHEMA("UPDATE MEDICARE DATES") +"RTN","BMXADOXY",212,0) + S SIEN2=$$SCHEMA("UPDATE MEDICARE INFO") +"RTN","BMXADOXY",213,0) + D SS^BMXADO(.OUT,SIEN1,"4,","~~~5~~~~~"_SIEN2_",PARENT") +"RTN","BMXADOXY",214,0) + D DISP(OUT) R %:$G(DTIME,60) +"RTN","BMXADOXY",215,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXY",216,0) + Q +"RTN","BMXADOXY",217,0) + ; +"RTN","BMXADOXY",218,0) +ADD ; ADD A NEW ENTRY +"RTN","BMXADOXY",219,0) + ; THIS IS A 2 STEP PROCESS: +"RTN","BMXADOXY",220,0) + ; FIRST GET THE SCHEMA FOR THE FILE YOU WISH TO UPDATE +"RTN","BMXADOXY",221,0) + ; THIS SCHEMA'S NAME TYPICALLY BEGINS WITH THE WORD "UPDATE" +"RTN","BMXADOXY",222,0) + ; IT CONTAINS NO ID OR IEN FIELDS +"RTN","BMXADOXY",223,0) + ; SECOND ADD THE DATA NODE TO THE ARRAY +"RTN","BMXADOXY",224,0) + ; IT HAS THE SAME FORMAT AS A DATA STRING ASSOCIATED WITH THE SCHEMA EXCEPT THE FIRST "^" PIECE IS NULL +"RTN","BMXADOXY",225,0) + ; THIS PIECE CORRESPONDS TO THE IEN OF THE RECORD. SINCE THE RECORD HAS NOT BEEN ADDED YET, IT IS NULL. +"RTN","BMXADOXY",226,0) + ; IN THE DATA STRING, ALL POINTER VALUES ARE PRECEDED BY THE '`' CHARACTER AND EA. STRING ENDS IN $C(30) +"RTN","BMXADOXY",227,0) + ; MULTIPLE DATA STRINGS CAN BE APPENDED AS NEW NODES AT THE BOTTOM OF THE ARRAY +"RTN","BMXADOXY",228,0) + ; IN THIS CASE WE ARE ADDING A RECORD TO THE V MEASUREMENT FILE +"RTN","BMXADOXY",229,0) + ; DATA STRING="^MEASUREMENT TYPE IEN^PATIENT DFN^VISIT IEN^RESULT"_$C(30) +"RTN","BMXADOXY",230,0) + ; THERE ARE 2 INPUT PARAMS: +"RTN","BMXADOXY",231,0) + ; THE CLOSED REF WHERE THE INPUT ARRAY IS STORED +"RTN","BMXADOXY",232,0) + ; SINCE IT IS PASSED BY REFERENCE "OUT" CAN BE NULL OR UNDEFIEND. +"RTN","BMXADOXY",233,0) + ; OUT WILL BE DEFINED AT THE CONCLUSION OF THE TRANSACTION. +"RTN","BMXADOXY",234,0) + ; THE OUTPUT IS IN THE OUT ARRAY +"RTN","BMXADOXY",235,0) + ; OUT(1)="OK|ien" WHERE ien IS THE IEN OF THE RECORD THAT HAS BEE ADDED. +"RTN","BMXADOXY",236,0) + ; IF THE TRANSACTION FAILED, AN ERROR MSG WILL BE IN THE OUT ARRAY +"RTN","BMXADOXY",237,0) + ; MEASUREMENT TYPE=2, PATIENT DFN=2, VISIT IEN=7806, PATIENT'S WEIGHT=172.75 +"RTN","BMXADOXY",238,0) + N OUT,%,SIEN,NODE,DFN +"RTN","BMXADOXY",239,0) + S DFN=2 +"RTN","BMXADOXY",240,0) + S SIEN=$$SCHEMA("UPDATE MEASUREMENTS") +"RTN","BMXADOXY",241,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOXY",242,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOXY",243,0) + S ^TMP("BMX ADO",$J,NODE)="^`2^`"_DFN_"^`7806^172.75"_$C(30) +"RTN","BMXADOXY",244,0) + D DISP(OUT) R %:$G(DTIME,60) ; DISPLAY THE INPUT ARRAY BEFORE UPDATING THE RECORD +"RTN","BMXADOXY",245,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) ; EP FOR UPDAING THE RECORD +"RTN","BMXADOXY",246,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXY",247,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) ; SEND BACK AN ACKNOWLEDGEMENT OR ERROR MSG +"RTN","BMXADOXY",248,0) + Q +"RTN","BMXADOXY",249,0) + ; +"RTN","BMXADOXY",250,0) +DEL ; DELETE A RECORD +"RTN","BMXADOXY",251,0) + ; THE SIPLEST WAY TO DELETE AN ENTRY IS TO PUT THE RECORD IEN IN THE DA STRING PRECEDED BY A MINUS SIGN +"RTN","BMXADOXY",252,0) + ; YOU CAN ALSO SET THE VALUE OF THE .01 FIELD TO "@" +"RTN","BMXADOXY",253,0) + ; IF THE VALUE OF THE .01 FIELD IS NULL AND THE DA STRING IS NOT PRECEDED BY A MINUS SIGN, THE TRANSACTION WILL BE CANCELLED +"RTN","BMXADOXY",254,0) + ; IF THE DA STRING IS NULL, THE TRANSACTION WILL BE CANCELLED +"RTN","BMXADOXY",255,0) + ; IN THIS EXAMPLE, WE DELETE A V MEASUREMENT RECORD THAT WAS JUST ADDED +"RTN","BMXADOXY",256,0) + N OUT,%,SIEN,NODE,DEL +"RTN","BMXADOXY",257,0) + S DEL=1621 +"RTN","BMXADOXY",258,0) + S SIEN=$$SCHEMA("UPDATE MEASUREMENTS") +"RTN","BMXADOXY",259,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOXY",260,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOXY",261,0) + S ^TMP("BMX ADO",$J,NODE)="-"_DEL_$C(30) +"RTN","BMXADOXY",262,0) + D DISP(OUT) R %:$G(DTIME,60) ; DISPLAY THE INPUT ARRAY BEFORE UPDATING THE RECORD +"RTN","BMXADOXY",263,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) ; EP FOR UPDAING THE RECORD +"RTN","BMXADOXY",264,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXY",265,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) ; SEND BACK AN ACKNOWLEDGEMENT OR ERROR MSG +"RTN","BMXADOXY",266,0) + Q +"RTN","BMXADOXY",267,0) + ; +"RTN","BMXADOXY",268,0) +EDIT ; EDIT AN EXISTING ENTRY +"RTN","BMXADOXY",269,0) + ; SIMILAR TO ABOVE EXCEPT THAT THE FIRST "^" PIECE OF THE DATA NODE IS THE IEN OF THE RECORD TO BE EDITIED +"RTN","BMXADOXY",270,0) + ; NOTE THAT THERE IS NO '`' IN FRONT OF THE FIRST PIECE. IT IS A PURE INTEGER +"RTN","BMXADOXY",271,0) + ; LAB TEST=175, PATIENT DFN=2, VISIT IEN=8040, PT'S GLUCOSE=276, ANORMAL="ABNORMAL" +"RTN","BMXADOXY",272,0) + N OUT,%,SIEN,NODE +"RTN","BMXADOXY",273,0) + S SIEN=$$SCHEMA("UPDATE LABS") +"RTN","BMXADOXY",274,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOXY",275,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOXY",276,0) + S ^TMP("BMX ADO",$J,NODE)="279^`175^`2^`8040^280^H"_$C(30) +"RTN","BMXADOXY",277,0) + D DISP(OUT) R %:$G(DTIME,60) ; DISPLAY THE INPUT ARRAY BEFORE UPDATING THE RECORD +"RTN","BMXADOXY",278,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) ; EP FOR UPDAING THE RECORD +"RTN","BMXADOXY",279,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXY",280,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) ; SEND BACK AN ACKNOWLEDGEMENT OR ERROR MSG +"RTN","BMXADOXY",281,0) + Q +"RTN","BMXADOXY",282,0) + ; +"RTN","BMXADOXY",283,0) +DELVAL ; DELETE A VALUE IN A FIELD +"RTN","BMXADOXY",284,0) + ; SIMILAR TO EDIT EXCEPT THE VALUE IS "@" +"RTN","BMXADOXY",285,0) + ; DELETE WILL BE ABORTED IF IF FILEMAN SAYS THIS IS A REQUIRED FIELD +"RTN","BMXADOXY",286,0) + N OUT,%,SIEN,NODE +"RTN","BMXADOXY",287,0) + S SIEN=$$SCHEMA("UPDATE LABS") +"RTN","BMXADOXY",288,0) + D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA +"RTN","BMXADOXY",289,0) + S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1 +"RTN","BMXADOXY",290,0) + S ^TMP("BMX ADO",$J,NODE)="279^`175^`2^`8040^^@"_$C(30) +"RTN","BMXADOXY",291,0) + D DISP(OUT) R %:$G(DTIME,60) ; DISPLAY THE INPUT ARRAY BEFORE UPDATING THE RECORD +"RTN","BMXADOXY",292,0) + D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J))) ; EP FOR UPDAING THE RECORD +"RTN","BMXADOXY",293,0) + K ^TMP("BMX ADO",$J) +"RTN","BMXADOXY",294,0) + W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%) ; SEND BACK AN ACKNOWLEDGEMENT OR ERROR MSG +"RTN","BMXADOXY",295,0) + Q +"RTN","BMXADOXY",296,0) + ; +"RTN","BMXE01") +0^114^B6931626 +"RTN","BMXE01",1,0) +BMXE01 ; IHS/OIT/FJE - ENVIRONMENT CHECK FOR BMX 2.0 ; +"RTN","BMXE01",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXE01",3,0) + ; +"RTN","BMXE01",4,0) + S $P(LINE,"*",81)="" +"RTN","BMXE01",5,0) + S XPDNOQUE="NO QUE" ;NO QUEUING ALLOWED +"RTN","BMXE01",6,0) + S XPDABORT=0 +"RTN","BMXE01",7,0) + I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." S XPX="DUZ" D SORRY Q +"RTN","BMXE01",8,0) + ; +"RTN","BMXE01",9,0) + I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." S XPX="DUZ" D SORRY Q +"RTN","BMXE01",10,0) + ; +"RTN","BMXE01",11,0) + D HOME^%ZIS,DT^DICRW +"RTN","BMXE01",12,0) + S X=$P($G(^VA(200,DUZ,0)),U) +"RTN","BMXE01",13,0) + I $G(X)="" W !,"Who are you????" S XPX="DUZ" D SORRY Q +"RTN","BMXE01",14,0) + W !,"Hello, "_$P(X,",",2)_" "_$P(X,",") +"RTN","BMXE01",15,0) + W !!,"Checking Environment for Install of Version "_$P($T(+2),";",3)_" of "_$P($T(+2),";",4)_"." +"RTN","BMXE01",16,0) + ; +"RTN","BMXE01",17,0) + S X=$G(^DD("VERSION")) +"RTN","BMXE01",18,0) + W !!,"Need at least FileMan 22.....FileMan "_X_" Present" +"RTN","BMXE01",19,0) + I X<22 S XPX="FM" D SORRY Q +"RTN","BMXE01",20,0) + ; +"RTN","BMXE01",21,0) + S X=$G(^DIC(9.4,$O(^DIC(9.4,"C","XU",0)),"VERSION")) +"RTN","BMXE01",22,0) + W !!,"Need at least Kernel 8.0.....Kernel "_X_" Present" +"RTN","BMXE01",23,0) + I +X<8 S XPX="KERNEL" D SORRY Q +"RTN","BMXE01",24,0) + ; +"RTN","BMXE01",25,0) + S X=$G(^DIC(9.4,$O(^DIC(9.4,"C","XB",0)),"VERSION")) +"RTN","BMXE01",26,0) + W !!,"Need at least XB/ZIB 3.....XB/ZIB "_X_" Present" +"RTN","BMXE01",27,0) + I +X<2 S XPX="XB" D SORRY Q +"RTN","BMXE01",28,0) + q +"RTN","BMXE01",29,0) +ENVOK ; If this is just an environ check, end here. +"RTN","BMXE01",30,0) + W !!,"ENVIRONMENT OK." +"RTN","BMXE01",31,0) + ; +"RTN","BMXE01",32,0) + ; The following line prevents the "Disable Options..." and "Move +"RTN","BMXE01",33,0) + ; Routines..." questions from being asked during the install. +"RTN","BMXE01",34,0) + I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0 +"RTN","BMXE01",35,0) + I $G(XPDENV)=1 D ;Updates BMX Version file +"RTN","BMXE01",36,0) + .S X="2",DIC="^BMXAPPL(",DLAYGO=90093.2,DIC(0)="E" K DD,D0 D FILE^DICN +"RTN","BMXE01",37,0) + .S DA=+Y +"RTN","BMXE01",38,0) + .S:+DA DIE="^BMXAPPL(",DR=".02///0;.03////"_DT D ^DIE +"RTN","BMXE01",39,0) + .K DIE,DA +"RTN","BMXE01",40,0) + Q +"RTN","BMXE01",41,0) +SORRY ; +"RTN","BMXE01",42,0) + K DIFQ +"RTN","BMXE01",43,0) + S XPDABORT=1 +"RTN","BMXE01",44,0) + W *7,!!!,"Sorry....something is wrong with your environment" +"RTN","BMXE01",45,0) + W !,"Aborting BMX Version 2.0 Install!" +"RTN","BMXE01",46,0) + W !,"Correct error and reinstall otherwise" +"RTN","BMXE01",47,0) + W !,"please print/capture this screen and notify" +"RTN","BMXE01",48,0) + W !,"technical support." +"RTN","BMXE01",49,0) + W !!,LINE +"RTN","BMXE01",50,0) + D BMES^XPDUTL("Sorry....something is wrong with your environment") +"RTN","BMXE01",51,0) + D BMES^XPDUTL("Enviroment ERROR "_$G(XPX)) +"RTN","BMXE01",52,0) + D BMES^XPDUTL("Aborting BMX 2.0 install!") +"RTN","BMXE01",53,0) + D BMES^XPDUTL("Correct error and reinstall otherwise") +"RTN","BMXE01",54,0) + D BMES^XPDUTL("please print/capture this screen and notify") +"RTN","BMXE01",55,0) + D BMES^XPDUTL("technical support.") +"RTN","BMXE01",56,0) + Q +"RTN","BMXE01",57,0) + ; +"RTN","BMXFIND") +0^79^B45092715 +"RTN","BMXFIND",1,0) +BMXFIND ; IHS/OIT/HMW - BMX GENERIC FIND ; +"RTN","BMXFIND",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXFIND",3,0) + ; +"RTN","BMXFIND",4,0) + ; +"RTN","BMXFIND",5,0) +TABLE(BMXGBL,BMXFL) ;EP +"RTN","BMXFIND",6,0) + ; +"RTN","BMXFIND",7,0) + ;---> If file number not provided check for file name. +"RTN","BMXFIND",8,0) + ;S ^HW("BMXTABLE")=BMXFL +"RTN","BMXFIND",9,0) + S BMX31=$C(31)_$C(31) +"RTN","BMXFIND",10,0) + I +BMXFL'=BMXFL D +"RTN","BMXFIND",11,0) + . S BMXFL=$TR(BMXFL,"_"," ") +"RTN","BMXFIND",12,0) + . I '$D(^DIC("B",BMXFL)) S BMXFL="" Q +"RTN","BMXFIND",13,0) + . S BMXFL=$O(^DIC("B",BMXFL,0)) +"RTN","BMXFIND",14,0) + I '$G(BMXFL) D ERROUT("File number not provided.",1) Q +"RTN","BMXFIND",15,0) + D FIND(.BMXGBL,BMXFL,"*",,,10,,,,1) +"RTN","BMXFIND",16,0) + Q +"RTN","BMXFIND",17,0) + ; +"RTN","BMXFIND",18,0) +FIND(BMXGBL,BMXFL,BMXFLDS,BMXFLG,BMXIN,BMXMX,BMXIX,BMXSCR,BMXMC,BMXNUM) ;EP +"RTN","BMXFIND",19,0) + ; +"RTN","BMXFIND",20,0) + ;TODO: +"RTN","BMXFIND",21,0) + ; -- Return column info even if no rows returned +"RTN","BMXFIND",22,0) + ; +"RTN","BMXFIND",23,0) + ;---> Places matching records from requested file into a +"RTN","BMXFIND",24,0) + ;---> result global, ^BMXTEMP($J). The exact global name +"RTN","BMXFIND",25,0) + ;---> is returned in the first parameter (BMXGBL). +"RTN","BMXFIND",26,0) + ;---> Records are returned one per node in the result global. +"RTN","BMXFIND",27,0) + ;---> Each record is terminated with a $C(30), for parsing out +"RTN","BMXFIND",28,0) + ;---> on the VB side, since the Broker concatenates all nodes +"RTN","BMXFIND",29,0) + ;---> into a single string when passing the data out of M. +"RTN","BMXFIND",30,0) + ;---> Requested fields within records are delimited by "^". +"RTN","BMXFIND",31,0) + ;---> NOTE: The first "^"-piece of every node is the IEN of +"RTN","BMXFIND",32,0) + ;---> that entry in its file; the requested fields follow. +"RTN","BMXFIND",33,0) + ;---> The final record (node) contains Error Delimiter, +"RTN","BMXFIND",34,0) + ; $C(31)_$C(31), followed by error text, if any. +"RTN","BMXFIND",35,0) + ; +"RTN","BMXFIND",36,0) + ; +"RTN","BMXFIND",37,0) + ;---> Parameters: +"RTN","BMXFIND",38,0) + ; 1 - BMXGBL (ret) Name of result global for Broker. +"RTN","BMXFIND",39,0) + ; 2 - BMXFL (req) File for lookup. +"RTN","BMXFIND",40,0) + ; 3 - BMXFLDS (opt) Fields to return w/each entry. +"RTN","BMXFIND",41,0) + ; 4 - BMXFLG (opt) Flags in DIC(0); If null, "M" is sent. +"RTN","BMXFIND",42,0) + ; 5 - BMXIN (opt) Input to match on (see Algorithm below). +"RTN","BMXFIND",43,0) + ; 6 - BMXMX (opt) Maximum number of entries to return. +"RTN","BMXFIND",44,0) + ; 7 - BMXIX (opt) Indexes to search. +"RTN","BMXFIND",45,0) + ; 8 - BMXSCR (opt) Screen/filter (M code). +"RTN","BMXFIND",46,0) + ; 9 - BMXMC (opt) Mixed Case: 1=mixed case, 0=no change. +"RTN","BMXFIND",47,0) + ; (Converts data in uppercase to mixed case.) +"RTN","BMXFIND",48,0) + ; 10 - BMXNUM (opt) Include IEN in returned recordset (1=true) +"RTN","BMXFIND",49,0) + ; +"RTN","BMXFIND",50,0) + ;---> Set variables, kill temp globals. +"RTN","BMXFIND",51,0) + ;N (BMXGBL,BMXFL,BMXFLDS,BMXFLG,BMXIN,BMXMX,BMXIX,BMXSCR,BMXMC) +"RTN","BMXFIND",52,0) + S BMX31=$C(31)_$C(31) +"RTN","BMXFIND",53,0) + S BMXGBL="^BMXTEMP("_$J_")",BMXERR="",U="^" +"RTN","BMXFIND",54,0) + K ^BMXTMP($J),^BMXTEMP($J) +"RTN","BMXFIND",55,0) + ; +"RTN","BMXFIND",56,0) + ;---> If file number not provided check for file name. +"RTN","BMXFIND",57,0) + I +BMXFL'=BMXFL D +"RTN","BMXFIND",58,0) + . I '$D(^DIC("B",BMXFL)) S BMXFL="" Q +"RTN","BMXFIND",59,0) + . S BMXFL=$O(^DIC("B",BMXFL,0)) +"RTN","BMXFIND",60,0) + I '$G(BMXFL) D ERROUT("File number not provided.",1) Q +"RTN","BMXFIND",61,0) + ; +"RTN","BMXFIND",62,0) + ;---> If no fields provided, pass .01. +"RTN","BMXFIND",63,0) + ;---> NOTE: If .01 is NOT included, but the Index to lookup on is +"RTN","BMXFIND",64,0) + ;---> NOT on the .01, then the .01 will be returned +"RTN","BMXFIND",65,0) + ;---> automatically as the second ^-piece of data in the +"RTN","BMXFIND",66,0) + ;---> Result Global. +"RTN","BMXFIND",67,0) + ;---> So it would be: IEN^.01^requested fields... +"RTN","BMXFIND",68,0) + I $G(BMXFLDS)="" S BMXFLDS=".01" +"RTN","BMXFIND",69,0) + ; +"RTN","BMXFIND",70,0) + ;---> If no index or flag provided, set flag="M". +"RTN","BMXFIND",71,0) + I $G(BMXFLG)="" D +"RTN","BMXFIND",72,0) + .I $G(BMXIX)="" S BMXFLG="M" Q +"RTN","BMXFIND",73,0) + .S BMXFLG="" +"RTN","BMXFIND",74,0) + ; +"RTN","BMXFIND",75,0) + ;---> If no Maximum Number provided, set it to 200. +"RTN","BMXFIND",76,0) + I '$G(BMXMX) S BMXMX=200 +"RTN","BMXFIND",77,0) + ; +"RTN","BMXFIND",78,0) + ;---> Define index and screen. +"RTN","BMXFIND",79,0) + S:'$D(BMXIX) BMXIX="" +"RTN","BMXFIND",80,0) + S:'$D(BMXSCR) BMXSCR="" +"RTN","BMXFIND",81,0) + ; +"RTN","BMXFIND",82,0) + ;---> Set Target Global for output and errors. +"RTN","BMXFIND",83,0) + S BMXG="^BMXTMP($J)" +"RTN","BMXFIND",84,0) + ; +"RTN","BMXFIND",85,0) + ;---> If Mixed Case not set, set to No Change. +"RTN","BMXFIND",86,0) + I '$D(BMXMC) S BMXMC=0 +"RTN","BMXFIND",87,0) + ; +"RTN","BMXFIND",88,0) + ;---> If Return IEN not set, set to No +"RTN","BMXFIND",89,0) + I '$D(BMXNUM) S BMXNUM=0 +"RTN","BMXFIND",90,0) + S BMXNUM=+BMXNUM +"RTN","BMXFIND",91,0) + ; +"RTN","BMXFIND",92,0) + ;---> Silent Fileman call. +"RTN","BMXFIND",93,0) + D +"RTN","BMXFIND",94,0) + .I $G(BMXIN)="" D Q +"RTN","BMXFIND",95,0) + ..D LIST^DIC(BMXFL,,,,BMXMX,0,,BMXIX,BMXSCR,,BMXG,BMXG) +"RTN","BMXFIND",96,0) + .D FIND^DIC(BMXFL,,,BMXFLG,BMXIN,BMXMX,BMXIX,BMXSCR,,BMXG,BMXG) +"RTN","BMXFIND",97,0) + ; +"RTN","BMXFIND",98,0) + D WRITE +"RTN","BMXFIND",99,0) + Q +"RTN","BMXFIND",100,0) + ; +"RTN","BMXFIND",101,0) + ; +"RTN","BMXFIND",102,0) + ;---------- +"RTN","BMXFIND",103,0) +WRITE ;EP +"RTN","BMXFIND",104,0) + ;---> Collect data for matching records and write in result global. +"RTN","BMXFIND",105,0) + ; +"RTN","BMXFIND",106,0) + ;---> First, check for errors. +"RTN","BMXFIND",107,0) + ;---> If errors exist, write them and quit. +"RTN","BMXFIND",108,0) + N I,N,X +"RTN","BMXFIND",109,0) + I $D(^BMXTMP($J,"DIERR")) I $O(^("DIERR",0)) D Q +"RTN","BMXFIND",110,0) + .S N=0,X="" +"RTN","BMXFIND",111,0) + .F S N=$O(^BMXTMP($J,"DIERR",N)) Q:'N D +"RTN","BMXFIND",112,0) + ..N M S M=0 +"RTN","BMXFIND",113,0) + ..F S M=$O(^BMXTMP($J,"DIERR",N,"TEXT",M)) Q:'M D +"RTN","BMXFIND",114,0) + ...S X=X_^BMXTMP($J,"DIERR",N,"TEXT",M)_" " +"RTN","BMXFIND",115,0) + .D ERROUT(X,1) +"RTN","BMXFIND",116,0) + ; +"RTN","BMXFIND",117,0) + ; +"RTN","BMXFIND",118,0) + ;---> Write valid results. +"RTN","BMXFIND",119,0) + ;---> Loop through the IEN node (...2,N) of the temp global. +"RTN","BMXFIND",120,0) + ; and call GETS^DIQ for each record +"RTN","BMXFIND",121,0) + N I,N,X S N=0 +"RTN","BMXFIND",122,0) + S BMXA="A" +"RTN","BMXFIND",123,0) + ;B +"RTN","BMXFIND",124,0) + S I=0 +"RTN","BMXFIND",125,0) + S BMXFLDF=0 +"RTN","BMXFIND",126,0) +RESULTS F S N=$O(^BMXTMP($J,"DILIST",2,N)) Q:'N D +"RTN","BMXFIND",127,0) + . S X=^BMXTMP($J,"DILIST",2,N) +"RTN","BMXFIND",128,0) + . S I=I+1 +"RTN","BMXFIND",129,0) + . K A +"RTN","BMXFIND",130,0) + . D GETS^DIQ(BMXFL,X_",",BMXFLDS,,BMXA,BMXA) +"RTN","BMXFIND",131,0) + . ;--->Once only, write field names +"RTN","BMXFIND",132,0) + . D:'BMXFLDF FIELDS +"RTN","BMXFIND",133,0) + . ; +"RTN","BMXFIND",134,0) + . ; +"RTN","BMXFIND",135,0) + . ;---> Loop through results global +"RTN","BMXFIND",136,0) + . S F=0,BMXCNT=0 +"RTN","BMXFIND",137,0) + . F S F=$O(A(BMXFL,X_",",F)) Q:'F S BMXCNT=BMXCNT+1 +"RTN","BMXFIND",138,0) + . S F=0 +"RTN","BMXFIND",139,0) + . S BMXREC="" +"RTN","BMXFIND",140,0) + . S:BMXNUM ^BMXTEMP($J,I)=X_"^" +"RTN","BMXFIND",141,0) + . S BMXCNTB=0 +"RTN","BMXFIND",142,0) + . S BMXORD=BMXNUM +"RTN","BMXFIND",143,0) + . F S F=$O(A(BMXFL,X_",",F)) Q:'F S BMXCNTB=BMXCNTB+1 D S:BMXCNTBBMXLEN(BMXORD) BMXLEN(BMXORD)=BMXLTMP +"RTN","BMXFIND",156,0) + . . . . Q +"RTN","BMXFIND",157,0) + . . . D ;It's a multiple. Implement in next phase +"RTN","BMXFIND",158,0) + . . . . Q ; +"RTN","BMXFIND",159,0) + . . . Q +"RTN","BMXFIND",160,0) + . . E D ;Not a multiple +"RTN","BMXFIND",161,0) + . . . S I=I+1 +"RTN","BMXFIND",162,0) + . . . S ^BMXTEMP($J,I)=A(BMXFL,X_",",F) +"RTN","BMXFIND",163,0) + . . . S:$L(A(BMXFL,X_",",F))>BMXLEN(BMXORD) BMXLEN(BMXORD)=$L(A(BMXFL,X_",",F)) +"RTN","BMXFIND",164,0) + . . . Q +"RTN","BMXFIND",165,0) + . . Q +"RTN","BMXFIND",166,0) + . ;---> Convert data to mixed case if BMXMC=1. +"RTN","BMXFIND",167,0) + . ;S:BMXMC BMXREC=$$T^BMXTRS(BMXREC) +"RTN","BMXFIND",168,0) + . ;---> Set data in result global. +"RTN","BMXFIND",169,0) + . S ^BMXTEMP($J,I)=^BMXTEMP($J,I)_$C(30) +"RTN","BMXFIND",170,0) + ; +"RTN","BMXFIND",171,0) + ;---> If no results, report it as an error. +"RTN","BMXFIND",172,0) + D:'$O(^BMXTEMP($J,0)) +"RTN","BMXFIND",173,0) + .I BMXIN]"" S BMXERR="No entry matches """_BMXIN_"""." Q +"RTN","BMXFIND",174,0) + .S BMXERR="Either the lookup file is empty" +"RTN","BMXFIND",175,0) + .S BMXERR=BMXERR_" or all entries are screened (software error)." +"RTN","BMXFIND",176,0) + ; +"RTN","BMXFIND",177,0) + ;---> Tack on Error Delimiter and any error. +"RTN","BMXFIND",178,0) + S I=I+1 +"RTN","BMXFIND",179,0) + S ^BMXTEMP($J,I)=BMX31_BMXERR +"RTN","BMXFIND",180,0) + ;---> Column types and widths +"RTN","BMXFIND",181,0) + S C=0 +"RTN","BMXFIND",182,0) + F S C=$O(BMXLEN(C)) Q:'C D +"RTN","BMXFIND",183,0) + . I BMXLEN(C)>99999 S BMXLEN(C)=99999 +"RTN","BMXFIND",184,0) + . S ^BMXTEMP($J,C)=BMXTYP(C)_$$NUMCHAR(BMXLEN(C))_^BMXTEMP($J,C) +"RTN","BMXFIND",185,0) + Q +"RTN","BMXFIND",186,0) + ; +"RTN","BMXFIND",187,0) + ; +"RTN","BMXFIND",188,0) +NUMCHAR(BMXN) ;EP +"RTN","BMXFIND",189,0) + ;---> Returns Field Length left-padded with 0 +"RTN","BMXFIND",190,0) + ; +"RTN","BMXFIND",191,0) + N BMXC +"RTN","BMXFIND",192,0) + S BMXC="00000"_BMXN +"RTN","BMXFIND",193,0) + Q $E(BMXC,$L(BMXC)-4,$L(BMXC)) +"RTN","BMXFIND",194,0) + ; +"RTN","BMXFIND",195,0) + ;---> Dead code follows +"RTN","BMXFIND",196,0) + N C,BMXC,F,N,J +"RTN","BMXFIND",197,0) + S BMXC="" +"RTN","BMXFIND",198,0) + S N=BMXN +"RTN","BMXFIND",199,0) + S:N>99999 N=99999 +"RTN","BMXFIND",200,0) + S:N<0 N=0 +"RTN","BMXFIND",201,0) + F J=1:1:$L(N) D +"RTN","BMXFIND",202,0) + . S F=10**(J-1) +"RTN","BMXFIND",203,0) + . S C=65+(N-((N\(10*F))*(10*F))\F) +"RTN","BMXFIND",204,0) + . S C=$C(C) +"RTN","BMXFIND",205,0) + . S BMXC=C_BMXC +"RTN","BMXFIND",206,0) + S BMXC="AAAAA"_BMXC +"RTN","BMXFIND",207,0) + Q $E(BMXC,$L(BMXC)-4,$L(BMXC)) +"RTN","BMXFIND",208,0) + ; +"RTN","BMXFIND",209,0) + ; +"RTN","BMXFIND",210,0) +FIELDS ;---> Write Field Names +"RTN","BMXFIND",211,0) + ;Field name is TAAAAANAME +"RTN","BMXFIND",212,0) + ;Where T is the field type (T=Text; D=Date) +"RTN","BMXFIND",213,0) + ; AAAAA is the field size (see NUMCHAR routine) +"RTN","BMXFIND",214,0) + ; NAME is the field name +"RTN","BMXFIND",215,0) + S BMXFLDF=1 +"RTN","BMXFIND",216,0) + K BMXLEN,BMXTYP +"RTN","BMXFIND",217,0) + D:$D(A) +"RTN","BMXFIND",218,0) + . I BMXNUM S ^BMXTEMP($J,I)="IEN^",BMXLEN(I)=10,BMXTYP(I)="T",I=I+1 ;TODO: Change from text to number +"RTN","BMXFIND",219,0) + . S ASDXFNUM=0 +"RTN","BMXFIND",220,0) + . S BMXIENS=$O(A(BMXFL,0)) +"RTN","BMXFIND",221,0) + . F S ASDXFNUM=$O(A(BMXFL,BMXIENS,ASDXFNUM)) Q:'ASDXFNUM D +"RTN","BMXFIND",222,0) + . . S ASDXFNAM=$P(^DD(BMXFL,ASDXFNUM,0),"^") ;Get type here +"RTN","BMXFIND",223,0) + . . S ASDXFNAM=$TR(ASDXFNAM," ","_") +"RTN","BMXFIND",224,0) + . . S BMXTYP(I)="T" +"RTN","BMXFIND",225,0) + . . S BMXLEN(I)=0 ;Start with length zero +"RTN","BMXFIND",226,0) + . . S:ASDXFNAM="" ASDXFNAM="UNKNOWN"_I +"RTN","BMXFIND",227,0) + . . S ^BMXTEMP($J,I)=ASDXFNAM_"^" +"RTN","BMXFIND",228,0) + . . S I=I+1 +"RTN","BMXFIND",229,0) + . S ^BMXTEMP($J,I-1)=$E(^BMXTEMP($J,I-1),1,$L(^BMXTEMP($J,I-1))-1)_$C(30) +"RTN","BMXFIND",230,0) + Q +"RTN","BMXFIND",231,0) + ; +"RTN","BMXFIND",232,0) + ;---------- +"RTN","BMXFIND",233,0) +ERROUT(BMXERR,I) ;EP +"RTN","BMXFIND",234,0) + ;---> Save next line for Error Code File if ever used. +"RTN","BMXFIND",235,0) + ;---> If necessary, use I>1 to avoid overwriting valid data. +"RTN","BMXFIND",236,0) + S:'$G(I) I=1 +"RTN","BMXFIND",237,0) + S ^BMXTEMP($J,I)=BMX31_BMXERR +"RTN","BMXFIND",238,0) + Q +"RTN","BMXFIND",239,0) + ; +"RTN","BMXFIND",240,0) + ; +"RTN","BMXFIND",241,0) +PASSERR(BMXGBL,BMXERR) ;EP +"RTN","BMXFIND",242,0) + ;---> If the RPC routine calling the BMX Generic Lookup above +"RTN","BMXFIND",243,0) + ;---> detects a specific error prior to the call and wants to pass +"RTN","BMXFIND",244,0) + ;---> that error in the result global rather than a generic error, +"RTN","BMXFIND",245,0) + ;---> then a call to this function (PASSERR) can be made. +"RTN","BMXFIND",246,0) + ;---> This call will store the error text passed in the result global. +"RTN","BMXFIND",247,0) + ;---> The calling routine should then quit (abort its call to the +"RTN","BMXFIND",248,0) + ;---> BMX Generic Lookup function above). +"RTN","BMXFIND",249,0) + ; +"RTN","BMXFIND",250,0) + ;---> Parameters: +"RTN","BMXFIND",251,0) + ; 1 - BMXGBL (ret) Name of result global for Broker. +"RTN","BMXFIND",252,0) + ; 2 - BMXERR (req) Text of error to be stored in result global. +"RTN","BMXFIND",253,0) + ; +"RTN","BMXFIND",254,0) + S:$G(BMXERR)="" BMXERR="Error not passed (software error)." +"RTN","BMXFIND",255,0) + ; +"RTN","BMXFIND",256,0) + N BMX31 S BMX31=$C(31)_$C(31) +"RTN","BMXFIND",257,0) + K ^BMXTMP($J),^BMXTEMP($J) +"RTN","BMXFIND",258,0) + S BMXGBL="^BMXTEMP("_$J_")" +"RTN","BMXFIND",259,0) + S ^BMXTEMP($J,1)=BMX31_BMXERR +"RTN","BMXFIND",260,0) + Q +"RTN","BMXG") +0^80^B2718298 +"RTN","BMXG",1,0) +BMXG ; IHS/OIT/HMW - UTIL: GET DATA ; +"RTN","BMXG",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXG",3,0) + ;;Stolen from:* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER * +"RTN","BMXG",4,0) + ; +"RTN","BMXG",5,0) + ; +"RTN","BMXG",6,0) + ;---------- +"RTN","BMXG",7,0) +GET(FILE,Y,PC) ;EP +"RTN","BMXG",8,0) + ;---> Return text of .01 Field of an entry in a file. +"RTN","BMXG",9,0) + ;---> Parameters: +"RTN","BMXG",10,0) + ; 1 - FILE (req) Number corresponding to desired file: +"RTN","BMXG",11,0) + ; 1 = State File, #5 +"RTN","BMXG",12,0) + ; 2 = Community File, #9999999.5 +"RTN","BMXG",13,0) + ; 3 = Employer File, #9999999.75 +"RTN","BMXG",14,0) + ; 4 = Beneficiary File, #9999999.25 +"RTN","BMXG",15,0) + ; 5 = Tribe File, #9999999.03 +"RTN","BMXG",16,0) + ; 6 = Insurer File, #9999999.18 +"RTN","BMXG",17,0) + ; 7 = Suffix File, #9999999.32 +"RTN","BMXG",18,0) + ; 8 = Employer Group Insurance File, #9999999.77 +"RTN","BMXG",19,0) + ; 9 = Medicare Eligible File, #9000003 +"RTN","BMXG",20,0) + ; 10 = Medicaid Eligible File, #9000004 +"RTN","BMXG",21,0) + ; 11 = Private Insurance Eligible File, #9000006 +"RTN","BMXG",22,0) + ; 12 = Patient File, #9000001 +"RTN","BMXG",23,0) + ; 13 = VA Patient File, #2 +"RTN","BMXG",24,0) + ; 14 = Policy Holder File, #9000003.1 +"RTN","BMXG",25,0) + ; 15 = Relationship File, #9999999.36 +"RTN","BMXG",26,0) + ; +"RTN","BMXG",27,0) + ; 2 - Y (req) IEN in the File storing the desired entry. +"RTN","BMXG",28,0) + ; 3 - PC (opt) Piece of 0-Node to return (default=1). +"RTN","BMXG",29,0) + ; If PC=0 return entire 0-node. +"RTN","BMXG",30,0) + ; +"RTN","BMXG",31,0) + Q:($G(Y)'?1N.N) "" +"RTN","BMXG",32,0) + Q:'$G(FILE) "" +"RTN","BMXG",33,0) + S:$G(PC)="" PC=1 S U="^" +"RTN","BMXG",34,0) + ; +"RTN","BMXG",35,0) + D +"RTN","BMXG",36,0) + .I FILE=1 S GLB="^DIC(5,"_Y_",0)" Q +"RTN","BMXG",37,0) + .I FILE=2 S GLB="^AUTTCOM("_Y_",0)" Q +"RTN","BMXG",38,0) + .I FILE=3 S GLB="^AUTNEMPL("_Y_",0)" Q +"RTN","BMXG",39,0) + .I FILE=4 S GLB="^AUTTBEN("_Y_",0)" Q +"RTN","BMXG",40,0) + .I FILE=5 S GLB="^AUTTTRI("_Y_",0)" Q +"RTN","BMXG",41,0) + .I FILE=6 S GLB="^AUTNINS("_Y_",0)" Q +"RTN","BMXG",42,0) + .I FILE=7 S GLB="^AUTTMCS("_Y_",0)" Q +"RTN","BMXG",43,0) + .I FILE=8 S GLB="^AUTNEGRP("_Y_",0)" Q +"RTN","BMXG",44,0) + .I FILE=9 S GLB="^AUPNMCR("_Y_",0)" Q +"RTN","BMXG",45,0) + .I FILE=10 S GLB="^AUPNMCD("_Y_",0)" Q +"RTN","BMXG",46,0) + .I FILE=11 S GLB="^AUPNPRVT("_Y_",0)" Q +"RTN","BMXG",47,0) + .I FILE=12 S GLB="^AUPNPAT("_Y_",0)" Q +"RTN","BMXG",48,0) + .I FILE=13 S GLB="^DPT("_Y_",0)" Q +"RTN","BMXG",49,0) + .I FILE=14 S GLB="^AUPN3PPH("_Y_",0)" Q +"RTN","BMXG",50,0) + .I FILE=15 S GLB="^AUTTRLSH("_Y_",0)" Q +"RTN","BMXG",51,0) + ; +"RTN","BMXG",52,0) + Q:'FILE "" +"RTN","BMXG",53,0) + Q:PC=0 $G(@GLB) +"RTN","BMXG",54,0) + Q $P($G(@GLB),U,PC) +"RTN","BMXGETS") +0^81^B15016739 +"RTN","BMXGETS",1,0) +BMXGETS ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; +"RTN","BMXGETS",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXGETS",3,0) + ; +"RTN","BMXGETS",4,0) + ;;Horace Whitt +"RTN","BMXGETS",5,0) + ;;Interface to GETS^DIQ +"RTN","BMXGETS",6,0) + ; +"RTN","BMXGETS",7,0) + ;---------- +"RTN","BMXGETS",8,0) +GETS(BMXGBL,BMXFL,BMXIENS,BMXFLDS,BMXFLG,BMXMC,BMXNUM) ;EP +"RTN","BMXGETS",9,0) + ;---> The final record (node) contains Error Delimiter, +"RTN","BMXGETS",10,0) + ; $C(31)_$C(31), followed by error text, if any. +"RTN","BMXGETS",11,0) + ; +"RTN","BMXGETS",12,0) + ;---> Parameters: +"RTN","BMXGETS",13,0) + ; 1 - BMXGBL (ret) Name of result global for Broker. +"RTN","BMXGETS",14,0) + ; 2 - BMXFL (req) File number for lookup. +"RTN","BMXGETS",15,0) + ; 3 - BMXFLDS (req) Fields to return w/each entry in IENS format. +"RTN","BMXGETS",16,0) + ; 4 - BMXFLG (opt) Flags - See GETS^DIQ documentation +"RTN","BMXGETS",17,0) + ; 9 - BMXMC (opt) Mixed Case: 1=mixed case, 0=no change. +"RTN","BMXGETS",18,0) + ; (Converts data in uppercase to mixed case.) +"RTN","BMXGETS",19,0) + ; 6 - BMXNUM (opt) Include IEN as first returned field (1=true) +"RTN","BMXGETS",20,0) + ; +"RTN","BMXGETS",21,0) + ;---> Set variables, kill temp globals. +"RTN","BMXGETS",22,0) + N BMX31 +"RTN","BMXGETS",23,0) + S BMX31=$C(31)_$C(31) +"RTN","BMXGETS",24,0) + S BMXGBL="^BMXTEMP("_$J_")",BMXERR="",U="^" +"RTN","BMXGETS",25,0) + K ^BMXTMP($J),^BMXTEMP($J) +"RTN","BMXGETS",26,0) + ; +"RTN","BMXGETS",27,0) + ;---> If file number not provided, return error. +"RTN","BMXGETS",28,0) + I '$G(BMXFL) D ERROUT("File number not provided.",1) Q +"RTN","BMXGETS",29,0) + ; +"RTN","BMXGETS",30,0) + I $G(BMXFLDS)="" S BMXFLDS=".01" +"RTN","BMXGETS",31,0) + ; +"RTN","BMXGETS",32,0) + ;---> Set Target Global for output and errors. +"RTN","BMXGETS",33,0) + S BMXG="^BMXTMP($J)" +"RTN","BMXGETS",34,0) + ; +"RTN","BMXGETS",35,0) + ;---> If Mixed Case not set, set to No Change. +"RTN","BMXGETS",36,0) + I '$D(BMXMC) S BMXMC=0 +"RTN","BMXGETS",37,0) + ; +"RTN","BMXGETS",38,0) + ;---> If Return IEN not set, set to No +"RTN","BMXGETS",39,0) + I '$D(BMXNUM) S BMXNUM=0 +"RTN","BMXGETS",40,0) + S BMXNUM=+BMXNUM +"RTN","BMXGETS",41,0) + ; +"RTN","BMXGETS",42,0) + ;---> Fileman call +"RTN","BMXGETS",43,0) + D GETS^DIQ(BMXFL,BMXIENS,BMXFLDS,BMXFLG,BMXG,BMXG) +"RTN","BMXGETS",44,0) + ; +"RTN","BMXGETS",45,0) + D WRITE +"RTN","BMXGETS",46,0) + Q +"RTN","BMXGETS",47,0) + ; +"RTN","BMXGETS",48,0) + ; +"RTN","BMXGETS",49,0) + ;---------- +"RTN","BMXGETS",50,0) +WRITE ;EP +"RTN","BMXGETS",51,0) + ;---> Collect data for matching records and write in result global. +"RTN","BMXGETS",52,0) + ; +"RTN","BMXGETS",53,0) + ;---> First, check for errors. +"RTN","BMXGETS",54,0) + ;---> If errors exist, write them and quit. +"RTN","BMXGETS",55,0) + N I,N,X,F,ASDX,ASDC,ASDXFNUM,ASDXFNAM +"RTN","BMXGETS",56,0) + I $D(^BMXTMP($J,"DIERR")) I $O(^("DIERR",0)) D Q +"RTN","BMXGETS",57,0) + .S N=0,X="" +"RTN","BMXGETS",58,0) + .F S N=$O(^BMXTMP($J,"DIERR",N)) Q:'N D +"RTN","BMXGETS",59,0) + ..N M S M=0 +"RTN","BMXGETS",60,0) + ..F S M=$O(^BMXTMP($J,"DIERR",N,"TEXT",M)) Q:'M D +"RTN","BMXGETS",61,0) + ...S X=X_^BMXTMP($J,"DIERR",N,"TEXT",M)_" " +"RTN","BMXGETS",62,0) + .D ERROUT(X,1) +"RTN","BMXGETS",63,0) + ; +"RTN","BMXGETS",64,0) + ; +"RTN","BMXGETS",65,0) + ;---> Write Field Names +"RTN","BMXGETS",66,0) + I BMXNUM S $P(ASDX,"^",1)="IEN" +"RTN","BMXGETS",67,0) + ;F ASDC=1:1:$L(BMXFLDS,";") D +"RTN","BMXGETS",68,0) + S ASDC=1 +"RTN","BMXGETS",69,0) + S ASDXFNUM=0 +"RTN","BMXGETS",70,0) + F S ASDXFNUM=$O(^BMXTMP($J,BMXFL,BMXIENS,ASDXFNUM)) Q:'ASDXFNUM D +"RTN","BMXGETS",71,0) + . ;S ASDXFNUM=$P(BMXFLDS,";",ASDC) +"RTN","BMXGETS",72,0) + . S ASDXFNAM=$P(^DD(BMXFL,ASDXFNUM,0),"^") +"RTN","BMXGETS",73,0) + . S:ASDXFNAM="" ASDXFNAM="UNKNOWN"_ASDC +"RTN","BMXGETS",74,0) + . S $P(ASDX,"^",ASDC+BMXNUM)=ASDXFNAM +"RTN","BMXGETS",75,0) + . S ASDC=ASDC+1 +"RTN","BMXGETS",76,0) + S ^BMXTEMP($J,1)=ASDX_$C(30) +"RTN","BMXGETS",77,0) + ;---> Write valid results. +"RTN","BMXGETS",78,0) +AAA ;---> Loop through results global +"RTN","BMXGETS",79,0) + S I=2,N=0 F S N=$O(^BMXTMP($J,BMXFL,N)) Q:'N D +"RTN","BMXGETS",80,0) + . S X="",F=0 +"RTN","BMXGETS",81,0) + . I BMXNUM S X=+N +"RTN","BMXGETS",82,0) + . F S F=$O(^BMXTMP($J,BMXFL,N,F)) Q:'F D +"RTN","BMXGETS",83,0) + . . S:X'="" X=X_U +"RTN","BMXGETS",84,0) + . . I $P(^DD(BMXFL,F,0),U,2) D I 1 ;Multiple or WP +"RTN","BMXGETS",85,0) + . . . ;Get the subfile number into FL1 +"RTN","BMXGETS",86,0) + . . . S FL1=+$P(^DD(BMXFL,F,0),U,2) +"RTN","BMXGETS",87,0) + . . . S FLD1=$O(^DD(FL1,0)) +"RTN","BMXGETS",88,0) + . . . I $P(^DD(FL1,FLD1,0),U,2)["W" D ;WP +"RTN","BMXGETS",89,0) + . . . . S WPL=0 F S WPL=$O(^BMXTMP($J,BMXFL,N,F,WPL)) Q:'WPL D +"RTN","BMXGETS",90,0) + . . . . . S X=X_^BMXTMP($J,BMXFL,N,F,WPL)_" " +"RTN","BMXGETS",91,0) + . . . . . Q +"RTN","BMXGETS",92,0) + . . . . Q +"RTN","BMXGETS",93,0) + . . . D ;It's a multiple. Implement in next phase +"RTN","BMXGETS",94,0) + . . . . Q ; +"RTN","BMXGETS",95,0) + . . . Q +"RTN","BMXGETS",96,0) + . . E D ;Not a multiple +"RTN","BMXGETS",97,0) + . . . S X=X_^BMXTMP($J,BMXFL,N,F) +"RTN","BMXGETS",98,0) + . . . Q +"RTN","BMXGETS",99,0) + . . Q +"RTN","BMXGETS",100,0) + . ;---> Convert data to mixed case if BMXMC=1. +"RTN","BMXGETS",101,0) +ZZZ . S:BMXMC X=$$T^BMXTRS(X) +"RTN","BMXGETS",102,0) + . ; +"RTN","BMXGETS",103,0) + . ;---> Set data in result global. +"RTN","BMXGETS",104,0) + . S ^BMXTEMP($J,I)=X_$C(30) +"RTN","BMXGETS",105,0) + . S I=I+1 +"RTN","BMXGETS",106,0) + ; +"RTN","BMXGETS",107,0) + ;---> If no results, report it as an error. +"RTN","BMXGETS",108,0) + D:'$O(^BMXTEMP($J,0)) +"RTN","BMXGETS",109,0) + .I BMXIN]"" S BMXERR="No entry matches """_BMXIN_"""." Q +"RTN","BMXGETS",110,0) + .S BMXERR="Either the lookup file is empty" +"RTN","BMXGETS",111,0) + .S BMXERR=BMXERR_" or all entries are screened (software error)." +"RTN","BMXGETS",112,0) + ; +"RTN","BMXGETS",113,0) + ;---> Tack on Error Delimiter and any error. +"RTN","BMXGETS",114,0) + S ^BMXTEMP($J,I)=BMX31_BMXERR +"RTN","BMXGETS",115,0) + Q +"RTN","BMXGETS",116,0) + ; +"RTN","BMXGETS",117,0) + ; +"RTN","BMXGETS",118,0) + ;---------- +"RTN","BMXGETS",119,0) +ERROUT(BMXERR,I) ;EP +"RTN","BMXGETS",120,0) + ;---> Save next line for Error Code File if ever used. +"RTN","BMXGETS",121,0) + ;---> If necessary, use I>1 to avoid overwriting valid data. +"RTN","BMXGETS",122,0) + S:'$G(I) I=1 +"RTN","BMXGETS",123,0) + S ^BMXTEMP($J,I)=BMX31_BMXERR +"RTN","BMXGETS",124,0) + Q +"RTN","BMXGETS",125,0) + ; +"RTN","BMXGETS",126,0) + ; +"RTN","BMXGETS",127,0) +PASSERR(BMXGBL,BMXERR) ;EP +"RTN","BMXGETS",128,0) + ;---> If the RPC routine calling the BMX Generic Lookup above +"RTN","BMXGETS",129,0) + ;---> detects a specific error prior to the call and wants to pass +"RTN","BMXGETS",130,0) + ;---> that error in the result global rather than a generic error, +"RTN","BMXGETS",131,0) + ;---> then a call to this function (PASSERR) can be made. +"RTN","BMXGETS",132,0) + ;---> This call will store the error text passed in the result global. +"RTN","BMXGETS",133,0) + ;---> The calling routine should then quit (abort its call to the +"RTN","BMXGETS",134,0) + ;---> BMX Generic Lookup function above). +"RTN","BMXGETS",135,0) + ; +"RTN","BMXGETS",136,0) + ;---> Parameters: +"RTN","BMXGETS",137,0) + ; 1 - BMXGBL (ret) Name of result global for Broker. +"RTN","BMXGETS",138,0) + ; 2 - BMXERR (req) Text of error to be stored in result global. +"RTN","BMXGETS",139,0) + ; +"RTN","BMXGETS",140,0) + S:$G(BMXERR)="" BMXERR="Error not passed (software error)." +"RTN","BMXGETS",141,0) + ; +"RTN","BMXGETS",142,0) + N BMX31 S BMX31=$C(31)_$C(31) +"RTN","BMXGETS",143,0) + K ^BMXTMP($J),^BMXTEMP($J) +"RTN","BMXGETS",144,0) + S BMXGBL="^BMXTEMP("_$J_")" +"RTN","BMXGETS",145,0) + S ^BMXTEMP($J,1)=BMX31_BMXERR +"RTN","BMXGETS",146,0) + Q +"RTN","BMXMBRK") +0^82^B32854296 +"RTN","BMXMBRK",1,0) +BMXMBRK ; IHS/OIT/HMW - BMXNet MONITOR ; +"RTN","BMXMBRK",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXMBRK",3,0) + ; +"RTN","BMXMBRK",4,0) + ; +"RTN","BMXMBRK",5,0) +PRSP(P) ;EP -Parse Protocol +"RTN","BMXMBRK",6,0) + ;M Extrinsic Function +"RTN","BMXMBRK",7,0) + ; +"RTN","BMXMBRK",8,0) + ;Inputs +"RTN","BMXMBRK",9,0) + ;P Protocol string with the form +"RTN","BMXMBRK",10,0) + ; Protocol := Protocol Header^Message where +"RTN","BMXMBRK",11,0) + ; Protocol Header := LLLWKID;WINH;PRCH;WISH;MESG +"RTN","BMXMBRK",12,0) + ; LLL := length of protocol header (3 numeric) +"RTN","BMXMBRK",13,0) + ; WKID := Workstation ID (ALPHA) +"RTN","BMXMBRK",14,0) + ; WINH := Window handle (ALPHA) +"RTN","BMXMBRK",15,0) + ; PRCH := Process handle (ALPHA) +"RTN","BMXMBRK",16,0) + ; WISH := Window server handle (ALPHA) +"RTN","BMXMBRK",17,0) + ; MESG := Unparsed message +"RTN","BMXMBRK",18,0) + ;Outputs +"RTN","BMXMBRK",19,0) + ;ERR 0 for success, "-1^Text" if error +"RTN","BMXMBRK",20,0) + ; +"RTN","BMXMBRK",21,0) + N ERR,C,M,R,X +"RTN","BMXMBRK",22,0) + S R=0,C=";",ERR=0,M=512 ;Maximum buffer input +"RTN","BMXMBRK",23,0) + IF $E(P,1,5)="{BMX}" S P=$E(P,6,$L(P)) ;drop out prefix +"RTN","BMXMBRK",24,0) + IF '+$G(P) S ERR="-1^Required input reference is NULL" +"RTN","BMXMBRK",25,0) + IF +ERR=0 D +"RTN","BMXMBRK",26,0) + . S BMXZ(R,"LENG")=+$E(P,1,3) +"RTN","BMXMBRK",27,0) + . S X=$E(P,4,BMXZ(R,"LENG")+3) +"RTN","BMXMBRK",28,0) + . S BMXZ(R,"MESG")=$E(P,BMXZ(R,"LENG")+4,M) +"RTN","BMXMBRK",29,0) + . S BMXZ(R,"WKID")=$P(X,C) +"RTN","BMXMBRK",30,0) + . S BMXZ(R,"WINH")=$P(X,C,2) +"RTN","BMXMBRK",31,0) + . S BMXZ(R,"PRCH")=$P(X,C,3) +"RTN","BMXMBRK",32,0) + . S BMXZ(R,"WISH")=$P(X,C,4) +"RTN","BMXMBRK",33,0) + Q ERR +"RTN","BMXMBRK",34,0) + ; +"RTN","BMXMBRK",35,0) +PRSM(P) ;EP - Parse message +"RTN","BMXMBRK",36,0) + ;M Extrinsic Function +"RTN","BMXMBRK",37,0) + ; +"RTN","BMXMBRK",38,0) + ;Inputs +"RTN","BMXMBRK",39,0) + ;P Message string with the form +"RTN","BMXMBRK",40,0) + ; Message := Header^Content +"RTN","BMXMBRK",41,0) + ; Header := LLL;FLAG +"RTN","BMXMBRK",42,0) + ; LLL := length of entire message (3 numeric) +"RTN","BMXMBRK",43,0) + ; FLAG := 1 indicates variables follow +"RTN","BMXMBRK",44,0) + ; Content := Contains API call information +"RTN","BMXMBRK",45,0) + ;Outputs +"RTN","BMXMBRK",46,0) + ;ERR 0 for success, "-1^Text" if error +"RTN","BMXMBRK",47,0) + N C,ERR,M,R,X,U +"RTN","BMXMBRK",48,0) + S U="^",R=1,C=";",ERR=0,M=512 ;Max buffer +"RTN","BMXMBRK",49,0) + IF '+$G(P) S ERR="-1^Required input reference is NULL" +"RTN","BMXMBRK",50,0) + IF +ERR=0 D +"RTN","BMXMBRK",51,0) + . S BMXZ(R,"LENG")=+$E(P,1,5) +"RTN","BMXMBRK",52,0) + . S BMXZ(R,"FLAG")=$E(P,6,6) +"RTN","BMXMBRK",53,0) + . S BMXZ(R,"TEXT")=$E(P,7,M) +"RTN","BMXMBRK",54,0) + Q ERR +"RTN","BMXMBRK",55,0) + ; +"RTN","BMXMBRK",56,0) +PRSA(P) ;EP - Parse API information, get calling info +"RTN","BMXMBRK",57,0) + ;M Extrinsic Function +"RTN","BMXMBRK",58,0) + ;Inputs +"RTN","BMXMBRK",59,0) + ;P Content := API Name^Param string +"RTN","BMXMBRK",60,0) + ; API := .01 field of API file +"RTN","BMXMBRK",61,0) + ; Param := Parameter information +"RTN","BMXMBRK",62,0) + ;Outputs +"RTN","BMXMBRK",63,0) + ;ERR 0 for success, "-1^Text" if error +"RTN","BMXMBRK",64,0) + ; +"RTN","BMXMBRK",65,0) + N C,DR,ERR,M,R,T,X,U +"RTN","BMXMBRK",66,0) + S U="^",R=2,C=";",ERR=0,M=512 ;Max buffer +"RTN","BMXMBRK",67,0) + IF '+$L(P) S ERR="-1^Required input reference is NULL" +"RTN","BMXMBRK",68,0) + IF +ERR=0 D +"RTN","BMXMBRK",69,0) + . S BMXZ(R,"CAPI")=$P(P,U) +"RTN","BMXMBRK",70,0) + . S BMXZ(R,"PARM")=$E(P,$F(P,U),M) +"RTN","BMXMBRK",71,0) + . S T=$O(^XWB(8994,"B",BMXZ(R,"CAPI"),0)) +"RTN","BMXMBRK",72,0) + . I '+T S ERR="-1^Remote Procedure '"_BMXZ(R,"CAPI")_"' doesn't exist on the server." Q ;P10 - dpc +"RTN","BMXMBRK",73,0) + . S T(0)=$G(^XWB(8994,T,0)) +"RTN","BMXMBRK",74,0) + . I $P(T(0),U,6)=1!($P(T(0),U,6)=2) S ERR="-1^Remote Procedure '"_BMXZ(R,"CAPI")_"' cannot be run at this time." Q ;P10. Check INACTIVE field. - dpc. +"RTN","BMXMBRK",75,0) + . S BMXZ(R,"NAME")=$P(T(0),"^") +"RTN","BMXMBRK",76,0) + . S BMXZ(R,"RTAG")=$P(T(0),"^",2) +"RTN","BMXMBRK",77,0) + . S BMXZ(R,"RNAM")=$P(T(0),"^",3) +"RTN","BMXMBRK",78,0) + . S BMXPTYPE=$P(T(0),"^",4) +"RTN","BMXMBRK",79,0) + . S BMXWRAP=+$P(T(0),"^",8) +"RTN","BMXMBRK",80,0) + Q ERR +"RTN","BMXMBRK",81,0) + ; +"RTN","BMXMBRK",82,0) +PRSB(P) ;EP - Parse Parameter information +"RTN","BMXMBRK",83,0) + ;M Extrinsic Function +"RTN","BMXMBRK",84,0) + ;Inputs +"RTN","BMXMBRK",85,0) + ;P Param := M parameter list +"RTN","BMXMBRK",86,0) + ; Param := LLL,Name,Value +"RTN","BMXMBRK",87,0) + ; LLL := length of variable name and value +"RTN","BMXMBRK",88,0) + ; Name := name of M variable +"RTN","BMXMBRK",89,0) + ; Value := a string +"RTN","BMXMBRK",90,0) + ;Outputs +"RTN","BMXMBRK",91,0) + ;ERR 0 for success, "-1^Text" if error +"RTN","BMXMBRK",92,0) + ; +"RTN","BMXMBRK",93,0) + N A,ERR,F,FL,I,K,L,M,P1,P2,P3,P4,P5,MAXP,R +"RTN","BMXMBRK",94,0) + S R=3,MAXP=+$E(P,1,5) +"RTN","BMXMBRK",95,0) + S P1=$E(P,6,MAXP+5) ;only param string +"RTN","BMXMBRK",96,0) + S ERR=0,F=3,M=512 +"RTN","BMXMBRK",97,0) + IF '+$D(P) S ERR="-1^Required input reference is NULL" +"RTN","BMXMBRK",98,0) + S FL=+$G(BMXZ(1,"FLAG")) +"RTN","BMXMBRK",99,0) + S I=0 +"RTN","BMXMBRK",100,0) + IF '+ERR D +"RTN","BMXMBRK",101,0) + . IF 'FL,+MAXP=0 S P1="",ERR=1 Q +"RTN","BMXMBRK",102,0) + . F D Q:P1="" +"RTN","BMXMBRK",103,0) + . . Q:P1="" +"RTN","BMXMBRK",104,0) + . . S L=+$E(P1,1,3)-1 +"RTN","BMXMBRK",105,0) + . . S P3=+$E(P1,4,4) +"RTN","BMXMBRK",106,0) + . . S P1=$E(P1,5,MAXP) +"RTN","BMXMBRK",107,0) + . . S BMXZ(R,"P",I)=$S(P3'=1:$E(P1,1,L),1:$$GETV($E(P1,1,L))) +"RTN","BMXMBRK",108,0) + . . IF FL=1,P3=2 D ;XWB*1.1*2 +"RTN","BMXMBRK",109,0) + . . . S A=$$OARY^BMXMBRK2,BMXARY=A +"RTN","BMXMBRK",110,0) + . . . S BMXZ(R,"P",I)=$$CREF^BMXMBRK2(A,BMXZ(R,"P",I)) +"RTN","BMXMBRK",111,0) + . . S P1=$E(P1,L+1,MAXP) +"RTN","BMXMBRK",112,0) + . . S K=I,I=I+1 +"RTN","BMXMBRK",113,0) + . IF 'FL Q +"RTN","BMXMBRK",114,0) + . S P3=P +"RTN","BMXMBRK",115,0) + . S L=+$E(P3,1,5) +"RTN","BMXMBRK",116,0) + . S P1=$E(P3,F+3,L+F) +"RTN","BMXMBRK",117,0) + . S P2=$E(P3,L+F+3,M) +"RTN","BMXMBRK",118,0) + . ;instantiate array +"RTN","BMXMBRK",119,0) + . F D Q:+L=0 +"RTN","BMXMBRK",120,0) + . . S L=$$BREAD(3) Q:+L=0 S P3=$$BREAD(L) +"RTN","BMXMBRK",121,0) + . . S L=$$BREAD(3) IF +L'=0 S P4=$$BREAD(L) +"RTN","BMXMBRK",122,0) + . . IF +L=0 Q +"RTN","BMXMBRK",123,0) + . . IF P3=0,P4=0 S L=0 Q +"RTN","BMXMBRK",124,0) + . . IF FL=1 D LINST(A,P3,P4) +"RTN","BMXMBRK",125,0) + . . IF FL=2 D GINST +"RTN","BMXMBRK",126,0) + IF ERR Q P1 +"RTN","BMXMBRK",127,0) + S P1="" +"RTN","BMXMBRK",128,0) + D Q P1 +"RTN","BMXMBRK",129,0) + . F I=0:1:K D +"RTN","BMXMBRK",130,0) + . . IF FL,$E(BMXZ(R,"P",I),1,5)=".BMXS" D Q ;XWB*1.1*2 +"RTN","BMXMBRK",131,0) + . . . S P1=P1_"."_$E(BMXZ(R,"P",I),2,$L(BMXZ(R,"P",I))) +"RTN","BMXMBRK",132,0) + . . . IF I'=K S P1=P1_"," +"RTN","BMXMBRK",133,0) + . . S P1=P1_"BMXZ("_R_",""P"","_I_")" +"RTN","BMXMBRK",134,0) + . . IF I'=K S P1=P1_"," +"RTN","BMXMBRK",135,0) + IF '+ERR Q P1 +"RTN","BMXMBRK",136,0) + Q ERR +"RTN","BMXMBRK",137,0) + ; +"RTN","BMXMBRK",138,0) +BREAD(L) ;read tcp buffer, L is length +"RTN","BMXMBRK",139,0) + N E,X,DONE +"RTN","BMXMBRK",140,0) + S (E,DONE)=0 +"RTN","BMXMBRK",141,0) + R X#L:BMXDTIME(1) +"RTN","BMXMBRK",142,0) + S E=X +"RTN","BMXMBRK",143,0) + IF $L(E)0) D +"RTN","BMXMBRK",159,0) + I '+ERR D CHKPRMIT^BMXMSEC(BMXZ(2,"CAPI")) ;checks if RPC allowed to run +"RTN","BMXMBRK",160,0) + S:$L($G(BMXSEC)) ERR="-1^"_BMXSEC +"RTN","BMXMBRK",161,0) + ;IF 'DEBUG S:$D(XRT0) XRTN="RPC BROKER READ/PARSE" D:$D(XRT0) T1^%ZOSV ;stop RTL +"RTN","BMXMBRK",162,0) + IF '+ERR,(+S=0)!(+S>0) D +"RTN","BMXMBRK",163,0) + . D CAPI^BMXMBRK2(.BMXP,BMXZ(2,"RTAG"),BMXZ(2,"RNAM"),S) +"RTN","BMXMBRK",164,0) + E D CLRBUF ;p10 +"RTN","BMXMBRK",165,0) + IF 'DEBUG K BMXZ +"RTN","BMXMBRK",166,0) + IF $D(BMXARY) K @BMXARY,BMXARY +"RTN","BMXMBRK",167,0) + Q +"RTN","BMXMBRK",168,0) + ; +"RTN","BMXMBRK",169,0) +LINST(A,X,BMXY) ;instantiate local array +"RTN","BMXMBRK",170,0) + IF BMXY=$C(1) S BMXY="" +"RTN","BMXMBRK",171,0) + S X=A_"("_X_")" +"RTN","BMXMBRK",172,0) + S @X=BMXY +"RTN","BMXMBRK",173,0) + Q +"RTN","BMXMBRK",174,0) +GINST ;instantiate global +"RTN","BMXMBRK",175,0) + N DONE,N,T,T1 +"RTN","BMXMBRK",176,0) + S (DONE,I)=0 +"RTN","BMXMBRK",177,0) + ;find piece with global ref - recover $C(44) +"RTN","BMXMBRK",178,0) + S REF=$TR(REF,$C(23),$C(44)) +"RTN","BMXMBRK",179,0) + F D Q:DONE +"RTN","BMXMBRK",180,0) + . S N=$NA(^TMP("BMXZ",$J,$P($H,",",2))) +"RTN","BMXMBRK",181,0) + . S BMXZ("FRM")=REF +"RTN","BMXMBRK",182,0) + . S BMXZ("TO")=N +"RTN","BMXMBRK",183,0) + . IF '$D(@N) S DONE=1 Q +"RTN","BMXMBRK",184,0) + ;loop through all and instantiate +"RTN","BMXMBRK",185,0) + S DONE=0 +"RTN","BMXMBRK",186,0) + F D Q:DONE +"RTN","BMXMBRK",187,0) + . S T=$E(@REF@(I),4,M) +"RTN","BMXMBRK",188,0) + . IF T="" S DONE=1 Q +"RTN","BMXMBRK",189,0) + . S @N@("BMXZ")="" ;set naked indicator +"RTN","BMXMBRK",190,0) + . S @T +"RTN","BMXMBRK",191,0) + . S I=I+1 +"RTN","BMXMBRK",192,0) + K @N@("BMXZ") +"RTN","BMXMBRK",193,0) + Q +"RTN","BMXMBRK",194,0) + ; +"RTN","BMXMBRK",195,0) +GETV(V) ;get value of V - reference parameter +"RTN","BMXMBRK",196,0) + N X +"RTN","BMXMBRK",197,0) + S X=V +"RTN","BMXMBRK",198,0) + IF $E(X,1,2)="$$" Q "" +"RTN","BMXMBRK",199,0) + IF $C(34,36)[$E(V) X "S V="_$$VCHK(V) +"RTN","BMXMBRK",200,0) + E S V=@V +"RTN","BMXMBRK",201,0) + Q V +"RTN","BMXMBRK",202,0) + ; +"RTN","BMXMBRK",203,0) +VCHK(S) ;Parse string for first argument +"RTN","BMXMBRK",204,0) + N C,I,P +"RTN","BMXMBRK",205,0) + F I=1:1 S C=$E(S,I) D VCHKP:C="(",VCHKQ:C=$C(34) Q:" ,"[C +"RTN","BMXMBRK",206,0) + Q $E(S,1,I-1) +"RTN","BMXMBRK",207,0) +VCHKP S P=1 ;Find closing paren +"RTN","BMXMBRK",208,0) + F I=I+1:1 S C=$E(S,I) Q:P=0!(C="") I "()"""[C D VCHKQ:C=$C(34) S P=P+$S("("[C:1,")"[C:-1,1:0) +"RTN","BMXMBRK",209,0) + Q +"RTN","BMXMBRK",210,0) +VCHKQ ;Find closing quote +"RTN","BMXMBRK",211,0) + F I=I+1:1 S C=$E(S,I) Q:C=""!(C=$C(34)) +"RTN","BMXMBRK",212,0) + Q +"RTN","BMXMBRK",213,0) +CLRBUF ;p10 Empties Input buffer +"RTN","BMXMBRK",214,0) + N % +"RTN","BMXMBRK",215,0) + F R %#1:BMXDTIME(1) Q:%="" +"RTN","BMXMBRK",216,0) + Q +"RTN","BMXMBRK2") +0^83^B17554247 +"RTN","BMXMBRK2",1,0) +BMXMBRK2 ; IHS/OIT/HMW - BMXNet MONITOR ; +"RTN","BMXMBRK2",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXMBRK2",3,0) + ; +"RTN","BMXMBRK2",4,0) + ; +"RTN","BMXMBRK2",5,0) +CAPI(BMXY,TAG,NAM,PAR) ;EP - make API call +"RTN","BMXMBRK2",6,0) + N R,T,DX,DY +"RTN","BMXMBRK2",7,0) + IF BMXZ(1,"FLAG")=2 D +"RTN","BMXMBRK2",8,0) + . S PAR=$P(PAR,BMXZ("FRM"))_BMXZ("TO")_$P(PAR,BMXZ("FRM"),2) +"RTN","BMXMBRK2",9,0) + S R=$S(PAR'=+PAR&(PAR=""):TAG_"^"_NAM_"(.BMXY)",1:TAG_"^"_NAM_"(.BMXY,"_PAR_")") +"RTN","BMXMBRK2",10,0) + U IO +"RTN","BMXMBRK2",11,0) + D @R +"RTN","BMXMBRK2",12,0) + ; D DEBUG^%Serenji("@R","10.10.10.104") +"RTN","BMXMBRK2",13,0) + U $P +"RTN","BMXMBRK2",14,0) + Q +"RTN","BMXMBRK2",15,0) + ; +"RTN","BMXMBRK2",16,0) +BHDR(WKID,WINH,PRCH,WISH) ;Build a protocol header +"RTN","BMXMBRK2",17,0) + N S,L +"RTN","BMXMBRK2",18,0) + S S="" +"RTN","BMXMBRK2",19,0) + S S=WKID_";"_WINH_";"_PRCH_";"_WISH_";" +"RTN","BMXMBRK2",20,0) + S L=$L(S) +"RTN","BMXMBRK2",21,0) + S S=$E("000"_L,$L(L)+1,$L(L)+3)_S +"RTN","BMXMBRK2",22,0) + Q S +"RTN","BMXMBRK2",23,0) + ; +"RTN","BMXMBRK2",24,0) +BARY(A,R,V) ;add array elements+values to storage array +"RTN","BMXMBRK2",25,0) + IF A'["BMXS" Q "-1^ARRAY NAME MUST BE BMXS" +"RTN","BMXMBRK2",26,0) + S @A@(R)=V +"RTN","BMXMBRK2",27,0) + Q 0 +"RTN","BMXMBRK2",28,0) + ; +"RTN","BMXMBRK2",29,0) +BLDB(P) ;Build formatted string +"RTN","BMXMBRK2",30,0) + N L +"RTN","BMXMBRK2",31,0) + S L=$L(P) +"RTN","BMXMBRK2",32,0) + Q $E("000"_L,$L(L)+1,$L(L)+3)_P +"RTN","BMXMBRK2",33,0) + ; +"RTN","BMXMBRK2",34,0) +BLDA(N,P) ;Build API string +"RTN","BMXMBRK2",35,0) + ;M Extrinsic Function +"RTN","BMXMBRK2",36,0) + ;Inputs +"RTN","BMXMBRK2",37,0) + ;N API name +"RTN","BMXMBRK2",38,0) + ;P Comma delimited parameter string +"RTN","BMXMBRK2",39,0) + ;Outputs +"RTN","BMXMBRK2",40,0) + ;String API string if successful, "-1^Text" if error +"RTN","BMXMBRK2",41,0) + ; +"RTN","BMXMBRK2",42,0) + N I,F,L,T,U,T1,T2 +"RTN","BMXMBRK2",43,0) + IF '+$D(N) Q "-1^Required input reference is NULL" +"RTN","BMXMBRK2",44,0) + S U="^" +"RTN","BMXMBRK2",45,0) + S (F,T,Y)=0 +"RTN","BMXMBRK2",46,0) + IF '$D(P) S P="" +"RTN","BMXMBRK2",47,0) + IF P'="" D +"RTN","BMXMBRK2",48,0) + . S L=$L(P)-$L($TR(P,$C(44)))+1 +"RTN","BMXMBRK2",49,0) + . IF L=0 S L=1 +"RTN","BMXMBRK2",50,0) + . F I=1:1:L D Q:T +"RTN","BMXMBRK2",51,0) + . . S T1=$P(P,",",I) +"RTN","BMXMBRK2",52,0) + . . S T2=$E(T1,1,1)="." +"RTN","BMXMBRK2",53,0) + . . IF T1=+T1 Q +"RTN","BMXMBRK2",54,0) + . . IF $E(T1,1,1)="^" S F=2,T=1 Q +"RTN","BMXMBRK2",55,0) + . . IF T2&($E(T1,2,$L(T1))?.ANP) S F=1,T=1 Q +"RTN","BMXMBRK2",56,0) + S P=$$BLDB(P) +"RTN","BMXMBRK2",57,0) + S L=$L(P)+$L(P)-3 +"RTN","BMXMBRK2",58,0) + S P=F_N_U_P +"RTN","BMXMBRK2",59,0) + S L=$L(P) +"RTN","BMXMBRK2",60,0) + Q $E("000"_L,$L(L)+1,$L(L)+3)_P +"RTN","BMXMBRK2",61,0) + ; +"RTN","BMXMBRK2",62,0) +BLDS(R) ;Build a parameter string from an array +"RTN","BMXMBRK2",63,0) + N L,T,Y +"RTN","BMXMBRK2",64,0) + S Y="" +"RTN","BMXMBRK2",65,0) + F D Q:R="" +"RTN","BMXMBRK2",66,0) + . S R=$Q(@R) +"RTN","BMXMBRK2",67,0) + . IF R="" Q +"RTN","BMXMBRK2",68,0) + . S L=$L(R)+$L(@R)+1 +"RTN","BMXMBRK2",69,0) + . S T=@R +"RTN","BMXMBRK2",70,0) + . S T=$TR(T,$C(44),$C(23)) +"RTN","BMXMBRK2",71,0) + . S Y=Y_$E("000"_L,$L(L)+1,$L(L)+3)_R_"="_T +"RTN","BMXMBRK2",72,0) + Q Y_"000" +"RTN","BMXMBRK2",73,0) + ; +"RTN","BMXMBRK2",74,0) +BLDU(R) ;Build a parameter string from a scalar +"RTN","BMXMBRK2",75,0) + N DONE,L,N,N1,P1 +"RTN","BMXMBRK2",76,0) + IF R=+R Q R +"RTN","BMXMBRK2",77,0) + S N=$F(R,$C(34)) +"RTN","BMXMBRK2",78,0) + IF N=0 Q $C(34)_R_$C(34) +"RTN","BMXMBRK2",79,0) + S P1=$E(R,1,N-2) +"RTN","BMXMBRK2",80,0) + S (L,DONE)=0 +"RTN","BMXMBRK2",81,0) + F D Q:DONE +"RTN","BMXMBRK2",82,0) + . S N1=$F(R,$C(34),N) +"RTN","BMXMBRK2",83,0) + . IF N1=0 S L=$L(R)+2,N1=L +"RTN","BMXMBRK2",84,0) + . S P1=P1_$C(34,34)_$E(R,N,N1-2) +"RTN","BMXMBRK2",85,0) + . IF N1=L S DONE=1,P1=$C(34)_P1_$C(34) Q +"RTN","BMXMBRK2",86,0) + . S N=N1 +"RTN","BMXMBRK2",87,0) + Q $TR(P1,$C(44),$C(23)) +"RTN","BMXMBRK2",88,0) + ; +"RTN","BMXMBRK2",89,0) +BLDG(R) ;build a parameter string from a global reference +"RTN","BMXMBRK2",90,0) + N I,L,L1,M,T,T1,T2,Y +"RTN","BMXMBRK2",91,0) + K ^TMP("BMXZ",$J) +"RTN","BMXMBRK2",92,0) + IF '$D(R) Q "-1^Reference does not exist" +"RTN","BMXMBRK2",93,0) + S Y=$NA(^TMP("BMXZ",$J,$P($H,",",2))) +"RTN","BMXMBRK2",94,0) + S I=0 +"RTN","BMXMBRK2",95,0) + S M=512 +"RTN","BMXMBRK2",96,0) + S T1=$P(R,")") +"RTN","BMXMBRK2",97,0) + S L1=$L($P(R,"(")) +"RTN","BMXMBRK2",98,0) + F D Q:R="" +"RTN","BMXMBRK2",99,0) + . S R=$Q(@R) +"RTN","BMXMBRK2",100,0) + . S T2=$F(R,"(") +"RTN","BMXMBRK2",101,0) + . IF R=""!(R'[T1) Q +"RTN","BMXMBRK2",102,0) + . S L=$L(R)+$L(@R)-L1 +"RTN","BMXMBRK2",103,0) + . S T=@R +"RTN","BMXMBRK2",104,0) + . S T=$TR(T,$C(44),$C(23)) +"RTN","BMXMBRK2",105,0) + . S @Y@(I)=$E("000"_L,$L(L)+1,$L(L)+3)_"^("_$E(R,T2,M)_"="_$$BLDU(T) +"RTN","BMXMBRK2",106,0) + . S I=I+1 +"RTN","BMXMBRK2",107,0) + S @Y@(I)="000" +"RTN","BMXMBRK2",108,0) + S Y=$TR(Y,$C(44),$C(23)) +"RTN","BMXMBRK2",109,0) + Q Y +"RTN","BMXMBRK2",110,0) + ; +"RTN","BMXMBRK2",111,0) +OARY() ;EP - create storage array +"RTN","BMXMBRK2",112,0) + N A,DONE,I +"RTN","BMXMBRK2",113,0) + S (DONE,I)=0 +"RTN","BMXMBRK2",114,0) + F I=1:1 D Q:DONE +"RTN","BMXMBRK2",115,0) + . S A="BMXS"_I +"RTN","BMXMBRK2",116,0) + . K @A ;temp fix for single array +"RTN","BMXMBRK2",117,0) + . IF '$D(@A) S DONE=1 +"RTN","BMXMBRK2",118,0) + S @A="" ;set naked +"RTN","BMXMBRK2",119,0) + Q A +"RTN","BMXMBRK2",120,0) + ; +"RTN","BMXMBRK2",121,0) +CREF(R,P) ;EP - Convert array contained in P to reference A +"RTN","BMXMBRK2",122,0) + N I,X,DONE,F1,S +"RTN","BMXMBRK2",123,0) + S DONE=0 +"RTN","BMXMBRK2",124,0) + S S="" +"RTN","BMXMBRK2",125,0) + F I=1:1 D Q:DONE +"RTN","BMXMBRK2",126,0) + . IF $P(P,",",I)="" S DONE=1 Q +"RTN","BMXMBRK2",127,0) + . S X(I)=$P(P,",",I) +"RTN","BMXMBRK2",128,0) + . IF X(I)?1"."1A.E D +"RTN","BMXMBRK2",129,0) + . . S F1=$F(X(I),".") +"RTN","BMXMBRK2",130,0) + . . S X(I)="."_R +"RTN","BMXMBRK2",131,0) + . S S=S_X(I)_"," +"RTN","BMXMBRK2",132,0) + Q $E(S,1,$L(S)-1) +"RTN","BMXMBRK2",133,0) + ; +"RTN","BMXMBRK2",134,0) +GETP(P) ;returns various parameters out of the Protocol string +"RTN","BMXMBRK2",135,0) + N M,T,BMXZ +"RTN","BMXMBRK2",136,0) + S M=512 +"RTN","BMXMBRK2",137,0) + S T=$$PRSP^BMXMBRK(P) +"RTN","BMXMBRK2",138,0) + IF '+T D +"RTN","BMXMBRK2",139,0) + . S T=$$PRSM^BMXMBRK(BMXZ(0,"MESG")) +"RTN","BMXMBRK2",140,0) + . IF '+T S T=BMXZ(0,"WKID")_";"_BMXZ(0,"WINH")_";"_BMXZ(0,"PRCH")_";"_BMXZ(0,"WISH")_";"_$P(BMXZ(1,"TEXT"),"^") +"RTN","BMXMBRK2",141,0) + Q T +"RTN","BMXMBRK2",142,0) + ; +"RTN","BMXMBRK2",143,0) +CALLM(X,P,DEBUG) ;make call using Message string +"RTN","BMXMBRK2",144,0) + N ERR,S +"RTN","BMXMBRK2",145,0) + S X="",ERR=0 +"RTN","BMXMBRK2",146,0) + S ERR=$$PRSM^BMXMBRK(P) +"RTN","BMXMBRK2",147,0) + IF '+ERR S ERR=$$PRSA^BMXMBRK(BMXZ(1,"TEXT")) +"RTN","BMXMBRK2",148,0) + IF '+ERR S S=$$PRSB^BMXMBRK(BMXZ(2,"PARM")) +"RTN","BMXMBRK2",149,0) + IF (+S=0)!(+S>0) D +"RTN","BMXMBRK2",150,0) + . D CAPI(.X,BMXZ(2,"RTAG"),BMXZ(2,"RNAM"),S) +"RTN","BMXMBRK2",151,0) + IF 'DEBUG K BMXZ +"RTN","BMXMBRK2",152,0) + K @(X("BMXS")),X("BMXS") +"RTN","BMXMBRK2",153,0) + Q +"RTN","BMXMBRK2",154,0) + ; +"RTN","BMXMBRK2",155,0) +CALLA(X,P,DEBUG) ;make call using API string +"RTN","BMXMBRK2",156,0) + N ERR,S +"RTN","BMXMBRK2",157,0) + S X="",ERR=0 +"RTN","BMXMBRK2",158,0) + S ERR=$$PRSA^BMXMBRK(P) +"RTN","BMXMBRK2",159,0) + IF '+ERR S S=$$PRSB^BMXMBRK(BMXZ(2,"PARM")) +"RTN","BMXMBRK2",160,0) + IF (+S=0)!(+S>0) D +"RTN","BMXMBRK2",161,0) + . D CAPI(.X,BMXZ(2,"RTAG"),BMXZ(2,"RNAM"),S) +"RTN","BMXMBRK2",162,0) + IF 'DEBUG K BMXZ +"RTN","BMXMBRK2",163,0) + K @(X("BMXS")),X("BMXS") +"RTN","BMXMBRK2",164,0) + Q +"RTN","BMXMBRK2",165,0) + ; +"RTN","BMXMBRK2",166,0) +TRANSPRT() ;Determine the Transport Method +"RTN","BMXMBRK2",167,0) + ;DDP is local :=0 +"RTN","BMXMBRK2",168,0) + ;TCP/IP is remote :=1 +"RTN","BMXMBRK2",169,0) + ;Serial/RS-232 is remote :=2 +"RTN","BMXMBRK2",170,0) + Q 1 +"RTN","BMXMBRK2",171,0) + ;Q 0 ;Do DDP for Now +"RTN","BMXMEVN") +0^84^B41862703 +"RTN","BMXMEVN",1,0) +BMXMEVN ; IHS/OIT/HMW - BMXNet MONITOR ; +"RTN","BMXMEVN",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXMEVN",3,0) + ; +"RTN","BMXMEVN",4,0) + Q +"RTN","BMXMEVN",5,0) + ; +"RTN","BMXMEVN",6,0) +REGET ;EP +"RTN","BMXMEVN",7,0) + ;Error trap from REGEVNT, RAISEVNT, and UNREG +"RTN","BMXMEVN",8,0) + ; +"RTN","BMXMEVN",9,0) + I '$D(BMXI) N BMXI S BMXI=999 +"RTN","BMXMEVN",10,0) + S BMXI=BMXI+1 +"RTN","BMXMEVN",11,0) + D REGERR(BMXI,99) +"RTN","BMXMEVN",12,0) + Q +"RTN","BMXMEVN",13,0) + ; +"RTN","BMXMEVN",14,0) +REGERR(BMXI,BMXERID) ;Error processing +"RTN","BMXMEVN",15,0) + S BMXI=BMXI+1 +"RTN","BMXMEVN",16,0) + S ^TMP("BMX",$J,BMXI)=BMXERID_$C(30) +"RTN","BMXMEVN",17,0) + S BMXI=BMXI+1 +"RTN","BMXMEVN",18,0) + S ^TMP("BMX",$J,BMXI)=$C(31) +"RTN","BMXMEVN",19,0) + Q +"RTN","BMXMEVN",20,0) + ; +"RTN","BMXMEVN",21,0) +REGEVNT(BMXY,BMXEVENT) ;EP +"RTN","BMXMEVN",22,0) + ;RPC Called by BMX REGISTER EVENT to inform RPMS server +"RTN","BMXMEVN",23,0) + ;of client's interest in BMXEVENT +"RTN","BMXMEVN",24,0) + ;Returns RECORDSET with field ERRORID. +"RTN","BMXMEVN",25,0) + ;If everything ok then ERRORID = 0; +"RTN","BMXMEVN",26,0) + ; +"RTN","BMXMEVN",27,0) + N BMXI +"RTN","BMXMEVN",28,0) + S BMXI=0 +"RTN","BMXMEVN",29,0) + S X="REGET^BMXMEVN",@^%ZOSF("TRAP") +"RTN","BMXMEVN",30,0) + S BMXY=$NA(^TMP("BMX",$J)) K @BMXY +"RTN","BMXMEVN",31,0) + S ^TMP("BMX",$J,0)="I00020ERRORID"_$C(30) +"RTN","BMXMEVN",32,0) + S ^TMP("BMX EVENT",$J,BMXEVENT)=$G(DUZ) +"RTN","BMXMEVN",33,0) + ; +"RTN","BMXMEVN",34,0) + S BMXI=BMXI+1 +"RTN","BMXMEVN",35,0) + S ^TMP("BMX",$J,BMXI)="0"_$C(30)_$C(31) +"RTN","BMXMEVN",36,0) + Q +"RTN","BMXMEVN",37,0) + ; +"RTN","BMXMEVN",38,0) +RAISEVNT(BMXY,BMXEVENT,BMXPARAM,BMXBACK,BMXKEY) ;EP +"RTN","BMXMEVN",39,0) + ;RPC Called to raise event BMXEVENT with parameter BMXPARAM +"RTN","BMXMEVN",40,0) + ;If BMXBACK = 'TRUE' then event will be raised back to originator +"RTN","BMXMEVN",41,0) + ;Calls EVENT +"RTN","BMXMEVN",42,0) + ;Returns a RECORDSET wit the field ERRORID. +"RTN","BMXMEVN",43,0) + ;If everything ok then ERRORID = 0; +"RTN","BMXMEVN",44,0) + ; +"RTN","BMXMEVN",45,0) + N BMXI,BMXORIG +"RTN","BMXMEVN",46,0) + S BMXI=0 +"RTN","BMXMEVN",47,0) + S BMXORIG=$S($G(BMXBACK)="TRUE":"",1:$J) +"RTN","BMXMEVN",48,0) + S BMXY=$NA(^TMP("BMX",$J)) K @BMXY +"RTN","BMXMEVN",49,0) + S ^TMP("BMX",$J,0)="I00020ERRORID"_$C(30) +"RTN","BMXMEVN",50,0) + S X="REGET^BMXMEVN",@^%ZOSF("TRAP") +"RTN","BMXMEVN",51,0) + ; +"RTN","BMXMEVN",52,0) + D EVENT(BMXEVENT,BMXPARAM,BMXORIG,$G(BMXKEY)) +"RTN","BMXMEVN",53,0) + ; +"RTN","BMXMEVN",54,0) + S BMXI=BMXI+1 +"RTN","BMXMEVN",55,0) + S ^TMP("BMX",$J,BMXI)="0"_$C(30)_$C(31) +"RTN","BMXMEVN",56,0) + Q +"RTN","BMXMEVN",57,0) + ; +"RTN","BMXMEVN",58,0) +EVENT(BMXEVENT,BMXPARAM,BMXORIG,BMXKEY) ;PEP - Raise event to interested clients +"RTN","BMXMEVN",59,0) + ;Clients are listed in ^TMP("BMX EVENT",BMXEVENT,BMXSESS)=DUZ +"RTN","BMXMEVN",60,0) + ;BMXORIG represents the event originator's session +"RTN","BMXMEVN",61,0) + ;The event will not be raised back to the originator if BMXORIG is the session of the originator +"RTN","BMXMEVN",62,0) + ;BMXKEY is a ~-delimited list of security keys. Only holders of one of these keys +"RTN","BMXMEVN",63,0) + ;will receive event notification. If BMXKEY is "" then all registered sessions +"RTN","BMXMEVN",64,0) + ;will be notified. +"RTN","BMXMEVN",65,0) + ; +"RTN","BMXMEVN",66,0) + L +^TMP("BMX EVENT RAISED"):30 +"RTN","BMXMEVN",67,0) + N BMXSESS,BMXINC +"RTN","BMXMEVN",68,0) + S BMXSESS=0 F S BMXSESS=$O(^TMP("BMX EVENT",BMXSESS)) Q:'+BMXSESS D +"RTN","BMXMEVN",69,0) + . I BMXSESS=$G(BMXORIG) Q +"RTN","BMXMEVN",70,0) + . I '$D(^TMP("BMX EVENT",BMXSESS,BMXEVENT)) Q +"RTN","BMXMEVN",71,0) + . ;S BMXDUZ=^TMP("BMX EVENT",BMXEVENT,BMXSESS) +"RTN","BMXMEVN",72,0) + . S BMXDUZ=^TMP("BMX EVENT",BMXSESS,BMXEVENT) +"RTN","BMXMEVN",73,0) + . ;TODO: Test if DUZ holds at least one of the keys in BMXKEY +"RTN","BMXMEVN",74,0) + . S BMXINC=$O(^TMP("BMX EVENT RAISED",BMXSESS,BMXEVENT,99999999),-1) +"RTN","BMXMEVN",75,0) + . S:BMXINC="" BMXINC=0 +"RTN","BMXMEVN",76,0) + . ;S ^TMP("BMXTRACK",$P($H,",",2))="Job "_$J_" Set "_$NA(^TMP("BMX EVENT RAISED",BMXSESS,BMXEVENT,BMXINC+1))_"="_$G(BMXPARAM) +"RTN","BMXMEVN",77,0) + . S ^TMP("BMX EVENT RAISED",BMXSESS,BMXEVENT,BMXINC+1)=$G(BMXPARAM) ;IHS/OIT/HMW SAC Exemption Applied For +"RTN","BMXMEVN",78,0) + . Q +"RTN","BMXMEVN",79,0) + L -^TMP("BMX EVENT RAISED") +"RTN","BMXMEVN",80,0) + Q +"RTN","BMXMEVN",81,0) + ; +"RTN","BMXMEVN",82,0) +POLLD(BMXY) ;EP +"RTN","BMXMEVN",83,0) + ;Debug Entry Point +"RTN","BMXMEVN",84,0) + D DEBUG^%Serenji("POLL^BMXMEVN(.BMXY)") +"RTN","BMXMEVN",85,0) + Q +"RTN","BMXMEVN",86,0) + ; +"RTN","BMXMEVN",87,0) +POLL(BMXY) ;EP +"RTN","BMXMEVN",88,0) + ;Check event queue for events of interest to current session +"RTN","BMXMEVN",89,0) + ;Return DataSet of events and parameters +"RTN","BMXMEVN",90,0) + ;Called by BMX EVENT POLL +"RTN","BMXMEVN",91,0) + ; +"RTN","BMXMEVN",92,0) + N BMXI,BMXEVENT +"RTN","BMXMEVN",93,0) + S BMXI=0 +"RTN","BMXMEVN",94,0) + S X="POLLET^BMXMEVN",@^%ZOSF("TRAP") +"RTN","BMXMEVN",95,0) + S BMXY=$NA(^TMP("BMX",$J)) K @BMXY +"RTN","BMXMEVN",96,0) + S ^TMP("BMX",$J,0)="T00030EVENT"_U_"T00030PARAM"_$C(30) +"RTN","BMXMEVN",97,0) + L +^TMP("BMX EVENT RAISED"):1 G:'$T POLLEND +"RTN","BMXMEVN",98,0) + ; +"RTN","BMXMEVN",99,0) + G:'$D(^TMP("BMX EVENT RAISED",$J)) POLLEND +"RTN","BMXMEVN",100,0) + S BMXEVENT=0 F S BMXEVENT=$O(^TMP("BMX EVENT RAISED",$J,BMXEVENT)) Q:BMXEVENT']"" D +"RTN","BMXMEVN",101,0) + . N BMXINC +"RTN","BMXMEVN",102,0) + . S BMXINC=0 +"RTN","BMXMEVN",103,0) + . F S BMXINC=$O(^TMP("BMX EVENT RAISED",$J,BMXEVENT,BMXINC)) Q:'+BMXINC D +"RTN","BMXMEVN",104,0) + . . ;Set output array node +"RTN","BMXMEVN",105,0) + . . S BMXPARAM=$G(^TMP("BMX EVENT RAISED",$J,BMXEVENT,BMXINC)) +"RTN","BMXMEVN",106,0) + . . S BMXI=BMXI+1 +"RTN","BMXMEVN",107,0) + . . S ^TMP("BMX",$J,BMXI)=BMXEVENT_U_BMXPARAM_$C(30) +"RTN","BMXMEVN",108,0) + . . Q +"RTN","BMXMEVN",109,0) + . Q +"RTN","BMXMEVN",110,0) + ;S ^TMP("BMXTRACK",$P($H,",",2))="Job "_$J_" Killed "_$NA(^TMP("BMX EVENT RAISED",$J)) +"RTN","BMXMEVN",111,0) + K ^TMP("BMX EVENT RAISED",$J) +"RTN","BMXMEVN",112,0) + ; +"RTN","BMXMEVN",113,0) +POLLEND S BMXI=BMXI+1 +"RTN","BMXMEVN",114,0) + S ^TMP("BMX",$J,BMXI)=$C(31) +"RTN","BMXMEVN",115,0) + L -^TMP("BMX EVENT RAISED") +"RTN","BMXMEVN",116,0) + Q +"RTN","BMXMEVN",117,0) + ; +"RTN","BMXMEVN",118,0) +TTESTD(BMXY,BMXTIME) ;Debug entry point +"RTN","BMXMEVN",119,0) + ; +"RTN","BMXMEVN",120,0) + D DEBUG^%Serenji("TTEST^BMXMEVN(.BMXY,BMXTIME)") +"RTN","BMXMEVN",121,0) + Q +"RTN","BMXMEVN",122,0) + ; +"RTN","BMXMEVN",123,0) +TTEST(BMXY,BMXTIME) ;EP Timer Test +"RTN","BMXMEVN",124,0) + ; +"RTN","BMXMEVN",125,0) + S X="REGET^BMXMEVN",@^%ZOSF("TRAP") +"RTN","BMXMEVN",126,0) + S BMXY=$NA(^BMXTMP("BMX",$J)) K @BMXY +"RTN","BMXMEVN",127,0) + S ^BMXTMP("BMX",$J,0)="I00020HANGTIME"_$C(30) +"RTN","BMXMEVN",128,0) + I +BMXTIME H BMXTIME +"RTN","BMXMEVN",129,0) + ; +"RTN","BMXMEVN",130,0) + S BMXI=1 +"RTN","BMXMEVN",131,0) + S BMXI=BMXI+1 +"RTN","BMXMEVN",132,0) + S ^BMXTMP("BMX",$J,BMXI)=BMXTIME_$C(30)_$C(31) +"RTN","BMXMEVN",133,0) + ; +"RTN","BMXMEVN",134,0) + Q +"RTN","BMXMEVN",135,0) + ; +"RTN","BMXMEVN",136,0) +UNREGALL ;EP +"RTN","BMXMEVN",137,0) + ;Unregister all events for current session +"RTN","BMXMEVN",138,0) + ;Called on exit of each session +"RTN","BMXMEVN",139,0) + ; +"RTN","BMXMEVN",140,0) + N BMXEVENT +"RTN","BMXMEVN",141,0) + S BMXEVENT="" +"RTN","BMXMEVN",142,0) + K ^TMP("BMX EVENT",$J) +"RTN","BMXMEVN",143,0) + Q +"RTN","BMXMEVN",144,0) + ; +"RTN","BMXMEVN",145,0) +UNREG(BMXY,BMXEVENT) ;EP +"RTN","BMXMEVN",146,0) + ;RPC Called by client to Unregister client's interest in BMXEVENT +"RTN","BMXMEVN",147,0) + ;Returns RECORDSET with field ERRORID. +"RTN","BMXMEVN",148,0) + ;If everything ok then ERRORID = 0; +"RTN","BMXMEVN",149,0) + ; +"RTN","BMXMEVN",150,0) + N BMXI +"RTN","BMXMEVN",151,0) + S BMXI=0 +"RTN","BMXMEVN",152,0) + S X="REGET^BMXMEVN",@^%ZOSF("TRAP") +"RTN","BMXMEVN",153,0) + S BMXY=$NA(^TMP("BMX",$J)) K @BMXY +"RTN","BMXMEVN",154,0) + S ^TMP("BMX",$J,0)="I00020ERRORID"_$C(30) +"RTN","BMXMEVN",155,0) + K ^TMP("BMX EVENT",$J,BMXEVENT) +"RTN","BMXMEVN",156,0) + ; +"RTN","BMXMEVN",157,0) + S BMXI=BMXI+1 +"RTN","BMXMEVN",158,0) + S ^TMP("BMX",$J,BMXI)="0"_$C(30)_$C(31) +"RTN","BMXMEVN",159,0) + Q +"RTN","BMXMEVN",160,0) + ; +"RTN","BMXMEVN",161,0) +POLLET ;EP +"RTN","BMXMEVN",162,0) + ;Error trap from REGEVNT, RAISEVNT, ASYNCQUE and UNREG +"RTN","BMXMEVN",163,0) + ; +"RTN","BMXMEVN",164,0) + I '$D(BMXI) N BMXI S BMXI=999 +"RTN","BMXMEVN",165,0) + S BMXI=BMXI+1 +"RTN","BMXMEVN",166,0) + D POLLERR(BMXI,99) +"RTN","BMXMEVN",167,0) + Q +"RTN","BMXMEVN",168,0) + ; +"RTN","BMXMEVN",169,0) +POLLERR(BMXI,BMXERID) ;Error processing +"RTN","BMXMEVN",170,0) + S BMXI=BMXI+1 +"RTN","BMXMEVN",171,0) + S ^TMP("BMX",$J,BMXI)=BMXERID_U_$C(30) +"RTN","BMXMEVN",172,0) + S BMXI=BMXI+1 +"RTN","BMXMEVN",173,0) + S ^TMP("BMX",$J,BMXI)=$C(31) +"RTN","BMXMEVN",174,0) + Q +"RTN","BMXMEVN",175,0) + ; +"RTN","BMXMEVN",176,0) +ASYNCQUE(BMXY,BMXRPC,BMXEVN) ;EP +"RTN","BMXMEVN",177,0) + ;RPC Queues taskman to job wrapper ASYNCZTM +"RTN","BMXMEVN",178,0) + ; +"RTN","BMXMEVN",179,0) + ;RETURNS EVENT NAME, ZTSK in PARAM +"RTN","BMXMEVN",180,0) + S X="POLLET^BMXMEVN",@^%ZOSF("TRAP") +"RTN","BMXMEVN",181,0) + S BMXY=$NA(^TMP("BMX ASYNC QUEUE",$J)) K @BMXY +"RTN","BMXMEVN",182,0) + S ^TMP("BMX ASYNC QUEUE",$J,0)="I00030ERRORID"_U_"I00030PARAM"_$C(30) +"RTN","BMXMEVN",183,0) + ; +"RTN","BMXMEVN",184,0) + ;K ZTSK +"RTN","BMXMEVN",185,0) + N ZTSK,ZTRTN,ZTSAVE,ZTDESC,ZTIO,ZTDTH +"RTN","BMXMEVN",186,0) + ;S ZTRTN="ASYNCZTD^BMXMEVN" ;Debugging call +"RTN","BMXMEVN",187,0) + S ZTRTN="ASYNCZTM^BMXMEVN" +"RTN","BMXMEVN",188,0) + S BMXRPC=$TR(BMXRPC,"~",$C(30)) +"RTN","BMXMEVN",189,0) + S ZTSAVE("BMXRPC")="" +"RTN","BMXMEVN",190,0) + S ZTSAVE("BMXEVN")="" +"RTN","BMXMEVN",191,0) + S ZTDESC="BMX ASYNC JOB" +"RTN","BMXMEVN",192,0) + S ZTIO="",ZTDTH=DT +"RTN","BMXMEVN",193,0) + D ^%ZTLOAD +"RTN","BMXMEVN",194,0) + ;D @ZTRTN ;Debugging call +"RTN","BMXMEVN",195,0) + ; +"RTN","BMXMEVN",196,0) + S ^TMP("BMX ASYNC QUEUE",$J,1)=1_U_$G(ZTSK)_$C(30) +"RTN","BMXMEVN",197,0) + S ^TMP("BMX ASYNC QUEUE",$J,2)=$C(31) +"RTN","BMXMEVN",198,0) + Q +"RTN","BMXMEVN",199,0) + ; +"RTN","BMXMEVN",200,0) +ASYNCZTD ;EP Debug entry point +"RTN","BMXMEVN",201,0) + D DEBUG^%Serenji("ASYNCZTM^BMXMEVN") +"RTN","BMXMEVN",202,0) + Q +"RTN","BMXMEVN",203,0) + ; +"RTN","BMXMEVN",204,0) +ASYNCZTM ;EP +"RTN","BMXMEVN",205,0) + ;Called by Taskman with BMXRPC and BMXEVN defined to +"RTN","BMXMEVN",206,0) + ; 1) invoke the BMXRPC (RPC NAME^PARAM1^...^PARAMN) +"RTN","BMXMEVN",207,0) + ; 2) when done, raises event BMXEVN with ZTSK^$J in BMXPARAM +"RTN","BMXMEVN",208,0) + ; +"RTN","BMXMEVN",209,0) + N BMXRTN,BMXTAG,BMXRPCD,BMXCALL,BMXJ,BMXY,BMXNOD,BMXY +"RTN","BMXMEVN",210,0) + N BMXT S BMXT=$C(30) +"RTN","BMXMEVN",211,0) + I $E(BMXRPC,1,6)="SELECT" S BMXRPC="BMX SQL"_$C(30)_BMXRPC +"RTN","BMXMEVN",212,0) + S BMXRPCD=$O(^XWB(8994,"B",$P(BMXRPC,BMXT),0)) +"RTN","BMXMEVN",213,0) + S BMXNOD=^XWB(8994,BMXRPCD,0) +"RTN","BMXMEVN",214,0) + S BMXRTN=$P(BMXNOD,U,3) +"RTN","BMXMEVN",215,0) + S BMXTAG=$P(BMXNOD,U,2) +"RTN","BMXMEVN",216,0) + S BMXCALL="D "_BMXTAG_"^"_BMXRTN_"(.BMXY," +"RTN","BMXMEVN",217,0) + F BMXJ=2:1:$L(BMXRPC,BMXT) D +"RTN","BMXMEVN",218,0) + . S BMXCALL=BMXCALL_$C(34)_$P(BMXRPC,BMXT,BMXJ)_$C(34) +"RTN","BMXMEVN",219,0) + . S:BMXJ<$L(BMXRPC,BMXT) BMXCALL=BMXCALL_"," +"RTN","BMXMEVN",220,0) + . Q +"RTN","BMXMEVN",221,0) + S BMXCALL=BMXCALL_")" +"RTN","BMXMEVN",222,0) + X BMXCALL +"RTN","BMXMEVN",223,0) + D EVENT(BMXEVN,$G(ZTSK)_"~"_$P($G(BMXY),U,2),$J,"") +"RTN","BMXMEVN",224,0) + Q +"RTN","BMXMEVN",225,0) + ; +"RTN","BMXMEVN",226,0) + ; +"RTN","BMXMEVN",227,0) + ;Windows event handler: +"RTN","BMXMEVN",228,0) + ;Catches event with ZTSK^DataLocation parameter +"RTN","BMXMEVN",229,0) + ;Matches ZTSK to process that called event +"RTN","BMXMEVN",230,0) + ;Calls ASYNCGET rpc with DATALOCATION parameter +"RTN","BMXMEVN",231,0) + ; +"RTN","BMXMEVN",232,0) +ASYNCGET(BMXY,BMXDATA) ;EP +"RTN","BMXMEVN",233,0) + ;RPC Retrieves data queued by ASYNCZTM +"RTN","BMXMEVN",234,0) + ;by setting BMXY to BMXDATA +"RTN","BMXMEVN",235,0) + ; +"RTN","BMXMEVN",236,0) + S BMXY="^"_BMXDATA +"RTN","BMXMEVN",237,0) + Q +"RTN","BMXMEVN",238,0) + ; +"RTN","BMXMEVN",239,0) +ASYNCET ;EP +"RTN","BMXMEVN",240,0) + ;Error trap from ASYNCQUE +"RTN","BMXMEVN",241,0) + ; +"RTN","BMXMEVN",242,0) + I '$D(BMXI) N BMXI S BMXI=999 +"RTN","BMXMEVN",243,0) + S BMXI=BMXI+1 +"RTN","BMXMEVN",244,0) + D ASYNCERR(BMXI,0) +"RTN","BMXMEVN",245,0) + Q +"RTN","BMXMEVN",246,0) + ; +"RTN","BMXMEVN",247,0) +ASYNCERR(BMXI,BMXERID) ;Error processing +"RTN","BMXMEVN",248,0) + S BMXI=BMXI+1 +"RTN","BMXMEVN",249,0) + S ^TMP("BMX ASYNC QUEUE",$J,BMXI)=BMXERID_U_$C(30) +"RTN","BMXMEVN",250,0) + S BMXI=BMXI+1 +"RTN","BMXMEVN",251,0) + S ^TMP("BMX ASYNC QUEUE",$J,BMXI)=$C(31) +"RTN","BMXMEVN",252,0) + Q +"RTN","BMXMON") +0^58^B199224797 +"RTN","BMXMON",1,0) +BMXMON ; IHS/OIT/HMW,VW/SMH - BMXNet MONITOR ; 7/20/2009 ; 7/25/11 9:32am +"RTN","BMXMON",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXMON",3,0) + ; +"RTN","BMXMON",4,0) + ;IHS/OIT/HMW Patch 1 added validity check for passed-in namespace +"RTN","BMXMON",5,0) + ; 7/20/2009: Release of patch to support GT.M WV/SMH +"RTN","BMXMON",6,0) + ; Changes: +"RTN","BMXMON",7,0) + ; Addition of XINETD and GTMLNX entry points for support of GT.M +"RTN","BMXMON",8,0) + ; Changes of W *-3 (which only works on Cache) to W ! +"RTN","BMXMON",9,0) + ; 9/7/2010: Minor bug fixes and enhancements +"RTN","BMXMON",10,0) + ; In GTMLNX: Set process name +"RTN","BMXMON",11,0) + ; In GTMLNX: Time out based now on the Kernel Broker Timeout field +"RTN","BMXMON",12,0) + ; in kernel system parameters file +"RTN","BMXMON",13,0) + ; 12/12/2010: Minor bug fixes +"RTN","BMXMON",14,0) + ; ETRAP nows screens errors before logging them. If it is a network +"RTN","BMXMON",15,0) + ; write error, it's not logged to the Error Trap +"RTN","BMXMON",16,0) + ; Set Process Name crashed on Cache due to undefined IO("GT.M"). +"RTN","BMXMON",17,0) + ; Now this is surrounded by $Get to prevent this error. +"RTN","BMXMON",18,0) + ; 6/25/2011: Fix to error trapping introduced by last patch. +"RTN","BMXMON",19,0) + ; Having N $ETRAP before setting $ETRAP as the backup trap causes +"RTN","BMXMON",20,0) + ; an infinite loop because of the restoration of the old trap +"RTN","BMXMON",21,0) + ; which lead it there in the first place. Removing N $ETRAP. +"RTN","BMXMON",22,0) + ; +"RTN","BMXMON",23,0) +STRT(BMXPORT,NS,IS,VB) ;EP +"RTN","BMXMON",24,0) + ;Interactive monitor start +"RTN","BMXMON",25,0) + ;Optional NS = namespace. If undefined, start in current ns +"RTN","BMXMON",26,0) + ;Optional IS = Integrated Security. Default is 1 +"RTN","BMXMON",27,0) + ;Optional VB = Verbose. Default is 1 +"RTN","BMXMON",28,0) + ; +"RTN","BMXMON",29,0) + N Y,BMXNS,BMXWIN +"RTN","BMXMON",30,0) + ; +"RTN","BMXMON",31,0) + ;Verbose +"RTN","BMXMON",32,0) + S BMXVB=$G(VB,1) +"RTN","BMXMON",33,0) + ; +"RTN","BMXMON",34,0) + ;Check if port already running +"RTN","BMXMON",35,0) + I '$$SEMAPHOR(BMXPORT,"LOCK") W:BMXVB "BMXNet Monitor on port "_BMXPORT_" appears to be running already.",! Q +"RTN","BMXMON",36,0) + S %=$$SEMAPHOR(BMXPORT,"UNLOCK") +"RTN","BMXMON",37,0) + ; +"RTN","BMXMON",38,0) + D MARKER(BMXPORT,1) ;record problem marker +"RTN","BMXMON",39,0) + ; -- start the monitor +"RTN","BMXMON",40,0) + ; +"RTN","BMXMON",41,0) + ;Namespace +"RTN","BMXMON",42,0) + X ^%ZOSF("UCI") +"RTN","BMXMON",43,0) + S BMXNS=$G(NS,$P(Y,",")) +"RTN","BMXMON",44,0) + ; +"RTN","BMXMON",45,0) + ;Integrated security +"RTN","BMXMON",46,0) + S BMXWIN=$G(IS,1) +"RTN","BMXMON",47,0) + ; +"RTN","BMXMON",48,0) + ;J DEBUG^%Serenji("MON^BMXMON("_BMXPORT_","_BMXNS_","_BMXWIN_")") +"RTN","BMXMON",49,0) + J MON^BMXMON(BMXPORT,BMXNS,BMXWIN)::5 I '$T W:BMXVB "Unable to run BMXNet Monitor in background.",! Q ;IHS/OIT/HMW SAC Exemption Applied For +"RTN","BMXMON",50,0) + F %=1:1:5 D Q:%=0 +"RTN","BMXMON",51,0) + . W:BMXVB "Checking if BMXNet Monitor has started...",! +"RTN","BMXMON",52,0) + . H 1 +"RTN","BMXMON",53,0) + . S:'$$MARKER(BMXPORT,0) %=0 +"RTN","BMXMON",54,0) + I $$MARKER(BMXPORT,0) D +"RTN","BMXMON",55,0) + . W:BMXVB !,"BMXNet Monitor could not be started!",! +"RTN","BMXMON",56,0) + . W:BMXVB "Check if port "_BMXPORT_" is busy on this CPU.",! +"RTN","BMXMON",57,0) + . D MARKER(BMXPORT,-1) ;clear marker +"RTN","BMXMON",58,0) + E W:BMXVB "BMXNet Monitor started successfully." +"RTN","BMXMON",59,0) + ; +"RTN","BMXMON",60,0) + Q +"RTN","BMXMON",61,0) + ; +"RTN","BMXMON",62,0) +RESTART ;EP +"RTN","BMXMON",63,0) + ;Stop and Start all monitors in BMX MONITOR file +"RTN","BMXMON",64,0) + ;Called by option BMX MONITOR START +"RTN","BMXMON",65,0) + ; +"RTN","BMXMON",66,0) + D STOPALL +"RTN","BMXMON",67,0) + D STRTALL +"RTN","BMXMON",68,0) + Q +"RTN","BMXMON",69,0) + ; +"RTN","BMXMON",70,0) +STRTALL ;EP +"RTN","BMXMON",71,0) + ;Start all monitors in BMX MONITOR file +"RTN","BMXMON",72,0) + ; +"RTN","BMXMON",73,0) + N BMXIEN +"RTN","BMXMON",74,0) + S BMXIEN=0 F S BMXIEN=$O(^BMXMON(BMXIEN)) Q:'+BMXIEN D +"RTN","BMXMON",75,0) + . S BMXNOD=$G(^BMXMON(BMXIEN,0)) +"RTN","BMXMON",76,0) + . Q:'+BMXNOD +"RTN","BMXMON",77,0) + . Q:'+$P(BMXNOD,U,2) +"RTN","BMXMON",78,0) + . S BMXWIN=$P(BMXNOD,U,3) +"RTN","BMXMON",79,0) + . S BMXNS=$P(BMXNOD,U,4) +"RTN","BMXMON",80,0) + . D STRT($P(BMXNOD,U),BMXNS,BMXWIN,0) +"RTN","BMXMON",81,0) + . Q +"RTN","BMXMON",82,0) + Q +"RTN","BMXMON",83,0) + ; +"RTN","BMXMON",84,0) +STOPALL ;EP +"RTN","BMXMON",85,0) + ;Stop all monitors in BMXNET MONITOR file +"RTN","BMXMON",86,0) + ; +"RTN","BMXMON",87,0) + N BMXIEN,BMXPORT +"RTN","BMXMON",88,0) + S BMXIEN=0 F S BMXIEN=$O(^BMXMON(BMXIEN)) Q:'+BMXIEN D +"RTN","BMXMON",89,0) + . S BMXNOD=$G(^BMXMON(BMXIEN,0)) +"RTN","BMXMON",90,0) + . Q:'+BMXNOD +"RTN","BMXMON",91,0) + . S BMXPORT=+BMXNOD +"RTN","BMXMON",92,0) + . D STOP(BMXPORT,0) +"RTN","BMXMON",93,0) + Q +"RTN","BMXMON",94,0) + ; +"RTN","BMXMON",95,0) +STOP(BMXPORT,VB) ;EP Stop monitor on BMXPORT +"RTN","BMXMON",96,0) + ;Open a channel to monitor on BMXPORT and send shutdown request +"RTN","BMXMON",97,0) + ;Optional VB = Verbose. Default is 1 +"RTN","BMXMON",98,0) + ; +"RTN","BMXMON",99,0) + N IP,REF,X,DEV +"RTN","BMXMON",100,0) + S U="^" D HOME^%ZIS +"RTN","BMXMON",101,0) + ; +"RTN","BMXMON",102,0) + ;Verbose +"RTN","BMXMON",103,0) + S BMXVB=$G(VB,1) +"RTN","BMXMON",104,0) + ; +"RTN","BMXMON",105,0) + D:BMXVB EN^DDIOL("Stop BMXNet Monitor...") +"RTN","BMXMON",106,0) + X ^%ZOSF("UCI") S REF=Y +"RTN","BMXMON",107,0) + S IP="0.0.0.0" ;get server IP +"RTN","BMXMON",108,0) + IF $G(BMXPORT)="" S BMXPORT=9200 +"RTN","BMXMON",109,0) + ; -- make sure the listener is running +"RTN","BMXMON",110,0) + I $$SEMAPHOR(BMXPORT,"LOCK") D Q +"RTN","BMXMON",111,0) + . S %=$$SEMAPHOR(BMXPORT,"UNLOCK") +"RTN","BMXMON",112,0) + . D:BMXVB EN^DDIOL("BMXNet Monitor does not appear to be running.") +"RTN","BMXMON",113,0) + ; -- send the shutdown message to the TCP Listener process +"RTN","BMXMON",114,0) + D CALL^%ZISTCP("127.0.0.1",BMXPORT) I POP D Q +"RTN","BMXMON",115,0) + . S %=$$SEMAPHOR(BMXPORT,"UNLOCK") +"RTN","BMXMON",116,0) + . D:BMXVB EN^DDIOL("BMXNet Monitor does not appear to be running.") +"RTN","BMXMON",117,0) + U IO +"RTN","BMXMON",118,0) + S X=$T(+2),X=$P(X,";;",2),X=$P(X,";") +"RTN","BMXMON",119,0) + IF X="" S X=0 +"RTN","BMXMON",120,0) + S X=$C($L(X))_X +"RTN","BMXMON",121,0) + W "{BMX}00011TCPshutdown",! +"RTN","BMXMON",122,0) + R X#3:5 +"RTN","BMXMON",123,0) + D CLOSE^%ZISTCP +"RTN","BMXMON",124,0) + I X="ack" D:BMXVB EN^DDIOL("BMXNet Monitor has been shutdown.") +"RTN","BMXMON",125,0) + E D:BMXVB EN^DDIOL("Shutdown Failed!") +"RTN","BMXMON",126,0) + ;change process name +"RTN","BMXMON",127,0) + D CHPRN($J) +"RTN","BMXMON",128,0) + Q +"RTN","BMXMON",129,0) + ; +"RTN","BMXMON",130,0) +MON(BMXPORT,NS,IS) ;Monitor port for connection & shutdown requests +"RTN","BMXMON",131,0) + ;NS = Namespace to Start monitor +"RTN","BMXMON",132,0) + ;IS = 1: Enable integrated security +"RTN","BMXMON",133,0) + ; +"RTN","BMXMON",134,0) + N BMXDEV,BMXQUIT,BMXDTIME,BMXLEN,BMXACT,BMXWIN,BMXNS +"RTN","BMXMON",135,0) + S BMXQUIT=0,BMXDTIME=999999 +"RTN","BMXMON",136,0) + ; +"RTN","BMXMON",137,0) + ;Set lock +"RTN","BMXMON",138,0) + Q:'$$SEMAPHOR(BMXPORT,"LOCK") +"RTN","BMXMON",139,0) + ;Clear problem marker +"RTN","BMXMON",140,0) + D MARKER(BMXPORT,-1) +"RTN","BMXMON",141,0) + ;H 1 +"RTN","BMXMON",142,0) + ; +"RTN","BMXMON",143,0) + ;Namespace +"RTN","BMXMON",144,0) + X ^%ZOSF("UCI") +"RTN","BMXMON",145,0) + S BMXNS=$G(NS,$P(Y,",")) +"RTN","BMXMON",146,0) + ; +"RTN","BMXMON",147,0) + ;Integrated security +"RTN","BMXMON",148,0) + S BMXWIN=$G(IS,1) +"RTN","BMXMON",149,0) + ; +"RTN","BMXMON",150,0) + ;Open server port; +"RTN","BMXMON",151,0) + S BMXDEV="|TCP|"_BMXPORT +"RTN","BMXMON",152,0) + C BMXDEV ;IHS/OIT/HMW SAC Exemption Applied For +"RTN","BMXMON",153,0) + O BMXDEV:(:BMXPORT:"S"):5 I '$T Q ;IHS/OIT/HMW SAC Exemption Applied For +"RTN","BMXMON",154,0) + ; +"RTN","BMXMON",155,0) + ;S BMXDTIME(1)=BMXDTIME ; TODO: Set timeouts +"RTN","BMXMON",156,0) + S BMXDTIME(1)=.5 ;HMW 20050120 +"RTN","BMXMON",157,0) + U BMXDEV +"RTN","BMXMON",158,0) + F D Q:BMXQUIT +"RTN","BMXMON",159,0) + . R BMXACT#5:BMXDTIME ;Read first 5 chars from TCP buffer, timeout=BMXDTIME +"RTN","BMXMON",160,0) + . I BMXACT'="{BMX}" S BMXQUIT=1 Q +"RTN","BMXMON",161,0) + . R BMXACT#5:BMXDTIME ;Read next 5 chars - message length +"RTN","BMXMON",162,0) + . S BMXLEN=+BMXACT +"RTN","BMXMON",163,0) + . R BMXACT#BMXLEN:BMXDTIME +"RTN","BMXMON",164,0) + . I $P(BMXACT,"^")="TCPconnect" D Q +"RTN","BMXMON",165,0) + . . ;IHS/OIT/HMW added validity check for namespace +"RTN","BMXMON",166,0) + . . N BMXNSJ,X,Y +"RTN","BMXMON",167,0) + . . S BMXNSJ=$P(BMXACT,"^",2) ;Namespace +"RTN","BMXMON",168,0) + . . S BMXNSJ=$P(BMXNSJ,",") +"RTN","BMXMON",169,0) + . . ;if passed in namespace is invalid, new job will start in listener namespace +"RTN","BMXMON",170,0) + . . I BMXNSJ]"" S X=BMXNSJ X ^%ZOSF("UCICHECK") S:Y=0 BMXNSJ=BMXNS +"RTN","BMXMON",171,0) + . . ;Job another MONITOR using concurrent connection +"RTN","BMXMON",172,0) + . . ;J DEBUG^%Serenji("SESSION^BMXMON("_BMXWIN_")"):(:5:BMXDEV:BMXDEV):5 +"RTN","BMXMON",173,0) + . . ;J SESSION^BMXMON(BMXWIN)[$P(BMXNS,",")]:(:5:BMXDEV:BMXDEV):5 ;IHS/OIT/HMW SAC Exemption Applied For +"RTN","BMXMON",174,0) + . . J SESSION^BMXMON(BMXWIN)[BMXNSJ]:(:5:BMXDEV:BMXDEV):5 ;IHS/OIT/HMW SAC Exemption Applied For +"RTN","BMXMON",175,0) + . I $P(BMXACT,"^")="TCPshutdown" S BMXQUIT=1 W "ack",! +"RTN","BMXMON",176,0) + S %=$$SEMAPHOR(BMXPORT,"UNLOCK") ; destroy 'running flag' +"RTN","BMXMON",177,0) + Q +"RTN","BMXMON",178,0) + ; +"RTN","BMXMON",179,0) +XINETD ;PEP Directly from xinetd or inetd for GT.M +"RTN","BMXMON",180,0) + N BMXDEV +"RTN","BMXMON",181,0) + S U="^",$ETRAP="D ^%ZTER H" ;Set up the error trap +"RTN","BMXMON",182,0) + S $ZT="" ;Clear old trap +"RTN","BMXMON",183,0) + ; GT.M specific error and device code +"RTN","BMXMON",184,0) + S @("$ZINTERRUPT=""I $$JOBEXAM^ZU($ZPOSITION)""") +"RTN","BMXMON",185,0) + S BMXDEV=$P X "U BMXDEV:(nowrap:nodelimiter:ioerror=""TRAP"")" +"RTN","BMXMON",186,0) + S %="",@("%=$ZTRNLNM(""REMOTE_HOST"")") S:$L(%) IO("GTM-IP")=% +"RTN","BMXMON",187,0) + I %["::ffff:" S IO("GTM-IP")=$P(%,"::ffff:",2) ; IPv6 support +"RTN","BMXMON",188,0) + ; Read message type +"RTN","BMXMON",189,0) + N BMXACT,BMXDTIME +"RTN","BMXMON",190,0) + S BMXDTIME=10 ; change in 2.2 instead of 9999999 - initial conn timout +"RTN","BMXMON",191,0) + R BMXACT#5:BMXDTIME +"RTN","BMXMON",192,0) + Q:BMXACT'="{BMX}" ; Not a BMX message - quit. +"RTN","BMXMON",193,0) + ; Fall through to below... +"RTN","BMXMON",194,0) +GTMLNX ;EP from XWBTCPM for GT.M +"RTN","BMXMON",195,0) + ; not implementing NS and integrated authentication +"RTN","BMXMON",196,0) + ; Vars: Read timeout, msg len, msg, windows auth, Namespace +"RTN","BMXMON",197,0) + N BMXDTIME,BMXLEN,BMXACT,BMXWIN,BMXNS +"RTN","BMXMON",198,0) + S BMXNSJ="",BMXWIN=0 ; No NS on GT.M, no Windows Authentication +"RTN","BMXMON",199,0) + S BMXDTIME(1)=.5,BMXDTIME=180 ; sign on timeout like XWBTCPM +"RTN","BMXMON",200,0) + R BMXACT#5:BMXDTIME ;Read next 5 chars - message length +"RTN","BMXMON",201,0) + S BMXLEN=+BMXACT +"RTN","BMXMON",202,0) + R BMXACT#BMXLEN:BMXDTIME +"RTN","BMXMON",203,0) + I $P(BMXACT,"^")="TCPconnect" G SESSRES +"RTN","BMXMON",204,0) + I $P(BMXACT,"^")="TCPshutdown" W "ack",! Q +"RTN","BMXMON",205,0) + Q ; Should't hit this quit, but just in case +"RTN","BMXMON",206,0) + ; +"RTN","BMXMON",207,0) +SESSION(BMXWIN) ;EP +"RTN","BMXMON",208,0) + ;Start session monitor +"RTN","BMXMON",209,0) + ;BMXWIN = 1: Enable integrated security +"RTN","BMXMON",210,0) +SESSRES ;EP - reentry point from trap +"RTN","BMXMON",211,0) + ;IHS/OIT/HMW SAC Exemption Applied For +"RTN","BMXMON",212,0) + S BMXDTIME(1)=.5,BMXDTIME=$$BAT^XUPARAM ; new in 2.2: Use kernel rpc timeout instead of 9999999 +"RTN","BMXMON",213,0) + ; +"RTN","BMXMON",214,0) + ; Change Process Name (new in 2.2 and 2.3) +"RTN","BMXMON",215,0) + ; (GT.M doesn't store the IP in $P, but Cache does. We get GT.M +"RTN","BMXMON",216,0) + ; remote process IP from linux env var $REMOTE_HOST) +"RTN","BMXMON",217,0) + D:+$G(IO("GTM-IP")) CHPRN("BMX:ip"_$P(IO("GTM-IP"),".",3,4)) ; GT.M +"RTN","BMXMON",218,0) + D:+$P CHPRN("BMX:ip_"_$P($P,".",3,4)) ; Cache +"RTN","BMXMON",219,0) + ; +"RTN","BMXMON",220,0) + N $ESTACK S $ETRAP="D ETRAP^BMXMON" +"RTN","BMXMON",221,0) + S DIQUIET=1,U="^" D DT^DICRW +"RTN","BMXMON",222,0) + D UNREGALL^BMXMEVN ;Unregister all events for this session +"RTN","BMXMON",223,0) + U $P D SESSMAIN +"RTN","BMXMON",224,0) + ;Turn off the error trap for the exit +"RTN","BMXMON",225,0) + S $ETRAP="" +"RTN","BMXMON",226,0) + I $G(DUZ) D LOGOUT^XUSRB +"RTN","BMXMON",227,0) + K BMXR,BMXARY +"RTN","BMXMON",228,0) + C $P ;IHS/OIT/HMW SAC Exemption Applied For +"RTN","BMXMON",229,0) + Q +"RTN","BMXMON",230,0) + ; +"RTN","BMXMON",231,0) +SESSMAIN ; +"RTN","BMXMON",232,0) + N BMXTBUF +"RTN","BMXMON",233,0) + D SETUP^BMXMSEC(.RET) ;Setup required system vars +"RTN","BMXMON",234,0) + S U="^" +"RTN","BMXMON",235,0) + U $P +"RTN","BMXMON",236,0) + F D Q:BMXTBUF="#BYE#" +"RTN","BMXMON",237,0) + . R BMXTBUF#11:BMXDTIME IF '$T D TIMEOUT S BMXTBUF="#BYE#" Q +"RTN","BMXMON",238,0) + . I BMXTBUF["XQKEY" S HWMP=1 +"RTN","BMXMON",239,0) + . I BMXTBUF="#BYE#" Q +"RTN","BMXMON",240,0) + . S BMXHTYPE=$S($E(BMXTBUF,1,5)="{BMX}":1,1:0) ;check HDR +"RTN","BMXMON",241,0) + . I 'BMXHTYPE S BMXTBUF="#BYE#" D SNDERR W BMXTBUF,$C(4),! Q +"RTN","BMXMON",242,0) + . S BMXTLEN=$E(BMXTBUF,6,10),L=$E(BMXTBUF,11,11) +"RTN","BMXMON",243,0) + . R BMXTBUF#4:BMXDTIME(1) S BMXTBUF=L_BMXTBUF +"RTN","BMXMON",244,0) + . S BMXPLEN=BMXTBUF +"RTN","BMXMON",245,0) + . R BMXTBUF#BMXPLEN:BMXDTIME(1) +"RTN","BMXMON",246,0) + . I $P(BMXTBUF,U)="TCPconnect" D Q +"RTN","BMXMON",247,0) + . . D SNDERR W "accept",$C(4),! ;Ack +"RTN","BMXMON",248,0) + . IF BMXHTYPE D +"RTN","BMXMON",249,0) + . . K BMXR,BMXARY +"RTN","BMXMON",250,0) + . . IF BMXTBUF="#BYE#" D SNDERR W "#BYE#",$C(4),! Q +"RTN","BMXMON",251,0) + . . S BMXTLEN=BMXTLEN-15 +"RTN","BMXMON",252,0) + . . D CALLP^BMXMBRK(.BMXR,BMXTBUF) +"RTN","BMXMON",253,0) + . . S BMXPTYPE=$S('$D(BMXPTYPE):1,BMXPTYPE<1:1,BMXPTYPE>6:1,1:BMXPTYPE) +"RTN","BMXMON",254,0) + . IF BMXTBUF="#BYE#" Q +"RTN","BMXMON",255,0) + . U $P +"RTN","BMXMON",256,0) + . D SNDERR ;Clears SNDERR parameters +"RTN","BMXMON",257,0) + . D SND +"RTN","BMXMON",258,0) + . D WRITE($C(4)) W ! ;send eot and flush buffer +"RTN","BMXMON",259,0) + D UNREGALL^BMXMEVN ;Unregister all events for this session +"RTN","BMXMON",260,0) + Q ;End Of Main +"RTN","BMXMON",261,0) + ; +"RTN","BMXMON",262,0) +SNDERR ;send error information +"RTN","BMXMON",263,0) + ;BMXSEC is the security packet, BMXERROR is application packet +"RTN","BMXMON",264,0) + N X +"RTN","BMXMON",265,0) + S X=$E($G(BMXSEC),1,255) +"RTN","BMXMON",266,0) + W $C($L(X))_X W ! +"RTN","BMXMON",267,0) + S X=$E($G(BMXERROR),1,255) +"RTN","BMXMON",268,0) + W $C($L(X))_X W ! +"RTN","BMXMON",269,0) + S BMXERROR="",BMXSEC="" ;clears parameters +"RTN","BMXMON",270,0) + Q +"RTN","BMXMON",271,0) + ; +"RTN","BMXMON",272,0) +WRITE(BMXSTR) ;Write a data string +"RTN","BMXMON",273,0) + ; +"RTN","BMXMON",274,0) + I $L(BMXSTR)<511 W ! W BMXSTR Q +"RTN","BMXMON",275,0) + ;Handle a long string +"RTN","BMXMON",276,0) + W ! ;Flush the buffer +"RTN","BMXMON",277,0) + F Q:'$L(BMXSTR) W $E(BMXSTR,1,510),! S BMXSTR=$E(BMXSTR,511,99999) +"RTN","BMXMON",278,0) + Q +"RTN","BMXMON",279,0) +SND ; -- send data for all, Let WRITE sort it out +"RTN","BMXMON",280,0) + N I,T +"RTN","BMXMON",281,0) + ; +"RTN","BMXMON",282,0) + ; -- error or abort occurred, send null +"RTN","BMXMON",283,0) + IF $L(BMXSEC)>0 D WRITE("") Q +"RTN","BMXMON",284,0) + ; -- single value +"RTN","BMXMON",285,0) + IF BMXPTYPE=1 S BMXR=$G(BMXR) D WRITE(BMXR) Q +"RTN","BMXMON",286,0) + ; -- table delimited by CR+LF +"RTN","BMXMON",287,0) + IF BMXPTYPE=2 D Q +"RTN","BMXMON",288,0) + . S I="" F S I=$O(BMXR(I)) Q:I="" D WRITE(BMXR(I)),WRITE($C(13,10)) +"RTN","BMXMON",289,0) + ; -- word processing +"RTN","BMXMON",290,0) + IF BMXPTYPE=3 D Q +"RTN","BMXMON",291,0) + . S I="" F S I=$O(BMXR(I)) Q:I="" D WRITE(BMXR(I)) D:BMXWRAP WRITE($C(13,10)) +"RTN","BMXMON",292,0) + ; -- global array +"RTN","BMXMON",293,0) + IF BMXPTYPE=4 D Q +"RTN","BMXMON",294,0) + . S I=$G(BMXR) Q:I="" S T=$E(I,1,$L(I)-1) D:$D(@I)>10 WRITE(@I) +"RTN","BMXMON",295,0) + . F S I=$Q(@I) Q:I=""!(I'[T) W ! W @I W:BMXWRAP&(@I'=$C(13,10)) $C(13,10) +"RTN","BMXMON",296,0) + . IF $D(@BMXR) K @BMXR +"RTN","BMXMON",297,0) + ; -- global instance +"RTN","BMXMON",298,0) + IF BMXPTYPE=5 S BMXR=$G(@BMXR) D WRITE(BMXR) Q +"RTN","BMXMON",299,0) + ; -- variable length records only good upto 255 char) +"RTN","BMXMON",300,0) + IF BMXPTYPE=6 S I="" F S I=$O(BMXR(I)) Q:I="" D WRITE($C($L(BMXR(I)))),WRITE(BMXR(I)) +"RTN","BMXMON",301,0) + Q +"RTN","BMXMON",302,0) + ; +"RTN","BMXMON",303,0) +TIMEOUT ;Do this on MAIN loop timeout +"RTN","BMXMON",304,0) + I $G(DUZ)>0 D SNDERR,WRITE("#BYE#"_$C(4)) Q +"RTN","BMXMON",305,0) + ;Sign-on timeout +"RTN","BMXMON",306,0) + S BMXR(0)=0,BMXR(1)=1,BMXR(2)="",BMXR(3)="TIME-OUT",BMXPTYPE=2 +"RTN","BMXMON",307,0) + D SNDERR,SND,WRITE($C(4)) +"RTN","BMXMON",308,0) + Q +"RTN","BMXMON",309,0) + ; +"RTN","BMXMON",310,0) +SEMAPHOR(BMXTSKT,BMXACT) ;Lock/Unlock BMXMON semaphore +"RTN","BMXMON",311,0) + N RESULT +"RTN","BMXMON",312,0) + S U="^",RESULT=1 +"RTN","BMXMON",313,0) + D GETENV^%ZOSV ;get Y=UCI^VOL^NODE^BOXLOOKUP of current system +"RTN","BMXMON",314,0) + I BMXACT="LOCK" D +"RTN","BMXMON",315,0) + . L +^BMXMON("BMXMON",$P(Y,U,2),$P(Y,U),$P(Y,U,4),BMXTSKT):1 +"RTN","BMXMON",316,0) + . S RESULT=$T +"RTN","BMXMON",317,0) + E L -^BMXMON("BMXMON",$P(Y,U,2),$P(Y,U),$P(Y,U,4),BMXTSKT) +"RTN","BMXMON",318,0) + Q RESULT +"RTN","BMXMON",319,0) + ; +"RTN","BMXMON",320,0) +CHPRN(N) ;Change process name to N. +"RTN","BMXMON",321,0) + D SETNM^%ZOSV($E(N,1,15)) +"RTN","BMXMON",322,0) + Q +"RTN","BMXMON",323,0) + ; +"RTN","BMXMON",324,0) +MARKER(BMXPORT,BMXMODE) ;Set/Test/Clear Problem Marker, BMXMODE=0 is a function +"RTN","BMXMON",325,0) + N IP,Y,%,REF X ^%ZOSF("UCI") S REF=Y,IP="0.0.0.0",%=0 +"RTN","BMXMON",326,0) + L +^BMX(IP,REF,BMXPORT,"PROBLEM MARKER"):1 +"RTN","BMXMON",327,0) + I BMXMODE=1 S ^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")=1 +"RTN","BMXMON",328,0) + I BMXMODE=0 S:$D(^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")) %=1 +"RTN","BMXMON",329,0) + I BMXMODE=-1 K ^BMX(IP,REF,BMXPORT,"PROBLEM MARKER") +"RTN","BMXMON",330,0) + L -^BMX(IP,REF,BMXPORT,"PROBLEM MARKER") +"RTN","BMXMON",331,0) + Q:BMXMODE=0 % Q +"RTN","BMXMON",332,0) + ; +"RTN","BMXMON",333,0) +ETRAP ; -- on trapped error, send error info to client +"RTN","BMXMON",334,0) + ; Error Trap Vars: Code, Error, Last Global Reference +"RTN","BMXMON",335,0) + N BMXERC,BMXERR,BMXLGR +"RTN","BMXMON",336,0) + ; +"RTN","BMXMON",337,0) + ; Change trapping during trap. +"RTN","BMXMON",338,0) + ; V:2.31: Removed N $ETRAP as it caused an infinite loop +"RTN","BMXMON",339,0) + ; when combined with the penultimate line of this trap. +"RTN","BMXMON",340,0) + ; N $ETRAP causes it to revert back to the old trap which +"RTN","BMXMON",341,0) + ; is this EP when a quit happens to pop the $STACK. +"RTN","BMXMON",342,0) + ; +"RTN","BMXMON",343,0) + S $ETRAP="D ^%ZTER HALT" +"RTN","BMXMON",344,0) + ; +"RTN","BMXMON",345,0) + ; If the error is simply that we can't write to the TCP device +"RTN","BMXMON",346,0) + ; clear and log out +"RTN","BMXMON",347,0) + ; GT.M Error Code. +"RTN","BMXMON",348,0) + I $ECODE=",Z150376602," S $ECODE="" D:$G(DUZ) LOGOUT^XUSRB HALT +"RTN","BMXMON",349,0) + ; Cache Error Codes: +"RTN","BMXMON",350,0) + I ($EC["READ")!($EC["WRITE")!($EC["SYSTEM-F") S $ECODE="" D:$G(DUZ) LOGOUT^XUSRB HALT +"RTN","BMXMON",351,0) + ; +"RTN","BMXMON",352,0) + ; Otherwise, log the error and send it to the client +"RTN","BMXMON",353,0) + S BMXERC=$$EC^%ZOSV +"RTN","BMXMON",354,0) + S BMXERR="M ERROR="_BMXERC_$C(13,10)_"LAST REF=" +"RTN","BMXMON",355,0) + S BMXLGR=$$LGR^%ZOSV_$C(4) +"RTN","BMXMON",356,0) + S BMXERR=BMXERR_BMXLGR +"RTN","BMXMON",357,0) + ; +"RTN","BMXMON",358,0) + D ^%ZTER ;%ZTER clears $ZE and $ECODE +"RTN","BMXMON",359,0) + ; +"RTN","BMXMON",360,0) + U $P +"RTN","BMXMON",361,0) + ; +"RTN","BMXMON",362,0) + D SNDERR,WRITE(BMXERR) W ! +"RTN","BMXMON",363,0) + ; +"RTN","BMXMON",364,0) + S $ETRAP="Q:($ESTACK&'$QUIT) Q:$ESTACK -9 S $ECODE="""" G SESSRES^BMXMON",$ECODE=",U99," +"RTN","BMXMON",365,0) + QUIT +"RTN","BMXMON",366,0) + ; +"RTN","BMXMON",367,0) +MENU ;EP - ENTRY ACTION FROM BMXMENU OPTION +"RTN","BMXMON",368,0) + ; +"RTN","BMXMON",369,0) + N BMX,BMXVER +"RTN","BMXMON",370,0) + ;VERSION +"RTN","BMXMON",371,0) + D +"RTN","BMXMON",372,0) + . S BMXN="BMXNET ADO.NET DATA PROVIDER" I $D(^DIC(9.4,"B",BMXN)) Q +"RTN","BMXMON",373,0) + . S BMXN="BMXNET RPMS .NET UTILITIES" I $D(^DIC(9.4,"B",BMXN)) Q +"RTN","BMXMON",374,0) + . S BMXN="" +"RTN","BMXMON",375,0) + . Q +"RTN","BMXMON",376,0) + ; +"RTN","BMXMON",377,0) + S BMXVER="" +"RTN","BMXMON",378,0) + I BMXN]"",$D(^DIC(9.4,"B",BMXN)) D +"RTN","BMXMON",379,0) + . S BMX=$O(^DIC(9.4,"B",BMXN,0)) +"RTN","BMXMON",380,0) + . I $D(^DIC(9.4,BMX,"VERSION")) S BMXVER=$P(^DIC(9.4,BMX,"VERSION"),"^") +"RTN","BMXMON",381,0) + . E S BMXVER="VERSION NOT FOUND" +"RTN","BMXMON",382,0) + S:BMXVER="" BMXVER="VERSION NOT FOUND" +"RTN","BMXMON",383,0) + ; +"RTN","BMXMON",384,0) + ;LOCATION +"RTN","BMXMON",385,0) + N BMXLOC +"RTN","BMXMON",386,0) + S BMXLOC="" +"RTN","BMXMON",387,0) + I $G(DUZ(2)),$D(^DIC(4,DUZ(2),0)) S BMXLOC=$P(^DIC(4,DUZ(2),0),"^") +"RTN","BMXMON",388,0) + S:BMXLOC="" BMXLOC="LOCATION NOT FOUND" +"RTN","BMXMON",389,0) + ; +"RTN","BMXMON",390,0) + ;WRITE +"RTN","BMXMON",391,0) + W ! +"RTN","BMXMON",392,0) + W !,"BMXNet Version: ",BMXVER +"RTN","BMXMON",393,0) + W !,"Location: ",BMXLOC +"RTN","BMXMON",394,0) + Q +"RTN","BMXMSEC") +0^85^B8709977 +"RTN","BMXMSEC",1,0) +BMXMSEC ; IHS/OIT/HMW - BMXNet MONITOR ; 7/20/2009 +"RTN","BMXMSEC",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXMSEC",3,0) + ; Edit History +"RTN","BMXMSEC",4,0) + ; Line SETUP+2 has been changed to support GT.M //SMH 7/5/09 +"RTN","BMXMSEC",5,0) + ; Per Wally Fort's GT.M code in XWBTCPM, IP for GT.M is stored +"RTN","BMXMSEC",6,0) + ; in IP("GTM-IP"). Changes in BMXMON and here follow that model. +"RTN","BMXMSEC",7,0) + ; +"RTN","BMXMSEC",8,0) +CHKPRMIT(BMXRP) ;EP - checks to see if remote procedure is permited to run +"RTN","BMXMSEC",9,0) + ;Input: BMXRP - Remote procedure to check +"RTN","BMXMSEC",10,0) + Q:$$KCHK("XUPROGMODE") +"RTN","BMXMSEC",11,0) + N ERR,BMXALLOW +"RTN","BMXMSEC",12,0) + S U="^",BMXSEC="" ;clear +"RTN","BMXMSEC",13,0) + ; +"RTN","BMXMSEC",14,0) + ;In the beginning, when no DUZ is defined and no context exist, setup +"RTN","BMXMSEC",15,0) + ;default signon context +"RTN","BMXMSEC",16,0) + S:'$G(DUZ) DUZ=0,XQY0="XUS SIGNON" ;set up default context +"RTN","BMXMSEC",17,0) + ; +"RTN","BMXMSEC",18,0) + I BMXRP'="XWB IM HERE",BMXRP'="XWB CREATE CONTEXT",BMXRP'="XWB RPC LIST",BMXRP'="BMX AV CODE" D ;check exemptions. new exemption for XWB*1.1*6 - dpc +"RTN","BMXMSEC",19,0) + . I $G(XQY0)'="" D +"RTN","BMXMSEC",20,0) + . . S BMXALLOW=$$CHK^XQCS(DUZ,$P(XQY0,U),BMXRP) ;do the check +"RTN","BMXMSEC",21,0) + . . S:'BMXALLOW BMXSEC=BMXALLOW +"RTN","BMXMSEC",22,0) + . E S BMXSEC="Application context has not been created!" +"RTN","BMXMSEC",23,0) + Q +"RTN","BMXMSEC",24,0) + ; +"RTN","BMXMSEC",25,0) +OWNSKEY(RET,LIST) ;EP Does user have Key +"RTN","BMXMSEC",26,0) + N I,K S I="" +"RTN","BMXMSEC",27,0) + I $G(DUZ)'>0 S RET(0)=0 Q +"RTN","BMXMSEC",28,0) + I $O(LIST(""))="" S RET(0)=$$KCHK(LIST) Q +"RTN","BMXMSEC",29,0) + F S I=$O(LIST(I)) Q:I="" S RET(I)=$$KCHK(LIST(I)) +"RTN","BMXMSEC",30,0) + Q +"RTN","BMXMSEC",31,0) +KCHK(%) Q $S($G(DUZ)>0:$D(^XUSEC(%,DUZ)),1:0) ;EP Key Check +"RTN","BMXMSEC",32,0) + ; +"RTN","BMXMSEC",33,0) + ; +"RTN","BMXMSEC",34,0) +SETUP(RET) ;EP - sets up environment for GUI signon +"RTN","BMXMSEC",35,0) + ; +"RTN","BMXMSEC",36,0) + K ^TMP("XQCS",$J) +"RTN","BMXMSEC",37,0) + ; S IO("IP")=$P D ZIO^%ZIS4 ;IHS/OIT/HMW SAC Exemption Applied For +"RTN","BMXMSEC",38,0) + ; --> Begin new code +"RTN","BMXMSEC",39,0) + I $$OS^XWBTCPM="GT.M" S IO("IP")=IO("GTM-IP") +"RTN","BMXMSEC",40,0) + I $$OS^XWBTCPM="OpenM" S IO("IP")=$P +"RTN","BMXMSEC",41,0) + D ZIO^%ZIS4 +"RTN","BMXMSEC",42,0) + ; <-- End new code //SMH +"RTN","BMXMSEC",43,0) + D SET1(0),SET^BMXMSEC("XUS XOPT",XOPT),SET^BMXMSEC("XUS CNT",0) +"RTN","BMXMSEC",44,0) + S %ZIS="0H",IOP="NULL" D ^%ZIS +"RTN","BMXMSEC",45,0) + ;0=server name, 1=volume, 2=uci, 3=device, 4=# attempts, 5=skip signon-screen +"RTN","BMXMSEC",46,0) + S RET(0)=$P(XUENV,U,3),RET(1)=$P(XUVOL,U),RET(2)=XUCI +"RTN","BMXMSEC",47,0) + S RET(3)=$I,RET(4)=$P(XOPT,U,2),RET(5)=0 ;IHS/OIT/HMW SAC Exemption Applied For +"RTN","BMXMSEC",48,0) + I $$INHIBIT() Q +"RTN","BMXMSEC",49,0) + Q +"RTN","BMXMSEC",50,0) + ; +"RTN","BMXMSEC",51,0) +SET1(FLAG) ;Setup parameters +"RTN","BMXMSEC",52,0) + D GETENV^%ZOSV S U="^",XUENV=Y,XUCI=$P(Y,U,1),XQVOL=$P(Y,U,2),XUEON=^%ZOSF("EON"),XUEOFF=^("EOFF") +"RTN","BMXMSEC",53,0) + S X=$O(^XTV(8989.3,1,4,"B",XQVOL,0)),XUVOL=$S(X>0:^XTV(8989.3,1,4,X,0),1:XQVOL_"^y^1") S:$P(XUVOL,U,6)="y" XRTL=XUCI_","_XQVOL +"RTN","BMXMSEC",54,0) + S XOPT=$S($D(^XTV(8989.3,1,"XUS")):^("XUS"),1:"") F I=2:1:15 I $P(XOPT,U,I)="" S $P(XOPT,U,I)=$P("^5^900^1^1^^^^1^300^^^^N^90",U,I) +"RTN","BMXMSEC",55,0) + Q +"RTN","BMXMSEC",56,0) + ; +"RTN","BMXMSEC",57,0) +INHIBIT() ;Is Logon to this system Inhibited? +"RTN","BMXMSEC",58,0) + I $G(^%ZIS(14.5,"LOGON",XQVOL)) Q 1 +"RTN","BMXMSEC",59,0) + I $D(^%ZOSF("ACTJ")) X ^("ACTJ") I $P(XUVOL,U,3),($P(XUVOL,U,3)'>Y) Q 2 +"RTN","BMXMSEC",60,0) + Q 0 +"RTN","BMXMSEC",61,0) + ; +"RTN","BMXMSEC",62,0) +NOW S U="^",XUNOW=$$NOW^XLFDT(),DT=$P(XUNOW,"."),XUDEV=0 +"RTN","BMXMSEC",63,0) + Q +"RTN","BMXMSEC",64,0) + ; +"RTN","BMXMSEC",65,0) +STATE(%) ;Return a state value +"RTN","BMXMSEC",66,0) + ;XWBSTATE is required by XUSRB +"RTN","BMXMSEC",67,0) + Q:'$L($G(%)) $G(XWBSTATE) +"RTN","BMXMSEC",68,0) + Q $G(XWBSTATE(%)) +"RTN","BMXMSEC",69,0) + ; +"RTN","BMXMSEC",70,0) + ; +"RTN","BMXMSEC",71,0) +SET(%,VALUE) ;Set the state variable +"RTN","BMXMSEC",72,0) + I $G(%)="" S XWBSTATE=VALUE +"RTN","BMXMSEC",73,0) + S XWBSTATE(%)=VALUE +"RTN","BMXMSEC",74,0) + Q +"RTN","BMXMSEC",75,0) +KILL(%) ;Kill state variable +"RTN","BMXMSEC",76,0) + I $L($G(%)) K XWBSTATE(%) +"RTN","BMXMSEC",77,0) + Q +"RTN","BMXNTEG") +0^115^B7300059 +"RTN","BMXNTEG",1,0) +BMXNTEG ;INTEGRITY CHECKER;FEB 26, 2007 +"RTN","BMXNTEG",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXNTEG",3,0) + ; +"RTN","BMXNTEG",4,0) +START ; +"RTN","BMXNTEG",5,0) + NEW BYTE,COUNT,RTN +"RTN","BMXNTEG",6,0) + K ^UTILITY($J) +"RTN","BMXNTEG",7,0) + F I=1:1 S X=$T(LIST+I) Q:X="" S X=$P(X,";;",2),R=$P(X,"^",1),B=$P(X,"^",2),C=$P(X,"^",3),^UTILITY($J,R)=B_"^"_C +"RTN","BMXNTEG",8,0) + F I=1:1:6 S X=$P($T(@("LINE"_I)),";;",2,99),@("XBSUMBLD("_I_")=X") +"RTN","BMXNTEG",9,0) + X XBSUMBLD(1) +"RTN","BMXNTEG",10,0) + Q +"RTN","BMXNTEG",11,0) + ; +"RTN","BMXNTEG",12,0) +LINE1 ;;X XBSUMBLD(2),XBSUMBLD(6) +"RTN","BMXNTEG",13,0) +LINE2 ;;S RTN=0 F S RTN=$O(^UTILITY($J,RTN)) Q:RTN="" W !,RTN ZL @RTN S (BYTE,COUNT)=0 S X=$T(+1),X=$P(X," [ ",1) X XBSUMBLD(4),XBSUMBLD(3),XBSUMBLD(5) +"RTN","BMXNTEG",14,0) +LINE3 ;;F I=2:1 S X=$T(+I) Q:X="" X XBSUMBLD(4) +"RTN","BMXNTEG",15,0) +LINE4 ;;F J=1:1 S Y=$E(X,J) Q:Y="" S BYTE=BYTE+1,COUNT=COUNT+$A(Y) +"RTN","BMXNTEG",16,0) +LINE5 ;;S B=$P(^UTILITY($J,RTN),"^",1),C=$P(^(RTN),"^",2) I B'=BYTE!(C'=COUNT) W " has been modified" +"RTN","BMXNTEG",17,0) +LINE6 ;;K XBSUMBLD,B,C,I,J,R,X,Y +"RTN","BMXNTEG",18,0) + ; +"RTN","BMXNTEG",19,0) +LIST ; +"RTN","BMXNTEG",20,0) + ;;BMXADE1^3028^202865 +"RTN","BMXNTEG",21,0) + ;;BMXADE2^3250^215372 +"RTN","BMXNTEG",22,0) + ;;BMXADO^6547^418026 +"RTN","BMXNTEG",23,0) + ;;BMXADO2^3489^255546 +"RTN","BMXNTEG",24,0) + ;;BMXADOF^11562^731974 +"RTN","BMXNTEG",25,0) + ;;BMXADOF1^3281^207224 +"RTN","BMXNTEG",26,0) + ;;BMXADOF2^2138^139496 +"RTN","BMXNTEG",27,0) + ;;BMXADOFD^2831^178610 +"RTN","BMXNTEG",28,0) + ;;BMXADOFS^6515^393782 +"RTN","BMXNTEG",29,0) + ;;BMXADOI^2215^134605 +"RTN","BMXNTEG",30,0) + ;;BMXADOS^9145^575000 +"RTN","BMXNTEG",31,0) + ;;BMXADOS1^2590^161592 +"RTN","BMXNTEG",32,0) + ;;BMXADOV^5739^373823 +"RTN","BMXNTEG",33,0) + ;;BMXADOV1^9072^554887 +"RTN","BMXNTEG",34,0) + ;;BMXADOV2^4690^289898 +"RTN","BMXNTEG",35,0) + ;;BMXADOVJ^3530^225534 +"RTN","BMXNTEG",36,0) + ;;BMXADOX^13904^870277 +"RTN","BMXNTEG",37,0) + ;;BMXADOX1^11753^751110 +"RTN","BMXNTEG",38,0) + ;;BMXADOX2^3126^199406 +"RTN","BMXNTEG",39,0) + ;;BMXADOXX^12226^762799 +"RTN","BMXNTEG",40,0) + ;;BMXADOXY^11992^769511 +"RTN","BMXNTEG",41,0) + ;;BMXE01^2111^148783 +"RTN","BMXNTEG",42,0) + ;;BMXFIND^7919^562996 +"RTN","BMXNTEG",43,0) + ;;BMXG^1970^120467 +"RTN","BMXNTEG",44,0) + ;;BMXGETS^4309^308726 +"RTN","BMXNTEG",45,0) + ;;BMXMBRK^5919^389568 +"RTN","BMXNTEG",46,0) + ;;BMXMBRK2^3621^233089 +"RTN","BMXNTEG",47,0) + ;;BMXMEVN^6627^468908 +"RTN","BMXNTEG",48,0) + ;;BMXMON^9356^664477 +"RTN","BMXNTEG",49,0) + ;;BMXMSEC^2302^160584 +"RTN","BMXNTEG",50,0) + ;;BMXNTEG^2045^127438 +"RTN","BMXNTEG",51,0) + ;;BMXPO^1522^101987 +"RTN","BMXNTEG",52,0) + ;;BMXPRS^2153^134429 +"RTN","BMXNTEG",53,0) + ;;BMXRPC^5716^425699 +"RTN","BMXNTEG",54,0) + ;;BMXRPC1^7622^559198 +"RTN","BMXNTEG",55,0) + ;;BMXRPC2^3531^243875 +"RTN","BMXNTEG",56,0) + ;;BMXRPC3^6466^450166 +"RTN","BMXNTEG",57,0) + ;;BMXRPC4^4967^312485 +"RTN","BMXNTEG",58,0) + ;;BMXRPC5^3896^288926 +"RTN","BMXNTEG",59,0) + ;;BMXRPC6^3757^270667 +"RTN","BMXNTEG",60,0) + ;;BMXRPC7^5687^404431 +"RTN","BMXNTEG",61,0) + ;;BMXRPC8^2236^165523 +"RTN","BMXNTEG",62,0) + ;;BMXRPC9^6408^421855 +"RTN","BMXNTEG",63,0) + ;;BMXSQL^10869^727499 +"RTN","BMXNTEG",64,0) + ;;BMXSQL1^9921^616204 +"RTN","BMXNTEG",65,0) + ;;BMXSQL2^2748^183754 +"RTN","BMXNTEG",66,0) + ;;BMXSQL3^13516^868578 +"RTN","BMXNTEG",67,0) + ;;BMXSQL4^1313^88477 +"RTN","BMXNTEG",68,0) + ;;BMXSQL5^6648^433290 +"RTN","BMXNTEG",69,0) + ;;BMXSQL6^10606^683062 +"RTN","BMXNTEG",70,0) + ;;BMXSQL7^8102^528283 +"RTN","BMXNTEG",71,0) + ;;BMXSQL91^4328^281351 +"RTN","BMXNTEG",72,0) + ;;BMXTABLE^159^9961 +"RTN","BMXNTEG",73,0) + ;;BMXTRS^1300^81264 +"RTN","BMXNTEG",74,0) + ;;BMXUTL1^7818^520369 +"RTN","BMXNTEG",75,0) + ;;BMXUTL2^900^60457 +"RTN","BMXNTEG",76,0) + ;;BMXUTL5^5330^358866 +"RTN","BMXNTEG",77,0) + ;;BMXUTL6^942^62126 +"RTN","BMXNTEG",78,0) + ;;BMXUTL7^163^10646 +"RTN","BMXPO") +0^116^B4666839 +"RTN","BMXPO",1,0) +BMXPO ; IHS/CMI/MAW - Populate appcontext with all namespaced RPC's ; +"RTN","BMXPO",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXPO",3,0) + ; +"RTN","BMXPO",4,0) + ; +"RTN","BMXPO",5,0) +MAIN ;EP - this is the main routine driver +"RTN","BMXPO",6,0) + N BMXQFLG +"RTN","BMXPO",7,0) + D ASK +"RTN","BMXPO",8,0) + I $G(BMXQFLG) D XIT Q +"RTN","BMXPO",9,0) + ;D CLEAN(BMXAPP) +"RTN","BMXPO",10,0) + D POP(BMXAPP,BMXNS) +"RTN","BMXPO",11,0) + D XIT +"RTN","BMXPO",12,0) + Q +"RTN","BMXPO",13,0) + ; +"RTN","BMXPO",14,0) +GUIEP(RETVAL,BMXSTR) ;EP - gui entry point +"RTN","BMXPO",15,0) + N P,BMXAPP,BMXNS +"RTN","BMXPO",16,0) + S P="|" +"RTN","BMXPO",17,0) + S BMXGUI=1 +"RTN","BMXPO",18,0) + S BMXAPP=$P(BMXSTR,P) +"RTN","BMXPO",19,0) + S BMXNS=$P(BMXSTR,P,2) +"RTN","BMXPO",20,0) + K ^BMXTMP($J) +"RTN","BMXPO",21,0) + S RETVAL="^BMXTMP("_$J_")" +"RTN","BMXPO",22,0) + S ^BMXTMP($J,0)="T00250DATA"_$C(30) +"RTN","BMXPO",23,0) + ;D CLEAN(BMXAPP) +"RTN","BMXPO",24,0) + D POP(BMXAPP,BMXNS) +"RTN","BMXPO",25,0) + D XIT +"RTN","BMXPO",26,0) + Q +"RTN","BMXPO",27,0) + ; +"RTN","BMXPO",28,0) +ASK ;-- ask the name of the OPTION to populate +"RTN","BMXPO",29,0) + W ! +"RTN","BMXPO",30,0) + S DIC=19,DIC(0)="AEMQZ",DIC("A")="Populate which Application Context: " +"RTN","BMXPO",31,0) + D ^DIC +"RTN","BMXPO",32,0) + I '$G(Y) S BMXQFLG=1 Q +"RTN","BMXPO",33,0) + S BMXAPP=+Y +"RTN","BMXPO",34,0) + W ! +"RTN","BMXPO",35,0) + K DIC +"RTN","BMXPO",36,0) + S DIR(0)="F^1:3",DIR("A")="Populate RPC's from which Namespace: " +"RTN","BMXPO",37,0) + D ^DIR +"RTN","BMXPO",38,0) + I $D(DIRUT) S BMXQFLG=1 Q +"RTN","BMXPO",39,0) + S BMXNS=$G(Y) +"RTN","BMXPO",40,0) + Q +"RTN","BMXPO",41,0) + ; +"RTN","BMXPO",42,0) +CLEAN(APP) ;-- clean out the RPC multiple first +"RTN","BMXPO",43,0) + S DA(1)=APP +"RTN","BMXPO",44,0) + S DIK="^DIC(19,"_DA(1)_","_"""RPC"""_"," +"RTN","BMXPO",45,0) + N BMXDA +"RTN","BMXPO",46,0) + S BMXDA=0 F S BDMDA=$O(^DIC(19,APP,"RPC",BMXDA)) Q:'BMXDA D +"RTN","BMXPO",47,0) + . S DA=BMXDA +"RTN","BMXPO",48,0) + . D ^DIK +"RTN","BMXPO",49,0) + K ^DIC(19,APP,"RPC","B") +"RTN","BMXPO",50,0) + Q +"RTN","BMXPO",51,0) + ; +"RTN","BMXPO",52,0) +POP(APP,NS) ;populate the app context with RPC's +"RTN","BMXPO",53,0) + I '$G(BMXGUI) W !,"Populating Application Context" +"RTN","BMXPO",54,0) + N BMXDA +"RTN","BMXPO",55,0) + S BMXDA=NS +"RTN","BMXPO",56,0) + F S BMXDA=$O(^XWB(8994,"B",BMXDA)) Q:BMXDA=""!($E(BMXDA,1,3)'=NS) D +"RTN","BMXPO",57,0) + . N BMXIEN +"RTN","BMXPO",58,0) + . S BMXIEN=0 F S BMXIEN=$O(^XWB(8994,"B",BMXDA,BMXIEN)) Q:'BMXIEN D +"RTN","BMXPO",59,0) + .. Q:$O(^DIC(19,APP,"RPC","B",BMXIEN,0)) +"RTN","BMXPO",60,0) + .. N BDMIENS,BDMFDA,BDMERR +"RTN","BMXPO",61,0) + .. S BDMIENS(1)=APP +"RTN","BMXPO",62,0) + .. S BDMIENS="+2,"_APP_"," +"RTN","BMXPO",63,0) + .. S BDMFDA(19.05,BDMIENS,.01)=BMXIEN +"RTN","BMXPO",64,0) + .. D UPDATE^DIE("","BDMFDA","BDMIENS","BDMERR(1)") +"RTN","BMXPO",65,0) + .. I '$G(BMXGUI) W "." +"RTN","BMXPO",66,0) + Q +"RTN","BMXPO",67,0) + ; +"RTN","BMXPO",68,0) +XIT ;-- clean vars +"RTN","BMXPO",69,0) + D EN^XBVK("BMX") +"RTN","BMXPO",70,0) + Q +"RTN","BMXPO",71,0) + ; +"RTN","BMXPRS") +0^86^B8898368 +"RTN","BMXPRS",1,0) +BMXPRS ; IHS/OIT/HMW - BMX WINDOWS UTILS ; +"RTN","BMXPRS",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXPRS",3,0) + ; +"RTN","BMXPRS",4,0) + ; +"RTN","BMXPRS",5,0) +PARSE(X) ;EP-Parse SQL Statement into array +"RTN","BMXPRS",6,0) + ;Input SQL statement as X +"RTN","BMXPRS",7,0) + ;Returns BMXTK() array +"RTN","BMXPRS",8,0) + ;Errors returned in BMXERR +"RTN","BMXPRS",9,0) + ; +"RTN","BMXPRS",10,0) + D PRE +"RTN","BMXPRS",11,0) + Q:$D(BMXERR) +"RTN","BMXPRS",12,0) + D POST +"RTN","BMXPRS",13,0) + Q +"RTN","BMXPRS",14,0) + ; +"RTN","BMXPRS",15,0) +POST2 ;EP - Remove commas from BMXTK +"RTN","BMXPRS",16,0) + N J,K +"RTN","BMXPRS",17,0) + S J=0 F S J=$O(BMXTK(J)) Q:'+J D +"RTN","BMXPRS",18,0) + . S K=$O(BMXTK(J)) +"RTN","BMXPRS",19,0) + . I +K,","=$G(BMXTK(K)) D +"RTN","BMXPRS",20,0) + . . K BMXTK(K) +"RTN","BMXPRS",21,0) + . . D PACK(J) +"RTN","BMXPRS",22,0) + . . Q +"RTN","BMXPRS",23,0) + . Q +"RTN","BMXPRS",24,0) + Q +"RTN","BMXPRS",25,0) + ; +"RTN","BMXPRS",26,0) +POST ; +"RTN","BMXPRS",27,0) + ;Combine multi-character operators +"RTN","BMXPRS",28,0) + N J +"RTN","BMXPRS",29,0) + S J=0 F S J=$O(BMXTK(J)) Q:'+J D +"RTN","BMXPRS",30,0) + . I ">"=BMXTK(J) D Q +"RTN","BMXPRS",31,0) + . . I "="[$G(BMXTK(J+1)) D Q +"RTN","BMXPRS",32,0) + . . . S BMXTK(J)=BMXTK(J)_"=" +"RTN","BMXPRS",33,0) + . . . K BMXTK(J+1) +"RTN","BMXPRS",34,0) + . . . D PACK(J) +"RTN","BMXPRS",35,0) + . . I "<"[$G(BMXTK(J+1)) D Q +"RTN","BMXPRS",36,0) + . . . S BMXTK(J)="<"_BMXTK(J) +"RTN","BMXPRS",37,0) + . . . K BMXTK(J+1) +"RTN","BMXPRS",38,0) + . . . D PACK(J) +"RTN","BMXPRS",39,0) + . I "<"=BMXTK(J) D Q +"RTN","BMXPRS",40,0) + . . I "=>"[$G(BMXTK(J+1)) D +"RTN","BMXPRS",41,0) + . . . S BMXTK(J)=BMXTK(J)_BMXTK(J+1) +"RTN","BMXPRS",42,0) + . . . K BMXTK(J+1) +"RTN","BMXPRS",43,0) + . . . D PACK(J) +"RTN","BMXPRS",44,0) + . I "="=BMXTK(J) D Q +"RTN","BMXPRS",45,0) + . . I "<>"[$G(BMXTK(J+1)) D +"RTN","BMXPRS",46,0) + . . . S BMXTK(J)=BMXTK(J+1)_BMXTK(J) +"RTN","BMXPRS",47,0) + . . . K BMXTK(J+1) +"RTN","BMXPRS",48,0) + . . . D PACK(J) +"RTN","BMXPRS",49,0) + Q +"RTN","BMXPRS",50,0) + ; +"RTN","BMXPRS",51,0) +PACK(J) ; +"RTN","BMXPRS",52,0) + F S J=$O(BMXTK(J)) Q:'+J D +"RTN","BMXPRS",53,0) + . S BMXTK(J-1)=BMXTK(J) +"RTN","BMXPRS",54,0) + . K BMXTK(J) +"RTN","BMXPRS",55,0) + Q +"RTN","BMXPRS",56,0) + ; +"RTN","BMXPRS",57,0) +PRE N P,T,Q,Q1,A,B S (P,T,Q)=0,BMXTK="",A=0 +"RTN","BMXPRS",58,0) +START S A=A+1 +"RTN","BMXPRS",59,0) + S B=$E(X,A) +"RTN","BMXPRS",60,0) + I B="" G B5 +"RTN","BMXPRS",61,0) + I 'Q G QUOTE +"RTN","BMXPRS",62,0) + I B=$C(39) G QUOTE +"RTN","BMXPRS",63,0) + S BMXTK=BMXTK_B G START +"RTN","BMXPRS",64,0) +QUOTE I B'=$C(39) G SPACE +"RTN","BMXPRS",65,0) + I Q G QUOTE2 +"RTN","BMXPRS",66,0) + ;S Q=1,BMXTK=B G START +"RTN","BMXPRS",67,0) + S Q=1,BMXTK=BMXTK_B G START +"RTN","BMXPRS",68,0) +QUOTE2 S Q1=B,A=A+1,B=$E(X,A) +"RTN","BMXPRS",69,0) + I B']"" G QUOTE3 +"RTN","BMXPRS",70,0) + I B'=$C(39) G QUOTE3 +"RTN","BMXPRS",71,0) + S BMXTK=BMXTK_Q1_B G START +"RTN","BMXPRS",72,0) +QUOTE3 S A=A-1,B=Q1,BMXTK=BMXTK_B,Q=0 G START +"RTN","BMXPRS",73,0) +SPACE I B'=" " G OP +"RTN","BMXPRS",74,0) + I BMXTK]"" S T=T+1,BMXTK(T)=BMXTK,BMXTK="" +"RTN","BMXPRS",75,0) + G START +"RTN","BMXPRS",76,0) +OP I "=><"'[B G OPAREN +"RTN","BMXPRS",77,0) + I BMXTK]"" S T=T+1,BMXTK(T)=BMXTK,BMXTK="" +"RTN","BMXPRS",78,0) + S T=T+1,BMXTK(T)=B,BMXTK="" +"RTN","BMXPRS",79,0) + G START +"RTN","BMXPRS",80,0) +OPAREN I B'="(" G CPAREN +"RTN","BMXPRS",81,0) + S P=P+1 +"RTN","BMXPRS",82,0) + I BMXTK]"" S T=T+1,BMXTK(T)=BMXTK,BMXTK="" +"RTN","BMXPRS",83,0) + S T=T+1,BMXTK(T)=B G START +"RTN","BMXPRS",84,0) +CPAREN I B'=")" G B2 +"RTN","BMXPRS",85,0) + I P G B1 +"RTN","BMXPRS",86,0) + G B0 +"RTN","BMXPRS",87,0) + ; +"RTN","BMXPRS",88,0) +B0 S BMXERR="SQL SYNTAX ERROR" D ERROR G B5 +"RTN","BMXPRS",89,0) +B1 S P=P-1 +"RTN","BMXPRS",90,0) + I BMXTK]"" S T=T+1,BMXTK(T)=BMXTK,BMXTK="" +"RTN","BMXPRS",91,0) + S T=T+1,BMXTK(T)=B G START +"RTN","BMXPRS",92,0) +B2 I B'="," G B3 +"RTN","BMXPRS",93,0) + S T=T+1,BMXTK(T)=BMXTK,T=T+1,BMXTK(T)=",",BMXTK="" G START +"RTN","BMXPRS",94,0) +B3 S BMXTK=BMXTK_B +"RTN","BMXPRS",95,0) +B4 G START +"RTN","BMXPRS",96,0) +B5 I BMXTK]"" S T=T+1,BMXTK(T)=BMXTK +"RTN","BMXPRS",97,0) + I $D(BMXERR) G B6 +"RTN","BMXPRS",98,0) + I P S BMXERR="SQL SYNTAX ERROR: MATCHING PARENTHESIS NOT FOUND" D ERROR +"RTN","BMXPRS",99,0) + E I Q S BMXERR="SQL SYNTAX ERROR: MATCHING QUOTE NOT FOUND" D ERROR +"RTN","BMXPRS",100,0) + I P>0 G START +"RTN","BMXPRS",101,0) +B6 Q +"RTN","BMXPRS",102,0) + ; +"RTN","BMXPRS",103,0) +ERROR ;W !,"ERROR=",BMXERR,! Q +"RTN","BMXPRS",104,0) + Q +"RTN","BMXRPC") +0^87^B21470311 +"RTN","BMXRPC",1,0) +BMXRPC ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; 9/7/10 5:04am +"RTN","BMXRPC",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXRPC",3,0) + ;;Stolen from:* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER * +"RTN","BMXRPC",4,0) + ;; GENERIC LOOKUP UTILITY FOR RETURNING MATCHING RECORDS +"RTN","BMXRPC",5,0) + ;; OR TABLES TO RPC'S. +"RTN","BMXRPC",6,0) + ; +"RTN","BMXRPC",7,0) + ; *** NOTE: I have discovered a number of cases where these calls +"RTN","BMXRPC",8,0) + ; produce errors (with error messages to IO) or simply +"RTN","BMXRPC",9,0) + ; do not work correctly. ANY CALL to this utility +"RTN","BMXRPC",10,0) + ; should be thoroughly tested in the M environment +"RTN","BMXRPC",11,0) + ; before being used as an RPC. +"RTN","BMXRPC",12,0) + ; +"RTN","BMXRPC",13,0) + ;---------- +"RTN","BMXRPC",14,0) + ; Change Log: +"RTN","BMXRPC",15,0) + ; UJO/SMH on 7 Sep 2010 -- added RPC for determining UTF-8 support +"RTN","BMXRPC",16,0) + ; Tag: UTF-8 +"RTN","BMXRPC",17,0) +LOOKUP(BMXGBL,BMXFL,BMXFLDS,BMXFLG,BMXIN,BMXMX,BMXIX,BMXSCR,BMXMC) ;EP +"RTN","BMXRPC",18,0) + ;---> Places matching records from requested file into a +"RTN","BMXRPC",19,0) + ;---> result global, ^BMXTEMP($J). The exact global name +"RTN","BMXRPC",20,0) + ;---> is returned in the first parameter (BMXGBL). +"RTN","BMXRPC",21,0) + ;---> Records are returned one per node in the result global. +"RTN","BMXRPC",22,0) + ;---> Each record is terminated with a $C(30), for parsing out +"RTN","BMXRPC",23,0) + ;---> on the VB side, since the Broker concatenates all nodes +"RTN","BMXRPC",24,0) + ;---> into a single string when passing the data out of M. +"RTN","BMXRPC",25,0) + ;---> Requested fields within records are delimited by "^". +"RTN","BMXRPC",26,0) + ;---> NOTE: The first "^"-piece of every node is the IEN of +"RTN","BMXRPC",27,0) + ;---> that entry in its file; the requested fields follow. +"RTN","BMXRPC",28,0) + ;---> The final record (node) contains Error Delimiter, +"RTN","BMXRPC",29,0) + ; $C(31)_$C(31), followed by error text, if any. +"RTN","BMXRPC",30,0) + ; +"RTN","BMXRPC",31,0) + ;---> Parameters: +"RTN","BMXRPC",32,0) + ; 1 - BMXGBL (ret) Name of result global for Broker. +"RTN","BMXRPC",33,0) + ; 2 - BMXFL (req) File for lookup. +"RTN","BMXRPC",34,0) + ; 3 - BMXFLDS (opt) Fields to return w/each entry. +"RTN","BMXRPC",35,0) + ; 4 - BMXFLG (opt) Flags in DIC(0); If null, "M" is sent. +"RTN","BMXRPC",36,0) + ; 5 - BMXIN (opt) Input to match on (see Algorithm below). +"RTN","BMXRPC",37,0) + ; 6 - BMXMX (opt) Maximum number of entries to return. +"RTN","BMXRPC",38,0) + ; 7 - BMXIX (opt) Indexes to search. +"RTN","BMXRPC",39,0) + ; 8 - BMXSCR (opt) Screen/filter (M code). +"RTN","BMXRPC",40,0) + ; 9 - BMXMC (opt) Mixed Case: 1=mixed case, 0=no change. +"RTN","BMXRPC",41,0) + ; (Converts data in uppercase to mixed case.) +"RTN","BMXRPC",42,0) + ; +"RTN","BMXRPC",43,0) + ;---> Set variables, kill temp globals. +"RTN","BMXRPC",44,0) + N (BMXGBL,BMXFL,BMXFLDS,BMXFLG,BMXIN,BMXMX,BMXIX,BMXSCR,BMXMC) +"RTN","BMXRPC",45,0) + S BMX31=$C(31)_$C(31) +"RTN","BMXRPC",46,0) + S BMXGBL="^BMXTEMP("_$J_")",BMXERR="",U="^" +"RTN","BMXRPC",47,0) + K ^BMXTMP($J),^BMXTEMP($J) +"RTN","BMXRPC",48,0) + ; +"RTN","BMXRPC",49,0) + ;---> If file number not provided, return error. +"RTN","BMXRPC",50,0) + I '$G(BMXFL) D ERROUT("File number not provided.",1) Q +"RTN","BMXRPC",51,0) + ; +"RTN","BMXRPC",52,0) + ;---> If no fields provided, pass .01. +"RTN","BMXRPC",53,0) + ;---> IEN will always be the first piece of data returned. +"RTN","BMXRPC",54,0) + ;---> NOTE: If .01 is NOT included, but the Index to lookup on is +"RTN","BMXRPC",55,0) + ;---> NOT on the .01, then the .01 will be returned +"RTN","BMXRPC",56,0) + ;---> automatically as the second ^-piece of data in the +"RTN","BMXRPC",57,0) + ;---> Result Global. +"RTN","BMXRPC",58,0) + ;---> So it would be: IEN^.01^requested fields... +"RTN","BMXRPC",59,0) + I $G(BMXFLDS)="" S BMXFLDS=".01" +"RTN","BMXRPC",60,0) + ; +"RTN","BMXRPC",61,0) + ;---> If no index or flag provided, set flag="M". +"RTN","BMXRPC",62,0) + I $G(BMXFLG)="" D +"RTN","BMXRPC",63,0) + .I $G(BMXIX)="" S BMXFLG="M" Q +"RTN","BMXRPC",64,0) + .S BMXFLG="" +"RTN","BMXRPC",65,0) + ; +"RTN","BMXRPC",66,0) + ;---> If no Maximum Number provided, set it to 200. +"RTN","BMXRPC",67,0) + I '$G(BMXMX) S BMXMX=200 +"RTN","BMXRPC",68,0) + ; +"RTN","BMXRPC",69,0) + ;---> Define index and screen. +"RTN","BMXRPC",70,0) + S:'$D(BMXIX) BMXIX="" +"RTN","BMXRPC",71,0) + S:'$D(BMXSCR) BMXSCR="" +"RTN","BMXRPC",72,0) + ; +"RTN","BMXRPC",73,0) + ;---> Set Target Global for output and errors. +"RTN","BMXRPC",74,0) + S BMXG="^BMXTMP($J)" +"RTN","BMXRPC",75,0) + ; +"RTN","BMXRPC",76,0) + ;---> If Mixed Case not set, set to No Change. +"RTN","BMXRPC",77,0) + I '$D(BMXMC) S BMXMC=0 +"RTN","BMXRPC",78,0) + ; +"RTN","BMXRPC",79,0) + ;---> Silent Fileman call. +"RTN","BMXRPC",80,0) + D +"RTN","BMXRPC",81,0) + .I $G(BMXIN)="" D Q +"RTN","BMXRPC",82,0) + ..D LIST^DIC(BMXFL,,BMXFLDS,,BMXMX,0,,BMXIX,BMXSCR,,BMXG,BMXG) +"RTN","BMXRPC",83,0) + .D FIND^DIC(BMXFL,,BMXFLDS,BMXFLG,BMXIN,BMXMX,BMXIX,BMXSCR,,BMXG,BMXG) +"RTN","BMXRPC",84,0) + ; +"RTN","BMXRPC",85,0) + D WRITE +"RTN","BMXRPC",86,0) + Q +"RTN","BMXRPC",87,0) + ; +"RTN","BMXRPC",88,0) + ; +"RTN","BMXRPC",89,0) + ;---------- +"RTN","BMXRPC",90,0) +WRITE ;EP +"RTN","BMXRPC",91,0) + ;---> Collect data for matching records and write in result global. +"RTN","BMXRPC",92,0) + ; +"RTN","BMXRPC",93,0) + ;---> First, check for errors. +"RTN","BMXRPC",94,0) + ;---> If errors exist, write them and quit. +"RTN","BMXRPC",95,0) + N I,N,X +"RTN","BMXRPC",96,0) + I $D(^BMXTMP($J,"DIERR")) I $O(^("DIERR",0)) D Q +"RTN","BMXRPC",97,0) + .S N=0,X="" +"RTN","BMXRPC",98,0) + .F S N=$O(^BMXTMP($J,"DIERR",N)) Q:'N D +"RTN","BMXRPC",99,0) + ..N M S M=0 +"RTN","BMXRPC",100,0) + ..F S M=$O(^BMXTMP($J,"DIERR",N,"TEXT",M)) Q:'M D +"RTN","BMXRPC",101,0) + ...S X=X_^BMXTMP($J,"DIERR",N,"TEXT",M)_" " +"RTN","BMXRPC",102,0) + .D ERROUT(X,1) +"RTN","BMXRPC",103,0) + ; +"RTN","BMXRPC",104,0) + ; +"RTN","BMXRPC",105,0) + ;---> Write Field Names +"RTN","BMXRPC",106,0) + S $P(ASDX,"^",1)="IEN" +"RTN","BMXRPC",107,0) + F ASDC=1:1:$L(BMXFLDS,";") D +"RTN","BMXRPC",108,0) + . S ASDXFNUM=$P(BMXFLDS,";",ASDC) +"RTN","BMXRPC",109,0) + . S ASDXFNAM=$P(^DD(BMXFL,ASDXFNUM,0),"^") +"RTN","BMXRPC",110,0) + . S:ASDXFNAM="" ASDXFNAM="UNKNOWN"_ASDC +"RTN","BMXRPC",111,0) + . S $P(ASDX,"^",ASDC+1)=ASDXFNAM +"RTN","BMXRPC",112,0) + S ^BMXTEMP($J,1)=ASDX_$C(30) +"RTN","BMXRPC",113,0) + ;---> Write valid results. +"RTN","BMXRPC",114,0) + ;---> Loop through the IEN node (...2,N) of the temp global. +"RTN","BMXRPC",115,0) + N I,N,X S N=0 +"RTN","BMXRPC",116,0) + F I=2:1 S N=$O(^BMXTMP($J,"DILIST",2,N)) Q:'N D +"RTN","BMXRPC",117,0) + .;---> Always set first piece of X=IEN of entry. +"RTN","BMXRPC",118,0) + .S X=^BMXTMP($J,"DILIST",2,N) +"RTN","BMXRPC",119,0) + .; +"RTN","BMXRPC",120,0) + .;---> Collect other fields and concatenate to X. +"RTN","BMXRPC",121,0) + .N M S M=0 +"RTN","BMXRPC",122,0) + .F S M=$O(^BMXTMP($J,"DILIST","ID",N,M)) Q:'M D +"RTN","BMXRPC",123,0) + ..S X=X_U_^BMXTMP($J,"DILIST","ID",N,M) +"RTN","BMXRPC",124,0) + .; +"RTN","BMXRPC",125,0) + .;---> Convert data to mixed case if BMXMC=1. +"RTN","BMXRPC",126,0) + .S:BMXMC X=$$T^BMXTRS(X) +"RTN","BMXRPC",127,0) + .; +"RTN","BMXRPC",128,0) + .;---> Set data in result global. +"RTN","BMXRPC",129,0) + .S ^BMXTEMP($J,I)=X_$C(30) +"RTN","BMXRPC",130,0) + ; +"RTN","BMXRPC",131,0) + ;---> If no results, report it as an error. +"RTN","BMXRPC",132,0) + D:'$O(^BMXTEMP($J,0)) +"RTN","BMXRPC",133,0) + .I BMXIN]"" S BMXERR="No entry matches """_BMXIN_"""." Q +"RTN","BMXRPC",134,0) + .S BMXERR="Either the lookup file is empty" +"RTN","BMXRPC",135,0) + .S BMXERR=BMXERR_" or all entries are screened (software error)." +"RTN","BMXRPC",136,0) + ; +"RTN","BMXRPC",137,0) + ;---> Tack on Error Delimiter and any error. +"RTN","BMXRPC",138,0) + S ^BMXTEMP($J,I)=BMX31_BMXERR +"RTN","BMXRPC",139,0) + Q +"RTN","BMXRPC",140,0) + ; +"RTN","BMXRPC",141,0) + ; +"RTN","BMXRPC",142,0) + ;---------- +"RTN","BMXRPC",143,0) +ERROUT(BMXERR,I) ;EP +"RTN","BMXRPC",144,0) + ;---> Save next line for Error Code File if ever used. +"RTN","BMXRPC",145,0) + ;---> If necessary, use I>1 to avoid overwriting valid data. +"RTN","BMXRPC",146,0) + S:'$G(I) I=1 +"RTN","BMXRPC",147,0) + S ^BMXTEMP($J,I)=BMX31_BMXERR +"RTN","BMXRPC",148,0) + Q +"RTN","BMXRPC",149,0) + ; +"RTN","BMXRPC",150,0) + ; +"RTN","BMXRPC",151,0) +PASSERR(BMXGBL,BMXERR) ;EP +"RTN","BMXRPC",152,0) + ;---> If the RPC routine calling the BMX Generic Lookup above +"RTN","BMXRPC",153,0) + ;---> detects a specific error prior to the call and wants to pass +"RTN","BMXRPC",154,0) + ;---> that error in the result global rather than a generic error, +"RTN","BMXRPC",155,0) + ;---> then a call to this function (PASSERR) can be made. +"RTN","BMXRPC",156,0) + ;---> This call will store the error text passed in the result global. +"RTN","BMXRPC",157,0) + ;---> The calling routine should then quit (abort its call to the +"RTN","BMXRPC",158,0) + ;---> BMX Generic Lookup function above). +"RTN","BMXRPC",159,0) + ; +"RTN","BMXRPC",160,0) + ;---> Parameters: +"RTN","BMXRPC",161,0) + ; 1 - BMXGBL (ret) Name of result global for Broker. +"RTN","BMXRPC",162,0) + ; 2 - BMXERR (req) Text of error to be stored in result global. +"RTN","BMXRPC",163,0) + ; +"RTN","BMXRPC",164,0) + S:$G(BMXERR)="" BMXERR="Error not passed (software error)." +"RTN","BMXRPC",165,0) + ; +"RTN","BMXRPC",166,0) + N BMX31 S BMX31=$C(31)_$C(31) +"RTN","BMXRPC",167,0) + K ^BMXTMP($J),^BMXTEMP($J) +"RTN","BMXRPC",168,0) + S BMXGBL="^BMXTEMP("_$J_")" +"RTN","BMXRPC",169,0) + S ^BMXTEMP($J,1)=BMX31_BMXERR +"RTN","BMXRPC",170,0) + Q +"RTN","BMXRPC",171,0) +UTF8(BMXRET) +"RTN","BMXRPC",172,0) + ; RPC: BMX UTF-8 +"RTN","BMXRPC",173,0) + ; UJO/SMH - tests if this database supports UTF-8 encoding +"RTN","BMXRPC",174,0) + ; 0 for FALSE for 1 for TRUE. +"RTN","BMXRPC",175,0) + I ^%ZOSF("OS")'["GT.M" S BMXRET=0 QUIT +"RTN","BMXRPC",176,0) + I $ZCHSET="M" S BMXRET=0 QUIT +"RTN","BMXRPC",177,0) + I $ZCHSET="UTF-8" S BMXRET=1 QUIT +"RTN","BMXRPC",178,0) + S BMXRET=0 QUIT ;default +"RTN","BMXRPC1") +0^88^B52168951 +"RTN","BMXRPC1",1,0) +BMXRPC1 ; IHS/OIT/HMW - UTIL: REMOTE PROCEDURE CALLS ; +"RTN","BMXRPC1",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXRPC1",3,0) + ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER * +"RTN","BMXRPC1",4,0) + ;; UTILITY: CODE FOR REMOTE PROCEDURE CALLS. +"RTN","BMXRPC1",5,0) + ;; RETURNS PATIENT DATA, HEALTH SUMMARY, FACE SHEET. +"RTN","BMXRPC1",6,0) + ; +"RTN","BMXRPC1",7,0) + ; +"RTN","BMXRPC1",8,0) + ;---------- +"RTN","BMXRPC1",9,0) +PDATA(BMXDATA,BMXDFN) ;EP +"RTN","BMXRPC1",10,0) + ;---> Return Patient Data in 5 ^-delimited pieces: +"RTN","BMXRPC1",11,0) + ;---> 1 - DOB in format: OCT 01,1994. +"RTN","BMXRPC1",12,0) + ;---> 2 - Age in format: 35 Months. +"RTN","BMXRPC1",13,0) + ;---> 3 - Text of Patient's sex. +"RTN","BMXRPC1",14,0) + ;---> 4 - HRCN in the format XX-XX-XX. +"RTN","BMXRPC1",15,0) + ;---> 5 - Text of ACTIVE/INACTIVE Status. +"RTN","BMXRPC1",16,0) + ;---> Parameters: +"RTN","BMXRPC1",17,0) + ; 1 - BMXDATA (ret) String of patient data||error. +"RTN","BMXRPC1",18,0) + ; 2 - BMXDFN (req) DFN of patient. +"RTN","BMXRPC1",19,0) + ; +"RTN","BMXRPC1",20,0) + ;---> Delimiter to pass error with result to GUI. +"RTN","BMXRPC1",21,0) + N BMX31,BMXERR S BMX31=$C(31)_$C(31) +"RTN","BMXRPC1",22,0) + S BMXDATA="",BMXERR="" +"RTN","BMXRPC1",23,0) + ; +"RTN","BMXRPC1",24,0) + ;---> If DFN not supplied, set Error Code and quit. +"RTN","BMXRPC1",25,0) + I '$G(BMXDFN) D Q +"RTN","BMXRPC1",26,0) + .;D ERRCD^BMXUTL2(201,.BMXERR) S BMXDATA=BMX31_BMXERR +"RTN","BMXRPC1",27,0) + ; +"RTN","BMXRPC1",28,0) + ;---> DOB. +"RTN","BMXRPC1",29,0) + S BMXDATA=$$TXDT1^BMXUTL5($$DOB^BMXUTL1(BMXDFN)) +"RTN","BMXRPC1",30,0) + ; +"RTN","BMXRPC1",31,0) + ;---> Age. +"RTN","BMXRPC1",32,0) + S BMXDATA=BMXDATA_U_$$AGEF^BMXUTL1(BMXDFN) +"RTN","BMXRPC1",33,0) + ; +"RTN","BMXRPC1",34,0) + ;---> Text of sex. +"RTN","BMXRPC1",35,0) + S BMXDATA=BMXDATA_U_$$SEXW^BMXUTL1(BMXDFN) +"RTN","BMXRPC1",36,0) + ; +"RTN","BMXRPC1",37,0) + ;---> HRCN, format XX-XX-XX. +"RTN","BMXRPC1",38,0) + S BMXDATA=BMXDATA_U_$$HRCN^BMXUTL1(BMXDFN) +"RTN","BMXRPC1",39,0) + ; +"RTN","BMXRPC1",40,0) + ;---> Active/Inactive Status. +"RTN","BMXRPC1",41,0) + ;S BMXDATA=BMXDATA_U_$$ACTIVE^BMXUTL1(BMXDFN) +"RTN","BMXRPC1",42,0) + ; +"RTN","BMXRPC1",43,0) + S BMXDATA=BMXDATA_BMX31 +"RTN","BMXRPC1",44,0) + ; +"RTN","BMXRPC1",45,0) + Q +"RTN","BMXRPC1",46,0) + ; +"RTN","BMXRPC1",47,0) + ; +"RTN","BMXRPC1",48,0) + ;---------- +"RTN","BMXRPC1",49,0) +HS(BMXGBL,BMXDFN) ;EP +"RTN","BMXRPC1",50,0) + ;---> Return patient's Health Summary in global array, ^BMXTEMP($J,"HS". +"RTN","BMXRPC1",51,0) + ;---> Lines delimited by "^". +"RTN","BMXRPC1",52,0) + ;---> Called by RPC: BMX IMMSERVE PT PROFILE +"RTN","BMXRPC1",53,0) + ;---> Parameters: +"RTN","BMXRPC1",54,0) + ; 1 - BMXGBL (ret) Name of result global containing patient's +"RTN","BMXRPC1",55,0) + ; Health Summary, passed to Broker. +"RTN","BMXRPC1",56,0) + ; 2 - BMXDFN (req) DFN of patient. +"RTN","BMXRPC1",57,0) + ; +"RTN","BMXRPC1",58,0) + ;---> Delimiter to pass error with result to GUI. +"RTN","BMXRPC1",59,0) + N BMX30,BMX31,BMXERR,X +"RTN","BMXRPC1",60,0) + S BMX30=$C(30),BMX31=$C(31)_$C(31) +"RTN","BMXRPC1",61,0) + S BMXGBL="^BMXTEMP("_$J_",""HS"")",BMXERR="" +"RTN","BMXRPC1",62,0) + K ^BMXTEMP($J,"HS") +"RTN","BMXRPC1",63,0) + ; +"RTN","BMXRPC1",64,0) + ;---> If DFN not supplied, set Error Code and quit. +"RTN","BMXRPC1",65,0) + I '$G(BMXDFN) D Q +"RTN","BMXRPC1",66,0) + .;D ERRCD^BMXUTL2(201,.BMXERR) S ^BMXTEMP($J,"HS",I)=BMX31_BMXERR +"RTN","BMXRPC1",67,0) + ; +"RTN","BMXRPC1",68,0) + ;---> If patient does not exist, set Error Code and quit. +"RTN","BMXRPC1",69,0) + I '$D(^AUPNPAT(BMXDFN,0)) D Q +"RTN","BMXRPC1",70,0) + .;D ERRCD^BMXUTL2(203,.BMXERR) S ^BMXTEMP($J,"HS",I)=BMX31_BMXERR +"RTN","BMXRPC1",71,0) + ; +"RTN","BMXRPC1",72,0) + N APCHSPAT,APCHSTYP +"RTN","BMXRPC1",73,0) + S APCHSPAT=BMXDFN,APCHSTYP=7 +"RTN","BMXRPC1",74,0) + ;---> Doesn't work from Device 56. +"RTN","BMXRPC1",75,0) + ;D GUIR^XBLM("EN^APCHS","^TMP(""BMXHS"",$J,") +"RTN","BMXRPC1",76,0) + ; +"RTN","BMXRPC1",77,0) + ;---> Generate a host file name. +"RTN","BMXRPC1",78,0) + N BMXFN S BMXFN="XB"_$J +"RTN","BMXRPC1",79,0) + ; +"RTN","BMXRPC1",80,0) + D +"RTN","BMXRPC1",81,0) + .;---> Important to preserve IO variables for when $I returns to 56. +"RTN","BMXRPC1",82,0) + .N IO,IOBS,IOF,IOHG,IOM,ION,IOPAR,IOS,IOSL,IOST,IOT,IOUPAR,IOXY +"RTN","BMXRPC1",83,0) + .; +"RTN","BMXRPC1",84,0) + .;---> Open host file to receive legacy code display. +"RTN","BMXRPC1",85,0) + .;S Y=$$OPEN^%ZISH($$HFSPATH^BMXUTL1,BMXFN,"W") +"RTN","BMXRPC1",86,0) + .; +"RTN","BMXRPC1",87,0) + .;---> Call to legacy code for Health Summary display. +"RTN","BMXRPC1",88,0) + .D EN^APCHS +"RTN","BMXRPC1",89,0) + .;---> Write End of File (EOF) marker. +"RTN","BMXRPC1",90,0) + .W $C(9) +"RTN","BMXRPC1",91,0) + .; +"RTN","BMXRPC1",92,0) + .;---> %ZISC doesn't close Device 51 when called from TCPIP socket? +"RTN","BMXRPC1",93,0) + .;D ^%ZISC +"RTN","BMXRPC1",94,0) + .;---> Buffer won't write out to file until the device is closed +"RTN","BMXRPC1",95,0) + .;---> or the buffer is flushed by some other command. +"RTN","BMXRPC1",96,0) + .;---> At this point, host file exists but has 0 bytes. +"RTN","BMXRPC1",97,0) + .;C 51 +"RTN","BMXRPC1",98,0) + .;---> Now host file contains legacy code display data. +"RTN","BMXRPC1",99,0) + .; +"RTN","BMXRPC1",100,0) + .;---> For some reason %ZISH cannot open the host file a second time. +"RTN","BMXRPC1",101,0) + .;S Y=$$OPEN^%ZISH($$HFSPATH^BMXUTL1,BMXFN,"R") +"RTN","BMXRPC1",102,0) + .;O 51:($$HFSPATH^BMXUTL1_BMXFN:"R") +"RTN","BMXRPC1",103,0) + .;U 51 +"RTN","BMXRPC1",104,0) + .; +"RTN","BMXRPC1",105,0) + .;---> Read in the host file. +"RTN","BMXRPC1",106,0) + .D +"RTN","BMXRPC1",107,0) + ..;---> Stop reading Host File if line contains EOF $C(9). +"RTN","BMXRPC1",108,0) + ..;N I,Y F I=1:1 R Y Q:Y[$C(9) S ^TMP("BMXHS",$J,I)=Y +"RTN","BMXRPC1",109,0) + .; +"RTN","BMXRPC1",110,0) + .;---> %ZISC doesn't close Device 51 when called from TCPIP socket? +"RTN","BMXRPC1",111,0) + .;D ^%ZISC +"RTN","BMXRPC1",112,0) + .;C 51 +"RTN","BMXRPC1",113,0) + ; +"RTN","BMXRPC1",114,0) + ;---> At this point $I=1. The job has "forgotten" its $I, even +"RTN","BMXRPC1",115,0) + ;---> though %SS shows 56 as the current device. $I=1 causes a +"RTN","BMXRPC1",116,0) + ;---> 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) + ;---> at CAPI+10^XWBBRK2. A simple USE 56 command +"RTN","BMXRPC1",212,0) + ;---> appears to "remind" the job its $I is 56, and it works. +"RTN","BMXRPC1",213,0) + ;---> Possibly this is something %ZISC ordinarily does. +"RTN","BMXRPC1",214,0) + U 56 +"RTN","BMXRPC1",215,0) + ; +"RTN","BMXRPC1",216,0) + ;---> Copy Face Sheet to global array for passing back to GUI. +"RTN","BMXRPC1",217,0) + N I,N,U,X S U="^" +"RTN","BMXRPC1",218,0) + S N=0 +"RTN","BMXRPC1",219,0) + F I=1:1 S N=$O(^TMP("BMXFACE",$J,N)) Q:'N D +"RTN","BMXRPC1",220,0) + .;---> Set null lines (line breaks) equal to one space, so that +"RTN","BMXRPC1",221,0) + .;---> Windows reader will quit only at the final "null" line. +"RTN","BMXRPC1",222,0) + .S X=^TMP("BMXFACE",$J,N) S:X="" X=" " +"RTN","BMXRPC1",223,0) + .;---> Remove Carriage Return (13)_Formfeed (12) characters. +"RTN","BMXRPC1",224,0) + .I X[$C(13)_$C(12) S X=$P(X,$C(13)_$C(12),2) +"RTN","BMXRPC1",225,0) + .; +"RTN","BMXRPC1",226,0) + .S ^BMXTEMP($J,"FACE",I)=X_BMX30 +"RTN","BMXRPC1",227,0) + ; +"RTN","BMXRPC1",228,0) + ;---> If no Health Summary produced, report it as an error. +"RTN","BMXRPC1",229,0) + D:'$O(^BMXTEMP($J,"FACE",0)) +"RTN","BMXRPC1",230,0) + .;D ERRCD^BMXUTL2(408,.BMXERR) S ^BMXTEMP($J,"FACE",I)=BMX31_BMXERR +"RTN","BMXRPC1",231,0) + ; +"RTN","BMXRPC1",232,0) + ;---> Tack on Error Delimiter and any error. +"RTN","BMXRPC1",233,0) + S ^BMXTEMP($J,"FACE",I)=BMX31_BMXERR +"RTN","BMXRPC1",234,0) + ; +"RTN","BMXRPC1",235,0) + ;---> This works; host file gets deleted. +"RTN","BMXRPC1",236,0) + ;S Y=$$DEL^%ZISH($$HFSPATH^BMXUTL1,BMXFN) +"RTN","BMXRPC1",237,0) + K ^TMP("BMXFACE",$J) +"RTN","BMXRPC1",238,0) + Q +"RTN","BMXRPC2") +0^89^B11504982 +"RTN","BMXRPC2",1,0) +BMXRPC2 ; IHS/OIT/HMW - FIELD LIST ; +"RTN","BMXRPC2",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXRPC2",3,0) + ; +"RTN","BMXRPC2",4,0) +FLDLIST(BMXGBL,BMXFL,BMXATTR,BMXSCR) ;EP +"RTN","BMXRPC2",5,0) + ;TODO: Change all this to be a hard-coded $O thru ^DD +"RTN","BMXRPC2",6,0) + ;Returns info in BMXATTR for all fields in file number BMXFL +"RTN","BMXRPC2",7,0) + ;BMXSCR is executable code to set $T +"RTN","BMXRPC2",8,0) + ; When BMXSCR is executed, the field number is in BMXFLD +"RTN","BMXRPC2",9,0) + ;See FileMan documentation for FIELD^DD for description +"RTN","BMXRPC2",10,0) + ;of Attributes +"RTN","BMXRPC2",11,0) + ; +"RTN","BMXRPC2",12,0) + ;---> Set variables, kill temp globals. +"RTN","BMXRPC2",13,0) + ;S ^HW("F",BMXFL)="" +"RTN","BMXRPC2",14,0) + ;S ^HW("F",BMXATTR)="" +"RTN","BMXRPC2",15,0) + N BMX31,BMXERR,BMXG,BMXFLD,BMX,BMXC,BMXT +"RTN","BMXRPC2",16,0) + S BMX31=$C(31)_$C(31) +"RTN","BMXRPC2",17,0) + S BMXGBL="BMXTMP("_$J_")",BMXERR="",U="^" +"RTN","BMXRPC2",18,0) + K BMXTMP($J) +"RTN","BMXRPC2",19,0) + ; +"RTN","BMXRPC2",20,0) + ;---> If file number not provided, return error. +"RTN","BMXRPC2",21,0) + ;I '+BMXFL D ERROUT^BMXRPC("File number not provided.",1) Q +"RTN","BMXRPC2",22,0) + ;---> If file number not provided check for file name. +"RTN","BMXRPC2",23,0) + I +BMXFL'=BMXFL D +"RTN","BMXRPC2",24,0) + . S BMXFL=$TR(BMXFL,"_"," ") +"RTN","BMXRPC2",25,0) + . I '$D(^DIC("B",BMXFL)) S BMXFL="" Q +"RTN","BMXRPC2",26,0) + . S BMXFL=$O(^DIC("B",BMXFL,0)) +"RTN","BMXRPC2",27,0) + I '$G(BMXFL) D ERROUT^BMXRPC("File number not provided.",1) Q +"RTN","BMXRPC2",28,0) + ; +"RTN","BMXRPC2",29,0) + ;---> If no such file, return error. +"RTN","BMXRPC2",30,0) + I '$D(^DD(BMXFL,0)) D ERROUT^BMXRPC("File does not exist.",1) Q +"RTN","BMXRPC2",31,0) + ; +"RTN","BMXRPC2",32,0) + ;---> Validate screen code +"RTN","BMXRPC2",33,0) + I $G(BMXSCR)="" S BMXSCR="I 1" +"RTN","BMXRPC2",34,0) + S X=$G(BMXSCR) +"RTN","BMXRPC2",35,0) + I X]"" D ^DIM +"RTN","BMXRPC2",36,0) + I '$D(X) S BMXSCR="I 1" ;Default to no screen +"RTN","BMXRPC2",37,0) + ; +"RTN","BMXRPC2",38,0) + ;---> Set Target Global for output and errors. +"RTN","BMXRPC2",39,0) + S BMXG="BMXTMP($J,""DID"")" +"RTN","BMXRPC2",40,0) + ; +"RTN","BMXRPC2",41,0) + ;---> Loop through ^DD(FileNumber,FieldNumber,0) to get field names +"RTN","BMXRPC2",42,0) + K BMXTMP($J) +"RTN","BMXRPC2",43,0) + I $G(BMXATTR)="" S BMXATTR="LABEL" ;Changed from NAME to LABEL +"RTN","BMXRPC2",44,0) + ;---> Attribute Names +"RTN","BMXRPC2",45,0) + F I=1:1:$L(BMXATTR,";") S BMXT($P(BMXATTR,";",I))="" +"RTN","BMXRPC2",46,0) + S (BMX,BMXC)=0 F S BMX=$O(BMXT(BMX)) Q:BMX="" D +"RTN","BMXRPC2",47,0) + . S BMXC=BMXC+1 +"RTN","BMXRPC2",48,0) + . S $P(BMXT,U,BMXC)="T00030"_BMX +"RTN","BMXRPC2",49,0) + S BMXTMP($J,1)="T00030NUMBER"_U_BMXT_$C(30) +"RTN","BMXRPC2",50,0) + ; +"RTN","BMXRPC2",51,0) + ;S BMXFLD=0 F I=2:1 S BMXFLD=$O(^DD(BMXFL,BMXFLD)) Q:'+BMXFLD D +"RTN","BMXRPC2",52,0) + S BMXTMP($J,2)=".001^BMXIEN"_$C(30) +"RTN","BMXRPC2",53,0) + S BMXFLDN=0 F I=3:1 S BMXFLDN=$O(^DD(BMXFL,"B",BMXFLDN)) Q:BMXFLDN="" D +"RTN","BMXRPC2",54,0) + . S BMXFLD=$O(^DD(BMXFL,"B",BMXFLDN,0)) Q:'+BMXFLD +"RTN","BMXRPC2",55,0) + . X BMXSCR Q:'$T +"RTN","BMXRPC2",56,0) + . D FIELD^DID(BMXFL,BMXFLD,,BMXATTR,BMXG,BMXG) +"RTN","BMXRPC2",57,0) + . K BMXT S (BMXC,BMX)=0 +"RTN","BMXRPC2",58,0) + . F S BMX=$O(BMXTMP($J,"DID",BMX)) Q:BMX="" D +"RTN","BMXRPC2",59,0) + . . S BMXC=BMXC+1 +"RTN","BMXRPC2",60,0) + . . S $P(BMXT,U,BMXC)=BMXTMP($J,"DID",BMX) +"RTN","BMXRPC2",61,0) + . S BMXTMP($J,I)=BMXFLD_U_$TR(BMXT," ","_")_$C(30) +"RTN","BMXRPC2",62,0) + ;S I=I+1,BMXTMP($J,I)=".001^BMXIEN"_$C(30) +"RTN","BMXRPC2",63,0) + S I=I+1 +"RTN","BMXRPC2",64,0) + K BMXTMP($J,"DID") +"RTN","BMXRPC2",65,0) + ;---> Tack on Error Delimiter and any error. +"RTN","BMXRPC2",66,0) + S BMXTMP($J,I)=BMX31_BMXERR +"RTN","BMXRPC2",67,0) + Q +"RTN","BMXRPC2",68,0) + ; +"RTN","BMXRPC2",69,0) +MLTLIST(BMXGBL,BMXFL,BMXONEOK) ;EP +"RTN","BMXRPC2",70,0) + ;Returns list of multiple fields in file BMXFL, returns only one field +"RTN","BMXRPC2",71,0) + ;if BMXONEOK is TRUE +"RTN","BMXRPC2",72,0) + ;S ^HW($H,"MLTLIST","FL")=BMXFL +"RTN","BMXRPC2",73,0) + ;S ^HW($H,"MLTLIST","ONE")=BMXONEOK +"RTN","BMXRPC2",74,0) + N BMX31,BMXERR,BMXG,BMXFLD,BMX,BMXC,BMXT,I +"RTN","BMXRPC2",75,0) + S BMX31=$C(31)_$C(31) +"RTN","BMXRPC2",76,0) + S BMXGBL="BMXTMP("_$J_")",BMXERR="",U="^" +"RTN","BMXRPC2",77,0) + K BMXTMP($J) +"RTN","BMXRPC2",78,0) + ; +"RTN","BMXRPC2",79,0) + ;---> If file number not provided check for file name. +"RTN","BMXRPC2",80,0) + I +BMXFL'=BMXFL D +"RTN","BMXRPC2",81,0) + . S BMXFL=$TR(BMXFL,"_"," ") +"RTN","BMXRPC2",82,0) + . I '$D(^DIC("B",BMXFL)) S BMXFL="" Q +"RTN","BMXRPC2",83,0) + . S BMXFL=$O(^DIC("B",BMXFL,0)) +"RTN","BMXRPC2",84,0) + I '$G(BMXFL) D ERROUT^BMXRPC("File number not provided.",1) Q +"RTN","BMXRPC2",85,0) + ; +"RTN","BMXRPC2",86,0) + ;---> If no such file, return error. +"RTN","BMXRPC2",87,0) + I '$D(^DD(BMXFL,0)) D ERROUT^BMXRPC("File does not exist.",1) Q +"RTN","BMXRPC2",88,0) + ; +"RTN","BMXRPC2",89,0) + ;---> Column Headers +"RTN","BMXRPC2",90,0) + S BMXTMP($J,1)="T00030NUMBER"_U_"T00030NAME"_$C(30) +"RTN","BMXRPC2",91,0) + ; +"RTN","BMXRPC2",92,0) + ;---> $O thru ^DD(BMXFL,"SB" to get subfile numbers and names +"RTN","BMXRPC2",93,0) + S I=2 +"RTN","BMXRPC2",94,0) + N BMXSB,BMXSBN,BMXSBF,BMXFOUND +"RTN","BMXRPC2",95,0) + S BMXFOUND=0 +"RTN","BMXRPC2",96,0) + I $D(^DD(BMXFL,"SB")) D +"RTN","BMXRPC2",97,0) + . S BMXSB=0 +"RTN","BMXRPC2",98,0) + . F S BMXSB=$O(^DD(BMXFL,"SB",BMXSB)) Q:'+BMXSB D I BMXFOUND Q:BMXONEOK=1 +"RTN","BMXRPC2",99,0) + . . S BMXSBF=$O(^DD(BMXFL,"SB",BMXSB,0)) +"RTN","BMXRPC2",100,0) + . . Q:'+BMXSBF +"RTN","BMXRPC2",101,0) + . . S BMXSBN=$G(^DD(BMXFL,BMXSBF,0)) +"RTN","BMXRPC2",102,0) + . . Q:BMXSBN="" +"RTN","BMXRPC2",103,0) + . . S BMXZ=$G(^DD(BMXSB,.01,0)) +"RTN","BMXRPC2",104,0) + . . Q:$P(BMXZ,U,2)["W" +"RTN","BMXRPC2",105,0) + . . S BMXFOUND=1 +"RTN","BMXRPC2",106,0) + . . S BMXSBN=$P(BMXSBN,U) +"RTN","BMXRPC2",107,0) + . . S BMXTMP($J,I)=BMXSB_U_BMXSBN_$C(30) +"RTN","BMXRPC2",108,0) + . . S I=I+1 +"RTN","BMXRPC2",109,0) + ; +"RTN","BMXRPC2",110,0) + ;---> Tack on Error Delimiter and any error. +"RTN","BMXRPC2",111,0) + S BMXTMP($J,I)=BMX31_BMXERR +"RTN","BMXRPC2",112,0) + Q +"RTN","BMXRPC3") +0^90^B39843476 +"RTN","BMXRPC3",1,0) +BMXRPC3 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; ; 8/30/10 2:56pm +"RTN","BMXRPC3",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXRPC3",3,0) + ;Mods by WV/SMH +"RTN","BMXRPC3",4,0) + ;7/26/09 Removed references to ^AUTTSITE, an IHS file in GETFAC* +"RTN","BMXRPC3",5,0) + ;8/30/10 Changed GETFCRS to return a better list of user divisions +"RTN","BMXRPC3",6,0) + ; - Checks to see if there are any divisions +"RTN","BMXRPC3",7,0) + ; +"RTN","BMXRPC3",8,0) +VARVAL(RESULT,VARIABLE) ;returns value of passed in variable +"RTN","BMXRPC3",9,0) + S VARIABLE=$TR(VARIABLE,"~","^") +"RTN","BMXRPC3",10,0) + S RESULT=VARIABLE ;can do this with the REFERENCE type parameter +"RTN","BMXRPC3",11,0) + Q +"RTN","BMXRPC3",12,0) + ;See GETV^XWBBRK for how we get the REFERENCE type parameter +"RTN","BMXRPC3",13,0) + ; +"RTN","BMXRPC3",14,0) +USER(RESULT,D) ; +"RTN","BMXRPC3",15,0) + ; +"RTN","BMXRPC3",16,0) + I '+D S RESULT="" Q +"RTN","BMXRPC3",17,0) + S RESULT=$P($G(^VA(200,D,0)),"^") +"RTN","BMXRPC3",18,0) + Q +"RTN","BMXRPC3",19,0) + ; +"RTN","BMXRPC3",20,0) +NTUSER(BMXY,BMXNTUSER) ;EP +"RTN","BMXRPC3",21,0) + ;Old code. Retain for reference +"RTN","BMXRPC3",22,0) + ;Returns NTDomain^NTUserName^RPMSName for user having DUZ=D +"RTN","BMXRPC3",23,0) + ;TODO: Move ANMC NT USERS file +"RTN","BMXRPC3",24,0) + ;from AZZWNT to BMX namespace and numberspace +"RTN","BMXRPC3",25,0) + ; +"RTN","BMXRPC3",26,0) + ;N BMX,BMXNOD,BMXDOM,BMXNAM,BMXCOL,BMXRNAM +"RTN","BMXRPC3",27,0) + ;S (BMXDOM,BMXNAM,BMXRNAM)="" +"RTN","BMXRPC3",28,0) + ;S U="^" +"RTN","BMXRPC3",29,0) + ;I '+D S RESULT="" Q +"RTN","BMXRPC3",30,0) + ;S BMXRNAM=$G(^VA(200,D,0)),BMXRNAM=$P(BMXRNAM,U) +"RTN","BMXRPC3",31,0) + ;I '$D(^AZZWNT("DUZ",D)) D NTU1 Q +"RTN","BMXRPC3",32,0) + ;S BMX=$O(^AZZWNT("DUZ",D,0)) +"RTN","BMXRPC3",33,0) + ;I '+BMX D NTU1 Q +"RTN","BMXRPC3",34,0) + ;I '$D(^AZZWNT(BMX,0)) D NTU1 Q +"RTN","BMXRPC3",35,0) + ;S BMXNOD=^AZZWNT(BMX,0) +"RTN","BMXRPC3",36,0) + ;S BMXDOM=$P(BMXNOD,U,2) +"RTN","BMXRPC3",37,0) + ;S BMXNAM=$P(BMXNOD,U) ;,4) +"RTN","BMXRPC3",38,0) + ;D NTU1 +"RTN","BMXRPC3",39,0) + Q +"RTN","BMXRPC3",40,0) + ; +"RTN","BMXRPC3",41,0) + ; +"RTN","BMXRPC3",42,0) +NTUGETD(BMXY,BMXNTNAME) ;EP +"RTN","BMXRPC3",43,0) + ;Entry point for debugging +"RTN","BMXRPC3",44,0) + ; +"RTN","BMXRPC3",45,0) + D DEBUG^%Serenji("NTUGET^BMXRPC3(.BMXY,BMXNTNAME)") +"RTN","BMXRPC3",46,0) + Q +"RTN","BMXRPC3",47,0) + ; +"RTN","BMXRPC3",48,0) +NTUGET(BMXY,BMXNTNAME) ;EP +"RTN","BMXRPC3",49,0) + ; +"RTN","BMXRPC3",50,0) + ;Returns A ENCRYPTED and V ENCRYPTED for NT User BMXNTNAME +"RTN","BMXRPC3",51,0) + ;Called by RPC BMXNetGetCodes +"RTN","BMXRPC3",52,0) + N BMXI,BMXNTID,BMXNTID,BMXNOD,BMXA,BMXV +"RTN","BMXRPC3",53,0) + S BMXI=0 +"RTN","BMXRPC3",54,0) + S BMXY="^BMXTMP("_$J_")" +"RTN","BMXRPC3",55,0) + S X="NTUET^BMXRPC3",@^%ZOSF("TRAP") +"RTN","BMXRPC3",56,0) + S BMXI=BMXI+1 +"RTN","BMXRPC3",57,0) + I BMXNTNAME="" S ^BMXTMP($J,BMXI)="^" Q +"RTN","BMXRPC3",58,0) + S BMXNTID=$O(^BMXUSER("B",BMXNTNAME,0)) +"RTN","BMXRPC3",59,0) + I '+BMXNTID S ^BMXTMP($J,BMXI)="^" Q +"RTN","BMXRPC3",60,0) + S BMXNOD=$G(^BMXUSER(BMXNTID,0)) +"RTN","BMXRPC3",61,0) + S BMXA=$P(BMXNOD,U,2) +"RTN","BMXRPC3",62,0) + S BMXV=$P(BMXNOD,U,3) +"RTN","BMXRPC3",63,0) + S ^BMXTMP($J,BMXI)=BMXA_"^"_BMXV_"^" +"RTN","BMXRPC3",64,0) + Q +"RTN","BMXRPC3",65,0) + ; +"RTN","BMXRPC3",66,0) +WINUGET(BMXWINID) ;EP +"RTN","BMXRPC3",67,0) + ;Returns DUZ for user having Windows Identity BMXWINID +"RTN","BMXRPC3",68,0) + ;Returns 0 if no Windows user found +"RTN","BMXRPC3",69,0) + ; +"RTN","BMXRPC3",70,0) + N BMXIEN,BMXNOD,BMXDUZ +"RTN","BMXRPC3",71,0) + I BMXWINID="" Q 0 +"RTN","BMXRPC3",72,0) + S BMXIEN=$O(^BMXUSER("B",BMXWINID,0)) +"RTN","BMXRPC3",73,0) + I '+BMXIEN Q 0 +"RTN","BMXRPC3",74,0) + S BMXNOD=$G(^BMXUSER(BMXIEN,0)) +"RTN","BMXRPC3",75,0) + S BMXDUZ=$P(BMXNOD,U,2) +"RTN","BMXRPC3",76,0) + Q BMXDUZ +"RTN","BMXRPC3",77,0) + ; +"RTN","BMXRPC3",78,0) +NTUSETD(BMXY,BMXNTNAME) ;EP +"RTN","BMXRPC3",79,0) + ;Entry point for debugging +"RTN","BMXRPC3",80,0) + ; +"RTN","BMXRPC3",81,0) + D DEBUG^%Serenji("NTUSET^BMXRPC3(.BMXY,BMXNTNAME)") +"RTN","BMXRPC3",82,0) + Q +"RTN","BMXRPC3",83,0) + ; +"RTN","BMXRPC3",84,0) +NTUSET(BMXY,BMXNTNAME) ;EP +"RTN","BMXRPC3",85,0) + ;Sets NEW PERSON map entry for Windows Identity BMXNTNAME +"RTN","BMXRPC3",86,0) + ;Returns ERRORID 0 if all ok +"RTN","BMXRPC3",87,0) + ;Called by RPC BMXNetSetUser +"RTN","BMXRPC3",88,0) + ; +"RTN","BMXRPC3",89,0) + ; +"RTN","BMXRPC3",90,0) + N BMXI,BMXNTID,BMXFDA,BMXF,BMXIEN,BMXMSG,BMXAPPTID +"RTN","BMXRPC3",91,0) + S BMXI=0 +"RTN","BMXRPC3",92,0) + S BMXY="^BMXTMP("_$J_")" +"RTN","BMXRPC3",93,0) + S X="NTUET^BMXRPC3",@^%ZOSF("TRAP") +"RTN","BMXRPC3",94,0) + S BMXI=BMXI+1 +"RTN","BMXRPC3",95,0) + ; Quit with error if no DUZ exists +"RTN","BMXRPC3",96,0) + I '+$G(DUZ) D NTUERR(BMXI,500) Q +"RTN","BMXRPC3",97,0) + ; Create entry or file in existing entry in BMX USER +"RTN","BMXRPC3",98,0) + I $D(^BMXUSER("B",BMXNTNAME)) S BMXF="?1," +"RTN","BMXRPC3",99,0) + E S BMXF="+1," +"RTN","BMXRPC3",100,0) + S BMXFDA(90093.1,BMXF,.01)=BMXNTNAME +"RTN","BMXRPC3",101,0) + S BMXFDA(90093.1,BMXF,.02)=$G(DUZ) +"RTN","BMXRPC3",102,0) + K BMXIEN,BMXMSG +"RTN","BMXRPC3",103,0) + D UPDATE^DIE("","BMXFDA","BMXIEN","BMXMSG") +"RTN","BMXRPC3",104,0) + S BMXAPPTID=+$G(BMXIEN(1)) +"RTN","BMXRPC3",105,0) + S BMXI=BMXI+1 +"RTN","BMXRPC3",106,0) + S ^BMXTMP($J,BMXI)=BMXAPPTID_"^0" +"RTN","BMXRPC3",107,0) + Q +"RTN","BMXRPC3",108,0) + ; +"RTN","BMXRPC3",109,0) +NTUET ;EP +"RTN","BMXRPC3",110,0) + ;Error trap from REGEVNT +"RTN","BMXRPC3",111,0) + ; +"RTN","BMXRPC3",112,0) + I '$D(BMXI) N BMXI S BMXI=999 +"RTN","BMXRPC3",113,0) + S BMXI=BMXI+1 +"RTN","BMXRPC3",114,0) + D NTUERR(BMXI,99) +"RTN","BMXRPC3",115,0) + Q +"RTN","BMXRPC3",116,0) + ; +"RTN","BMXRPC3",117,0) +NTUERR(BMXI,BMXERID) ;Error processing +"RTN","BMXRPC3",118,0) + S BMXI=BMXI+1 +"RTN","BMXRPC3",119,0) + S ^BMXTMP($J,BMXI)="^"_BMXERID +"RTN","BMXRPC3",120,0) + Q +"RTN","BMXRPC3",121,0) + ; +"RTN","BMXRPC3",122,0) + ; +"RTN","BMXRPC3",123,0) +NTU1 ;S BMXCOL="T00030NT_DOMAIN^T00030NT_USERNAME^T00030RPMS_USERNAME"_$C(30) +"RTN","BMXRPC3",124,0) + ;S RESULT=BMXCOL_BMXDOM_U_BMXNAM_U_BMXRNAM_$C(30)_$C(31) +"RTN","BMXRPC3",125,0) + Q +"RTN","BMXRPC3",126,0) + ; +"RTN","BMXRPC3",127,0) +GETFC(BMXFACS,DUZ) ;Gets all facilities for a user +"RTN","BMXRPC3",128,0) + ; Input DUZ - user IEN from the NEW PERSON FILE +"RTN","BMXRPC3",129,0) + ; Output - Number of facilities;facility1 name&facility1 IEN;...facilityN&facilityN IEN +"RTN","BMXRPC3",130,0) + N BMXFN,BMXN +"RTN","BMXRPC3",131,0) + S BMXFN=0,BMXFACS="" +"RTN","BMXRPC3",132,0) + F BMXN=1:1 S BMXFN=$O(^VA(200,DUZ,2,BMXFN)) Q:BMXFN="" D +"RTN","BMXRPC3",133,0) + . S:BMXN>1 BMXFACS=BMXFACS_";" S BMXFACS=BMXFACS_$P(^DIC(4,BMXFN,0),U,1)_"&"_BMXFN +"RTN","BMXRPC3",134,0) + ;//smh I BMXN=1 S BMXFN=$P(^AUTTSITE(1,0),U,1) D +"RTN","BMXRPC3",135,0) + ;//smh . S BMXFACS=BMXFACS_$P(^DIC(4,BMXFN,0),U,1)_"&"_BMXFN +"RTN","BMXRPC3",136,0) + S BMXFACS=BMXN-(BMXN>1)_";"_BMXFACS +"RTN","BMXRPC3",137,0) + Q +"RTN","BMXRPC3",138,0) + ; +"RTN","BMXRPC3",139,0) +GETFCRS(BMXY,BMXDUZ) ;Gets all facilities for a user - returns RECORDSET +"RTN","BMXRPC3",140,0) + ;/mods by //smh for WV +"RTN","BMXRPC3",141,0) + N $ET S $ET="G ERFC^BMXRPC3" +"RTN","BMXRPC3",142,0) + N BMXFN ; Facility Number +"RTN","BMXRPC3",143,0) + S BMXDUZ=$TR(BMXDUZ,$C(13)) ; Strip CR,LF,tab +"RTN","BMXRPC3",144,0) + S BMXDUZ=$TR(BMXDUZ,$C(10)) +"RTN","BMXRPC3",145,0) + S BMXDUZ=$TR(BMXDUZ,$C(9)) +"RTN","BMXRPC3",146,0) + S BMXY="T00030FACILITY_NAME^T00030FACILITY_IEN^T00002DEFAULT"_$C(30) +"RTN","BMXRPC3",147,0) + S BMXFN=0 +"RTN","BMXRPC3",148,0) + F S BMXFN=$O(^VA(200,BMXDUZ,2,BMXFN)) Q:'BMXFN D +"RTN","BMXRPC3",149,0) + . ; DD for ^VA(200,DUZ,2,DUZ(2)) is DUZ(2)^default. DUZ(2) is dinummed. +"RTN","BMXRPC3",150,0) + . S BMXY=BMXY_$P(^DIC(4,BMXFN,0),U,1)_U_^VA(200,BMXDUZ,2,BMXFN,0)_$C(30) +"RTN","BMXRPC3",151,0) + ; Crazy line: if we have no results, then use kernel's DUZ(2) set +"RTN","BMXRPC3",152,0) + ; during sign-on +"RTN","BMXRPC3",153,0) + I $L(BMXY,$C(30))<3 S BMXY=BMXY_$P(^DIC(4,DUZ(2),0),U,1)_U_DUZ(2)_$C(30) +"RTN","BMXRPC3",154,0) + S BMXY=BMXY_$C(31) +"RTN","BMXRPC3",155,0) + Q +"RTN","BMXRPC3",156,0) + ; +"RTN","BMXRPC3",157,0) +SETFCRS(BMXY,BMXFAC) ; +"RTN","BMXRPC3",158,0) + ; +"RTN","BMXRPC3",159,0) + ;Sets DUZ(2) to value in BMXFAC +"RTN","BMXRPC3",160,0) + ;Fails if BMXFAC is not one of the current user's divisions +"RTN","BMXRPC3",161,0) + ;Returns Recordset +"RTN","BMXRPC3",162,0) + ; +"RTN","BMXRPC3",163,0) + S X="ERFC^BMXRPC3",@^%ZOSF("TRAP") +"RTN","BMXRPC3",164,0) + S BMXY="T00030DUZ^T00030FACILITY_IEN^T00030FACILITY_NAME"_$C(30) +"RTN","BMXRPC3",165,0) + N BMXSUB,BMXFACN +"RTN","BMXRPC3",166,0) + I '+DUZ S BMXY=BMXY_0_"^"_0_"^"_0_$C(30)_$C(31) Q +"RTN","BMXRPC3",167,0) + I '+BMXFAC S BMXY=BMXY_DUZ_"^"_0_"^"_0_$C(30)_$C(31) Q +"RTN","BMXRPC3",168,0) + ; //SMH Line below is incorrect. Facility valid if not in user profile +"RTN","BMXRPC3",169,0) + ; if it is default kernel facility +"RTN","BMXRPC3",170,0) + ; I '$D(^VA(200,DUZ,2,+BMXFAC)) S BMXY=BMXY_DUZ_"^"_0_"^"_0_$C(30)_$C(31) Q +"RTN","BMXRPC3",171,0) + S DUZ(2)=BMXFAC ;IHS/OIT/HMW SAC Exemption Applied For +"RTN","BMXRPC3",172,0) + S BMXFACN=$G(^DIC(4,+DUZ(2),0)) +"RTN","BMXRPC3",173,0) + S BMXFACN=$P(BMXFACN,"^") +"RTN","BMXRPC3",174,0) + S BMXSUB="^VA(200,"_DUZ_",2," +"RTN","BMXRPC3",175,0) + S ^DISV(DUZ,BMXSUB)=BMXFAC +"RTN","BMXRPC3",176,0) + S BMXY=BMXY_DUZ_"^"_BMXFAC_"^"_BMXFACN_$C(30)_$C(31) +"RTN","BMXRPC3",177,0) + Q +"RTN","BMXRPC3",178,0) + ; +"RTN","BMXRPC3",179,0) +ERFC ; +"RTN","BMXRPC3",180,0) + D ^%ZTER +"RTN","BMXRPC3",181,0) + S BMXY=$G(BMXY)_0_"^"_0_$C(30)_$C(31) Q +"RTN","BMXRPC3",182,0) + Q +"RTN","BMXRPC3",183,0) + ; +"RTN","BMXRPC3",184,0) +SETFC(BMXY,BMXFAC) ; +"RTN","BMXRPC3",185,0) + ;Sets DUZ(2) to value in BMXFAC +"RTN","BMXRPC3",186,0) + ;Fails if BMXFAC is not one of the current user's divisions +"RTN","BMXRPC3",187,0) + ;Returns 1 if successful, 0 if failed +"RTN","BMXRPC3",188,0) + ; +"RTN","BMXRPC3",189,0) + S BMXY=0 +"RTN","BMXRPC3",190,0) + N BMXSUB +"RTN","BMXRPC3",191,0) + I '+DUZ S BMXY=0 Q +"RTN","BMXRPC3",192,0) + I '+BMXFAC S BMXY=0 Q +"RTN","BMXRPC3",193,0) + I '$D(^VA(200,DUZ,2,+BMXFAC)) S BMXY=0 Q +"RTN","BMXRPC3",194,0) + S DUZ(2)=BMXFAC ;IHS/OIT/HMW SAC Exemption Applied For +"RTN","BMXRPC3",195,0) + S BMXSUB="^VA(200,"_DUZ_",2," +"RTN","BMXRPC3",196,0) + S ^DISV(DUZ,BMXSUB)=BMXFAC +"RTN","BMXRPC3",197,0) + S BMXY=1 +"RTN","BMXRPC3",198,0) + Q +"RTN","BMXRPC3",199,0) + ; +"RTN","BMXRPC3",200,0) +APSEC(BMXY,BMXKEY) ;EP +"RTN","BMXRPC3",201,0) + ;Return IHSCD_SUCCEEDED (-1) if user has key BMXKEY +"RTN","BMXRPC3",202,0) + ;OR if user has key XUPROGMODE +"RTN","BMXRPC3",203,0) + ;Otherwise, returns IHSCD_FAILED (0) +"RTN","BMXRPC3",204,0) + N BMXIEN,BMXPROG,BMXPKEY +"RTN","BMXRPC3",205,0) + I '$G(DUZ) S BMXY=0 Q +"RTN","BMXRPC3",206,0) + I BMXKEY="" S BMXY=0 Q +"RTN","BMXRPC3",207,0) + ; +"RTN","BMXRPC3",208,0) + ;Test for programmer mode key +"RTN","BMXRPC3",209,0) + S BMXPROG=0 +"RTN","BMXRPC3",210,0) + I $D(^DIC(19.1,"B","XUPROGMODE")) D +"RTN","BMXRPC3",211,0) + . S BMXPKEY=$O(^DIC(19.1,"B","XUPROGMODE",0)) +"RTN","BMXRPC3",212,0) + . I '+BMXPKEY Q +"RTN","BMXRPC3",213,0) + . I '$D(^VA(200,DUZ,51,BMXPKEY,0)) Q +"RTN","BMXRPC3",214,0) + . S BMXPROG=1 +"RTN","BMXRPC3",215,0) + I BMXPROG S BMXY=-1 Q +"RTN","BMXRPC3",216,0) + ; +"RTN","BMXRPC3",217,0) + I '$D(^DIC(19.1,"B",BMXKEY)) S BMXY=0 Q +"RTN","BMXRPC3",218,0) + S BMXIEN=$O(^DIC(19.1,"B",BMXKEY,0)) +"RTN","BMXRPC3",219,0) + I '+BMXIEN S BMXY=0 Q +"RTN","BMXRPC3",220,0) + I '$D(^VA(200,DUZ,51,BMXIEN,0)) S BMXY=0 Q +"RTN","BMXRPC3",221,0) + S BMXY=-1 +"RTN","BMXRPC3",222,0) + Q +"RTN","BMXRPC3",223,0) + ; +"RTN","BMXRPC3",224,0) +SIGCHK(BMXY,BMXSIG) ;EP +"RTN","BMXRPC3",225,0) + ;Checks BMXSIG against hashed value in NEW PERSON +"RTN","BMXRPC3",226,0) + ;Return IHSCD_SUCCEEDED (-1) if BMXSIG matches +"RTN","BMXRPC3",227,0) + ;Otherwise, returns IHSCD_FAILED (0) +"RTN","BMXRPC3",228,0) + N X +"RTN","BMXRPC3",229,0) + S BMXY=0 +"RTN","BMXRPC3",230,0) + I '$G(DUZ) Q +"RTN","BMXRPC3",231,0) + I '$D(^VA(200,DUZ,20)) Q ;TODO What if no signature? +"RTN","BMXRPC3",232,0) + S BMXHSH=$P(^VA(200,DUZ,20),U,4) +"RTN","BMXRPC3",233,0) + S X=$G(BMXSIG) +"RTN","BMXRPC3",234,0) + D HASH^XUSHSHP +"RTN","BMXRPC3",235,0) + I X=BMXHSH S BMXY=-1 +"RTN","BMXRPC3",236,0) + Q +"RTN","BMXRPC4") +0^91^B28124037 +"RTN","BMXRPC4",1,0) +BMXRPC4 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; +"RTN","BMXRPC4",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXRPC4",3,0) + ; +"RTN","BMXRPC4",4,0) +PTINFORS(BMXY,BMXIEN) ;EP Patient Info Recordset +"RTN","BMXRPC4",5,0) + ; +"RTN","BMXRPC4",6,0) + N BMXDPT,BMXZ,BMXDLIM,BMXXX,BMXRET,BMXAGE,BMXNEXT,BMXSEX,BMXERR,BMXHRN +"RTN","BMXRPC4",7,0) + S BMXDLIM="^",BMXERR="" +"RTN","BMXRPC4",8,0) + S BMXRET="T00030NAME^T00030HRN^T00030SSN^D00030DOB^T00030IEN^T00020AGE^T00080NEXT_APPT^T00010SEX"_$C(30) +"RTN","BMXRPC4",9,0) + I '$D(DUZ(2)) S BMXY=BMXRET_$C(31)_"No DUZ2" Q +"RTN","BMXRPC4",10,0) + I +$G(DUZ) D +"RTN","BMXRPC4",11,0) + . S ^DISV(DUZ,"^AUPNPAT(")=BMXIEN +"RTN","BMXRPC4",12,0) + . S ^DISV(DUZ,"^DPT(")=BMXIEN +"RTN","BMXRPC4",13,0) + I '$D(^DPT(BMXIEN)) S BMXY=BMXRET_$C(31)_"No such patient" Q +"RTN","BMXRPC4",14,0) + S BMXDPT=$G(^DPT(BMXIEN,0)) +"RTN","BMXRPC4",15,0) + S BMXZ=$P(BMXDPT,U) ;NAME +"RTN","BMXRPC4",16,0) + ;S $P(BMXZ,BMXDLIM,2)=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART +"RTN","BMXRPC4",17,0) + S BMXHRN=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART +"RTN","BMXRPC4",18,0) + ;I BMXHRN="" Q ;NO CHART AT THIS DUZ2 +"RTN","BMXRPC4",19,0) + I $P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,3) S BMXHRN=BMXHRN_"(*)" +"RTN","BMXRPC4",20,0) + S $P(BMXZ,BMXDLIM,2)=BMXHRN +"RTN","BMXRPC4",21,0) + ; +"RTN","BMXRPC4",22,0) + S $P(BMXZ,BMXDLIM,3)=$P(BMXDPT,U,9) ;SSN +"RTN","BMXRPC4",23,0) + S Y=$P(BMXDPT,U,3) X ^DD("DD") +"RTN","BMXRPC4",24,0) + S $P(BMXZ,BMXDLIM,4)=Y ;DOB +"RTN","BMXRPC4",25,0) + S $P(BMXZ,BMXDLIM,5)=BMXIEN +"RTN","BMXRPC4",26,0) + S BMXAGE=$$AGEF^BMXUTL1(BMXIEN) +"RTN","BMXRPC4",27,0) + S $P(BMXZ,BMXDLIM,6)=BMXAGE +"RTN","BMXRPC4",28,0) + S BMXNEXT=$$NEXTAPPT^BMXUTL2(BMXIEN) +"RTN","BMXRPC4",29,0) + S $P(BMXZ,BMXDLIM,7)=BMXNEXT +"RTN","BMXRPC4",30,0) + S BMXSEX=$$SEXW^BMXUTL1(BMXIEN) +"RTN","BMXRPC4",31,0) + S $P(BMXZ,BMXDLIM,8)=BMXSEX +"RTN","BMXRPC4",32,0) + S BMXRET=BMXRET_BMXZ +"RTN","BMXRPC4",33,0) + S BMXY=BMXRET_$C(30)_$C(31)_BMXERR +"RTN","BMXRPC4",34,0) + Q +"RTN","BMXRPC4",35,0) + ; +"RTN","BMXRPC4",36,0) +PTLOOKRS(BMXY,BMXP,BMXC) ;EP Patient Lookup +"RTN","BMXRPC4",37,0) + ; +"RTN","BMXRPC4",38,0) + ;Find up to BMXC patients matching BMXP* +"RTN","BMXRPC4",39,0) + ;Supports DOB Lookup, SSN Lookup +"RTN","BMXRPC4",40,0) + ; +"RTN","BMXRPC4",41,0) + ;S ^HW("PTLOOK","INPUT")=BMXP +"RTN","BMXRPC4",42,0) + ;S ^HW("PTLOOK","DUZ2")=$G(DUZ(2)) +"RTN","BMXRPC4",43,0) + S BMXP=$TR(BMXP,$C(13),"") +"RTN","BMXRPC4",44,0) + S BMXP=$TR(BMXP,$C(10),"") +"RTN","BMXRPC4",45,0) + S BMXP=$TR(BMXP,$C(9),"") +"RTN","BMXRPC4",46,0) + S:BMXC="" BMXC=10 +"RTN","BMXRPC4",47,0) + N BMXHRN,BMXZ,BMXDLIM,BMXRET +"RTN","BMXRPC4",48,0) + S BMXDLIM="^" +"RTN","BMXRPC4",49,0) + S BMXRET="T00030NAME^T00030HRN^T00030SSN^D00030DOB^T00030IEN"_$C(30) +"RTN","BMXRPC4",50,0) + I '+$G(DUZ) S BMXY=BMXRET_$C(31) Q +"RTN","BMXRPC4",51,0) + I '$D(DUZ(2)) S BMXY=BMXRET_$C(31) Q +"RTN","BMXRPC4",52,0) +DOB ;DOB Lookup +"RTN","BMXRPC4",53,0) + I +DUZ(2),((BMXP?1.2N1"/"1.2N1"/"1.4N)!(BMXP?1.2N1" "1.2N1" "1.4N)!(BMXP?1.2N1"-"1.2N1"-"1.4N)) D S BMXY=BMXRET_$C(31) Q +"RTN","BMXRPC4",54,0) + . S X=BMXP S %DT="P" D ^%DT S BMXP=Y Q:'+Y +"RTN","BMXRPC4",55,0) + . Q:'$D(^DPT("ADOB",BMXP)) +"RTN","BMXRPC4",56,0) + . S BMXIEN=0,BMXXX=1 F S BMXIEN=$O(^DPT("ADOB",BMXP,BMXIEN)) Q:'+BMXIEN D +"RTN","BMXRPC4",57,0) + . . Q:'$D(^DPT(BMXIEN,0)) +"RTN","BMXRPC4",58,0) + . . S BMXDPT=$G(^DPT(BMXIEN,0)) +"RTN","BMXRPC4",59,0) + . . S BMXZ=$P(BMXDPT,U) ;NAME +"RTN","BMXRPC4",60,0) + . . ;S $P(BMXZ,BMXDLIM,2)=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART +"RTN","BMXRPC4",61,0) + . . S BMXHRN=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART +"RTN","BMXRPC4",62,0) + . . I BMXHRN="" Q ;NO CHART AT THIS DUZ2 +"RTN","BMXRPC4",63,0) + . . I $P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,3) S BMXHRN=BMXHRN_"(*)" +"RTN","BMXRPC4",64,0) + . . S $P(BMXZ,BMXDLIM,2)=BMXHRN +"RTN","BMXRPC4",65,0) + . . ; +"RTN","BMXRPC4",66,0) + . . S $P(BMXZ,BMXDLIM,3)=$P(BMXDPT,U,9) ;SSN +"RTN","BMXRPC4",67,0) + . . S Y=$P(BMXDPT,U,3) X ^DD("DD") +"RTN","BMXRPC4",68,0) + . . S $P(BMXZ,BMXDLIM,4)=Y ;DOB +"RTN","BMXRPC4",69,0) + . . S $P(BMXZ,BMXDLIM,5)=BMXIEN +"RTN","BMXRPC4",70,0) + . . S BMXXX=BMXXX+1 +"RTN","BMXRPC4",71,0) + . . ;S $P(BMXRET,$C(30),BMXXX)=BMXZ +"RTN","BMXRPC4",72,0) + . . S BMXRET=BMXRET_BMXZ_$C(30) +"RTN","BMXRPC4",73,0) + . . Q +"RTN","BMXRPC4",74,0) + . Q +"RTN","BMXRPC4",75,0) + ; +"RTN","BMXRPC4",76,0) + ;Chart# Lookup +"RTN","BMXRPC4",77,0) + I +DUZ(2),BMXP]"",$D(^AUPNPAT("D",BMXP)) D S BMXY=BMXRET_$C(30)_$C(31) Q +"RTN","BMXRPC4",78,0) + . S BMXIEN=0 F S BMXIEN=$O(^AUPNPAT("D",BMXP,BMXIEN)) Q:'+BMXIEN I $D(^AUPNPAT("D",BMXP,BMXIEN,DUZ(2))) D Q +"RTN","BMXRPC4",79,0) + . . Q:'$D(^DPT(BMXIEN,0)) +"RTN","BMXRPC4",80,0) + . . S BMXDPT=$G(^DPT(BMXIEN,0)) +"RTN","BMXRPC4",81,0) + . . S BMXZ=$P(BMXDPT,U) ;NAME +"RTN","BMXRPC4",82,0) + . . ;S $P(BMXZ,BMXDLIM,2)=BMXP ;CHART +"RTN","BMXRPC4",83,0) + . . S BMXHRN=BMXP ;CHART +"RTN","BMXRPC4",84,0) + . . I $D(^AUPNPAT(BMXIEN,41,DUZ(2),0)),$P(^(0),U,3) S BMXHRN=BMXHRN_"(*)" +"RTN","BMXRPC4",85,0) + . . S $P(BMXZ,BMXDLIM,2)=BMXHRN +"RTN","BMXRPC4",86,0) + . . S $P(BMXZ,BMXDLIM,3)=$P(BMXDPT,U,9) ;SSN +"RTN","BMXRPC4",87,0) + . . S Y=$P(BMXDPT,U,3) X ^DD("DD") +"RTN","BMXRPC4",88,0) + . . S $P(BMXZ,BMXDLIM,4)=Y ;DOB +"RTN","BMXRPC4",89,0) + . . S $P(BMXZ,BMXDLIM,5)=BMXIEN +"RTN","BMXRPC4",90,0) + . . S $P(BMXRET,$C(30),2)=BMXZ +"RTN","BMXRPC4",91,0) + . . Q +"RTN","BMXRPC4",92,0) + . Q +"RTN","BMXRPC4",93,0) + ; +"RTN","BMXRPC4",94,0) + ;SSN Lookup +"RTN","BMXRPC4",95,0) + I (BMXP?9N)!(BMXP?3N1"-"2N1"-"4N),$D(^DPT("SSN",BMXP)) D S BMXY=BMXRET_$C(30)_$C(31) Q +"RTN","BMXRPC4",96,0) + . S BMXIEN=0 F S BMXIEN=$O(^DPT("SSN",BMXP,BMXIEN)) Q:'+BMXIEN D Q +"RTN","BMXRPC4",97,0) + . . Q:'$D(^DPT(BMXIEN,0)) +"RTN","BMXRPC4",98,0) + . . S BMXDPT=$G(^DPT(BMXIEN,0)) +"RTN","BMXRPC4",99,0) + . . S BMXZ=$P(BMXDPT,U) ;NAME +"RTN","BMXRPC4",100,0) + . . S BMXHRN=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART +"RTN","BMXRPC4",101,0) + . . I BMXHRN="" Q ;NO CHART AT THIS DUZ2 +"RTN","BMXRPC4",102,0) + . . I $P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,3) S BMXHRN=BMXHRN_"(*)" +"RTN","BMXRPC4",103,0) + . . S $P(BMXZ,BMXDLIM,2)=BMXHRN +"RTN","BMXRPC4",104,0) + . . S $P(BMXZ,BMXDLIM,3)=$P(BMXDPT,U,9) ;SSN +"RTN","BMXRPC4",105,0) + . . S Y=$P(BMXDPT,U,3) X ^DD("DD") +"RTN","BMXRPC4",106,0) + . . S $P(BMXZ,BMXDLIM,4)=Y ;DOB +"RTN","BMXRPC4",107,0) + . . S $P(BMXZ,BMXDLIM,5)=BMXIEN +"RTN","BMXRPC4",108,0) + . . S $P(BMXRET,$C(30),2)=BMXZ +"RTN","BMXRPC4",109,0) + . . Q +"RTN","BMXRPC4",110,0) + . Q +"RTN","BMXRPC4",111,0) + ; +"RTN","BMXRPC4",112,0) + S BMXFILE=9000001 +"RTN","BMXRPC4",113,0) + S BMXIENS="" +"RTN","BMXRPC4",114,0) + S BMXFIELDS=".01" +"RTN","BMXRPC4",115,0) + S BMXFLAGS="M" +"RTN","BMXRPC4",116,0) + S BMXVALUE=BMXP +"RTN","BMXRPC4",117,0) + S BMXNUMBER=BMXC +"RTN","BMXRPC4",118,0) + S BMXINDEXES="" +"RTN","BMXRPC4",119,0) + S BMXSCREEN=$S(+DUZ(2):"I $D(^AUPNPAT(Y,41,DUZ(2),0))",1:"") +"RTN","BMXRPC4",120,0) + ;I BMXSCREEN]"" S DIC("S")=BMXSCREEN +"RTN","BMXRPC4",121,0) + ;S BMXSCREEN="I 0" +"RTN","BMXRPC4",122,0) + S BMXIDEN="" +"RTN","BMXRPC4",123,0) + S BMXTARG="BMXRSLT" +"RTN","BMXRPC4",124,0) + S BMXMSG="" +"RTN","BMXRPC4",125,0) + D FIND^DIC(BMXFILE,BMXIENS,BMXFIELDS,BMXFLAGS,BMXVALUE,BMXNUMBER,BMXINDEXES,BMXSCREEN,BMXIDEN,BMXTARG,BMXMSG) +"RTN","BMXRPC4",126,0) + ;S BMXRET="" +"RTN","BMXRPC4",127,0) + ;B +"RTN","BMXRPC4",128,0) + I '+$G(BMXRSLT("DILIST",0)) S BMXY=BMXRET_$C(31) Q +"RTN","BMXRPC4",129,0) + F BMXX=1:1:$P(BMXRSLT("DILIST",0),U) D +"RTN","BMXRPC4",130,0) + . ;B +"RTN","BMXRPC4",131,0) + . S BMXIEN=BMXRSLT("DILIST",2,BMXX) +"RTN","BMXRPC4",132,0) + . S BMXZ=BMXRSLT("DILIST","ID",BMXX,.01) ;NAME +"RTN","BMXRPC4",133,0) + . ;S $P(BMXZ,BMXDLIM,2)=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART +"RTN","BMXRPC4",134,0) + . S BMXHRN=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART +"RTN","BMXRPC4",135,0) + . I BMXHRN="" Q ;NO CHART AT THIS DUZ2 +"RTN","BMXRPC4",136,0) + . I $P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,3) S BMXHRN=BMXHRN_"(*)" +"RTN","BMXRPC4",137,0) + . S $P(BMXZ,BMXDLIM,2)=BMXHRN +"RTN","BMXRPC4",138,0) + . S BMXDPT=$G(^DPT(BMXIEN,0)) +"RTN","BMXRPC4",139,0) + . S $P(BMXZ,BMXDLIM,3)=$P(BMXDPT,U,9) ;SSN +"RTN","BMXRPC4",140,0) + . S Y=$P(BMXDPT,U,3) X ^DD("DD") +"RTN","BMXRPC4",141,0) + . S $P(BMXZ,BMXDLIM,4)=Y ;DOB +"RTN","BMXRPC4",142,0) + . S $P(BMXZ,BMXDLIM,5)=BMXIEN +"RTN","BMXRPC4",143,0) + . S $P(BMXRET,$C(30),BMXX+1)=BMXZ +"RTN","BMXRPC4",144,0) + . Q +"RTN","BMXRPC4",145,0) + ;K BMXRSLT +"RTN","BMXRPC4",146,0) + S BMXY=BMXRET_$C(30)_$C(31) +"RTN","BMXRPC4",147,0) + Q +"RTN","BMXRPC4",148,0) +ZZZ ; +"RTN","BMXRPC5") +0^92^B15030574 +"RTN","BMXRPC5",1,0) +BMXRPC5 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; +"RTN","BMXRPC5",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXRPC5",3,0) + ; +"RTN","BMXRPC5",4,0) + ;Stolen from Mike Remillard. If it doesn't work, it's his fault. +"RTN","BMXRPC5",5,0) +HS(BMXGBL,BMXDFN,BMXTYPE,BMXRDL,BMXFDL) ;EP +"RTN","BMXRPC5",6,0) + ;---> Return patient's Health Summary in global array, ^BMXTEMP($J,"HS" +"RTN","BMXRPC5",7,0) + ;---> Lines delimited by BMXRDL +"RTN","BMXRPC5",8,0) + ;---> File delimited by BMXFDL +"RTN","BMXRPC5",9,0) + ;---> Called by RPC: BMX HEALTH SUMMARY +"RTN","BMXRPC5",10,0) + ;---> Parameters: +"RTN","BMXRPC5",11,0) + ; 1 - BMXGBL (ret) Name of result global containing patient's +"RTN","BMXRPC5",12,0) + ; Health Summary, passed to Broker. +"RTN","BMXRPC5",13,0) + ; 2 - BMXDFN (req) DFN of patient. +"RTN","BMXRPC5",14,0) + ; +"RTN","BMXRPC5",15,0) + ;---> Delimiter to pass error with result to GUI. +"RTN","BMXRPC5",16,0) + N BMX30,BMX31,BMXERR,X +"RTN","BMXRPC5",17,0) + ;S BMX30=$C(30),BMX31=$C(31)_$C(31) +"RTN","BMXRPC5",18,0) + S BMX30=$G(BMXRDL) +"RTN","BMXRPC5",19,0) + I BMX30="" S BMX30=$C(13)_$C(10) +"RTN","BMXRPC5",20,0) + S BMX31=$G(BMXFDL) +"RTN","BMXRPC5",21,0) + S BMXGBL="^BMXTEMP("_$J_",""HS"")",BMXERR="" +"RTN","BMXRPC5",22,0) + K ^BMXTEMP($J,"HS") +"RTN","BMXRPC5",23,0) + ; +"RTN","BMXRPC5",24,0) + N BMXPATH +"RTN","BMXRPC5",25,0) + ;---> Should get path from a Site Parameter. For now, use MSM default. +"RTN","BMXRPC5",26,0) + S BMXPATH="/usr/spool/uucppublic/" +"RTN","BMXRPC5",27,0) + ;S BMXPATH="C:\MSM\" ;TODO: Change to site parameter +"RTN","BMXRPC5",28,0) + ;--->Flag to test whether running as broker job: +"RTN","BMXRPC5",29,0) + N BMXSOCK +"RTN","BMXRPC5",30,0) + S BMXSOCK=0 +"RTN","BMXRPC5",31,0) + ;I $I=56 S BMXSOCK=1 +"RTN","BMXRPC5",32,0) + ; +"RTN","BMXRPC5",33,0) + ;---> If DFN not supplied, set Error Code and quit. +"RTN","BMXRPC5",34,0) + I '$G(BMXDFN) D Q +"RTN","BMXRPC5",35,0) + . S BMXERR="No Patient DFN" S ^BMXTEMP($J,"HS",I)=BMX31_BMXERR +"RTN","BMXRPC5",36,0) + ; +"RTN","BMXRPC5",37,0) + ;---> If patient does not exist, set Error Code and quit. +"RTN","BMXRPC5",38,0) + I '$D(^AUPNPAT(BMXDFN,0)) D Q +"RTN","BMXRPC5",39,0) + . S BMXERR="Patient DFN does not exist" S ^BMXTEMP($J,"HS",I)=BMX31_BMXERR +"RTN","BMXRPC5",40,0) + ; +"RTN","BMXRPC5",41,0) + N APCHSPAT,APCHSTYP +"RTN","BMXRPC5",42,0) + S APCHSPAT=BMXDFN +"RTN","BMXRPC5",43,0) + S APCHSTYP=$G(BMXTYPE) +"RTN","BMXRPC5",44,0) + S:'+APCHSTYP APCHSTYP=7 +"RTN","BMXRPC5",45,0) + ;S APCHSTYP=9 +"RTN","BMXRPC5",46,0) + ;---> Doesn't work from Device 56. +"RTN","BMXRPC5",47,0) + ;D GUIR^XBLM("EN^APCHS","^TMP(""BMXHS"",$J,") +"RTN","BMXRPC5",48,0) + ; +"RTN","BMXRPC5",49,0) + ;---> Generate a host file name. +"RTN","BMXRPC5",50,0) + N BMXFN S BMXFN="XB"_$J +"RTN","BMXRPC5",51,0) + ; +"RTN","BMXRPC5",52,0) + D +"RTN","BMXRPC5",53,0) + .;---> Important to preserve IO variables for when $I returns to 56. +"RTN","BMXRPC5",54,0) + .N IO,IOBS,IOF,IOHG,IOM,ION,IOPAR,IOS,IOSL,IOST,IOT,IOUPAR,IOXY +"RTN","BMXRPC5",55,0) + .; +"RTN","BMXRPC5",56,0) + .;---> Open host file to receive legacy code display. +"RTN","BMXRPC5",57,0) + .S Y=$$OPEN^%ZISH(BMXPATH,BMXFN,"W") +"RTN","BMXRPC5",58,0) + .;O 51:(BMXPATH_BMXFN:"W") +"RTN","BMXRPC5",59,0) + .;S IO=51,IOST="P-OTHER80" +"RTN","BMXRPC5",60,0) + .;K ^HW("HS") +"RTN","BMXRPC5",61,0) + .;S ^HW("HS","IOST")=$G(IOST) +"RTN","BMXRPC5",62,0) + .;S ^HW("HS","IO")=$G(IO) +"RTN","BMXRPC5",63,0) + .; +"RTN","BMXRPC5",64,0) + .;---> Call to legacy code for Health Summary display. +"RTN","BMXRPC5",65,0) + .S IOSL=999,IOM=80 +"RTN","BMXRPC5",66,0) + .D EN^APCHS +"RTN","BMXRPC5",67,0) + .;---> Write End of File (EOF) marker. +"RTN","BMXRPC5",68,0) + .W $C(9) +"RTN","BMXRPC5",69,0) + .; +"RTN","BMXRPC5",70,0) + .;---> %ZISC doesn't close Device 51 when called from TCPIP socket? +"RTN","BMXRPC5",71,0) + .;D ^%ZISC +"RTN","BMXRPC5",72,0) + .;---> Buffer won't write out to file until the device is closed +"RTN","BMXRPC5",73,0) + .;---> or the buffer is flushed by some other command. +"RTN","BMXRPC5",74,0) + .;---> At this point, host file exists but has 0 bytes. +"RTN","BMXRPC5",75,0) + .;C 51 +"RTN","BMXRPC5",76,0) + .;---> Now host file contains legacy code display data. +"RTN","BMXRPC5",77,0) + .; +"RTN","BMXRPC5",78,0) + .;---> For some reason %ZISH cannot open the host file a second time. +"RTN","BMXRPC5",79,0) + .;S Y=$$OPEN^%ZISH(BMXPATH,BMXFN,"R") +"RTN","BMXRPC5",80,0) + .;O 51:(BMXPATH_BMXFN:"R") +"RTN","BMXRPC5",81,0) + .U 51 +"RTN","BMXRPC5",82,0) + .; +"RTN","BMXRPC5",83,0) + .;---> Read in the host file. +"RTN","BMXRPC5",84,0) + .D +"RTN","BMXRPC5",85,0) + ..;---> Stop reading Host File if line contains EOF $C(9). +"RTN","BMXRPC5",86,0) + ..;N I,Y F I=1:1 R Y Q:Y[$C(9) S ^TMP("BMXHS",$J,I)=Y +"RTN","BMXRPC5",87,0) + .; +"RTN","BMXRPC5",88,0) + .;---> %ZISC doesn't close Device 51 when called from TCPIP socket? +"RTN","BMXRPC5",89,0) + .;D ^%ZISC +"RTN","BMXRPC5",90,0) + .;C 51 +"RTN","BMXRPC5",91,0) + ; +"RTN","BMXRPC5",92,0) + ;---> At this point $I=1. The job has "forgotten" its $I, even +"RTN","BMXRPC5",93,0) + ;---> though %SS shows 56 as the current device. $I=1 causes a +"RTN","BMXRPC5",94,0) + ;---> at CAPI+10^XWBBRK2. A simple USE 56 command +"RTN","BMXRPC5",95,0) + ;---> appears to "remind" the job its $I is 56, and it works. +"RTN","BMXRPC5",96,0) + ;---> Possibly this is something %ZISC ordinarily does. +"RTN","BMXRPC5",97,0) + I BMXSOCK U 56 +"RTN","BMXRPC5",98,0) + ;U 56 +"RTN","BMXRPC5",99,0) + ; +"RTN","BMXRPC5",100,0) + ;---> Copy Health Summary to global array for passing back to GUI. +"RTN","BMXRPC5",101,0) + N I,N,U,X S U="^" +"RTN","BMXRPC5",102,0) + S N=0 +"RTN","BMXRPC5",103,0) + F I=1:1 S N=$O(^TMP("BMXHS",$J,N)) Q:'N D +"RTN","BMXRPC5",104,0) + .;---> Set null lines (line breaks) equal to one space, so that +"RTN","BMXRPC5",105,0) + .;---> Windows reader will quit only at the final "null" line. +"RTN","BMXRPC5",106,0) + .S X=^TMP("BMXHS",$J,N) S:X="" X=" " +"RTN","BMXRPC5",107,0) + .S ^BMXTEMP($J,"HS",I)=X_BMX30 +"RTN","BMXRPC5",108,0) + ; +"RTN","BMXRPC5",109,0) + ;---> If no Health Summary produced, report it as an error. +"RTN","BMXRPC5",110,0) + D:'$O(^BMXTEMP($J,"HS",0)) +"RTN","BMXRPC5",111,0) + . S BMXERR="No Health Summary produced" S ^BMXTEMP($J,"HS",I)=BMX31_BMXERR +"RTN","BMXRPC5",112,0) + ; +"RTN","BMXRPC5",113,0) + ;---> Tack on Error Delimiter and any error. +"RTN","BMXRPC5",114,0) + S ^BMXTEMP($J,"HS",I)=BMX31_BMXERR +"RTN","BMXRPC5",115,0) + ; +"RTN","BMXRPC5",116,0) + ;---> Delete host file. +"RTN","BMXRPC5",117,0) + ;---> This doesn't work. +"RTN","BMXRPC5",118,0) + S Y=$$DEL^%ZISH(BMXPATH,BMXFN) +"RTN","BMXRPC5",119,0) + ;---> Call system command. +"RTN","BMXRPC5",120,0) + ;S ^MIKE(1)=BMXPATH +"RTN","BMXRPC5",121,0) + ;S ^MIKE(2)=BMXFN +"RTN","BMXRPC5",122,0) + ;S Y=$ZOS(2,BMXPATH_BMXFN) +"RTN","BMXRPC5",123,0) + K ^TMP("BMXHS",$J) +"RTN","BMXRPC5",124,0) + Q +"RTN","BMXRPC6") +0^93^B14693179 +"RTN","BMXRPC6",1,0) +BMXRPC6 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; +"RTN","BMXRPC6",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXRPC6",3,0) + ; +"RTN","BMXRPC6",4,0) + ; +"RTN","BMXRPC6",5,0) +USRKEYRS(BMXY,BMXDUZ) ;EP - Returns recordset of user's keys +"RTN","BMXRPC6",6,0) + ; +"RTN","BMXRPC6",7,0) + N BMXDPT,BMXZ,BMXDLIM,BMXXX,BMXRET,BMXAGE,BMXNEXT,BMXSEX,BMXERR +"RTN","BMXRPC6",8,0) + S BMXDLIM="^",BMXERR="" +"RTN","BMXRPC6",9,0) + S BMXRET="T00050KEY"_$C(30) +"RTN","BMXRPC6",10,0) + I '$D(DUZ(2)) S BMXY=BMXRET_$C(31)_"No DUZ2" Q +"RTN","BMXRPC6",11,0) + ;Strip CRLFs from parameter +"RTN","BMXRPC6",12,0) + S BMXCRLF=$C(13)_$C(10) +"RTN","BMXRPC6",13,0) + S BMXDUZ=$TR(BMXDUZ,BMXCRLF,"") +"RTN","BMXRPC6",14,0) + I '$D(^VA(200,BMXDUZ)) S BMXY=BMXRET_$C(31)_"No such user" Q +"RTN","BMXRPC6",15,0) + S BMXK=0 F S BMXK=$O(^VA(200,BMXDUZ,51,BMXK)) Q:'+BMXK D +"RTN","BMXRPC6",16,0) + . S BMXKEY=$G(^VA(200,BMXDUZ,51,BMXK,0)) +"RTN","BMXRPC6",17,0) + . Q:BMXKEY="" +"RTN","BMXRPC6",18,0) + . S BMXKEY=$P(BMXKEY,BMXDLIM) +"RTN","BMXRPC6",19,0) + . Q:'+BMXKEY +"RTN","BMXRPC6",20,0) + . Q:'$D(^DIC(19.1,BMXKEY,0)) +"RTN","BMXRPC6",21,0) + . S BMXKEY=$P(^DIC(19.1,BMXKEY,0),BMXDLIM) +"RTN","BMXRPC6",22,0) + . Q:BMXKEY']"" +"RTN","BMXRPC6",23,0) + . S BMXRET=BMXRET_BMXKEY_$C(30) +"RTN","BMXRPC6",24,0) + S BMXY=BMXRET_$C(30)_$C(31)_BMXERR +"RTN","BMXRPC6",25,0) + Q +"RTN","BMXRPC6",26,0) + ; +"RTN","BMXRPC6",27,0) +PDATA(BMXY,BMXP) ;-EP Returns patient demographics for pt with +"RTN","BMXRPC6",28,0) + ;health record number BMXP at the current DUZ(2) +"RTN","BMXRPC6",29,0) + N BMXIEN,BMXDUZ2,BMXSQL +"RTN","BMXRPC6",30,0) + ;Strip CR, LF, TAB, SPACE +"RTN","BMXRPC6",31,0) + S BMXP=$TR(BMXP,$C(13),"") +"RTN","BMXRPC6",32,0) + S BMXP=$TR(BMXP,$C(10),"") +"RTN","BMXRPC6",33,0) + S BMXP=$TR(BMXP,$C(9),"") +"RTN","BMXRPC6",34,0) + S BMXP=$TR(BMXP,$C(32),"") +"RTN","BMXRPC6",35,0) + S BMXDUZ2=$G(DUZ(2)),BMXDUZ2=+BMXDUZ2 +"RTN","BMXRPC6",36,0) + S BMXIEN=0 +"RTN","BMXRPC6",37,0) + I +BMXDUZ2 F S BMXIEN=$O(^AUPNPAT("D",BMXP,BMXIEN)) Q:'+BMXIEN I $D(^AUPNPAT("D",BMXP,BMXIEN,BMXDUZ2)) Q +"RTN","BMXRPC6",38,0) + S BMXSQL="SELECT NAME 'Name', DOB 'DateOfBirth', TRIBE_OF_MEMBERSHIP 'Tribe', MAILING_ADDRESS-STREET 'Street'," +"RTN","BMXRPC6",39,0) + S BMXSQL=BMXSQL_" MAILING_ADDRESS-CITY 'City', MAILING_ADDRESS-STATE 'State', MAILING_ADDRESS-ZIP 'Zip', HOME_PHONE 'HomePhone', OFFICE_PHONE 'WorkPhone' FROM PATIENT WHERE BMXIEN='"_+BMXIEN_"'" +"RTN","BMXRPC6",40,0) + D SQL^BMXSQL(.BMXY,BMXSQL) +"RTN","BMXRPC6",41,0) + S @BMXY@(.5)="T00015Chart^" +"RTN","BMXRPC6",42,0) + I $D(@BMXY@(10)) S @BMXY@(10)=BMXP_"^"_@BMXY@(10) +"RTN","BMXRPC6",43,0) + ; +"RTN","BMXRPC6",44,0) + Q +"RTN","BMXRPC6",45,0) + ; +"RTN","BMXRPC6",46,0) +PDEMOD(BMXY,BMXPAT,BMXCOUNT) ;EP +"RTN","BMXRPC6",47,0) + ;Entry point for Serenji debugging +"RTN","BMXRPC6",48,0) + ; +"RTN","BMXRPC6",49,0) + D DEBUG^%Serenji("PDEMO^BMXRPC6(.BMXY,BMXPAT,BMXCOUNT)") +"RTN","BMXRPC6",50,0) + Q +"RTN","BMXRPC6",51,0) + ; +"RTN","BMXRPC6",52,0) +PDEMO(BMXY,BMXPAT,BMXCOUNT) ;EP +"RTN","BMXRPC6",53,0) + ;This simple RPC demonstrates how to format data +"RTN","BMXRPC6",54,0) + ;for the BMXNet ADO.NET data provider +"RTN","BMXRPC6",55,0) + ; +"RTN","BMXRPC6",56,0) + ;Returns a maximum of BMXCOUNT records from the +"RTN","BMXRPC6",57,0) + ;VA PATIENT file whose names begin with BMXPAT +"RTN","BMXRPC6",58,0) + ; +"RTN","BMXRPC6",59,0) + N BMXI,BMXD,BMXC,BMXNODE,BMXDOB +"RTN","BMXRPC6",60,0) + ; +"RTN","BMXRPC6",61,0) + ;When the VA BROKER calls this routine, BMXY is passed by reference +"RTN","BMXRPC6",62,0) + ;We set BMXY to the value of the variable in which we will return +"RTN","BMXRPC6",63,0) + ;our data: +"RTN","BMXRPC6",64,0) + ;S BMXY="^TMP(""BMX"","_$J_")" +"RTN","BMXRPC6",65,0) + N BMXUID +"RTN","BMXRPC6",66,0) + S BMXUID=$S($G(ZTSK):"Z"_ZTSK,1:$J) +"RTN","BMXRPC6",67,0) + S BMXY=$NA(^BMXTMP("BMXTEST",BMXUID)) +"RTN","BMXRPC6",68,0) + K ^BMXTMP("BMXTEST",BMXUID) +"RTN","BMXRPC6",69,0) + ; +"RTN","BMXRPC6",70,0) + ;The first subnode of the data global contains the column header information +"RTN","BMXRPC6",71,0) + ;in the form "TxxxxxCOLUMN1NAME^txxxxxCOLUMN2NAME"_$C(30) +"RTN","BMXRPC6",72,0) + ;where T is the column data type and can be either T for text, I for numeric or D for date/time. +"RTN","BMXRPC6",73,0) + ;xxxxx is the length of the column in characters: +"RTN","BMXRPC6",74,0) + ; +"RTN","BMXRPC6",75,0) + S BMXI=0,BMXC=0 +"RTN","BMXRPC6",76,0) + S ^BMXTMP("BMXTEST",BMXUID,BMXI)="T00030NAME^T00010SEX^D00020DOB"_$C(30) +"RTN","BMXRPC6",77,0) + ; +"RTN","BMXRPC6",78,0) + ;You MUST set an error trap: +"RTN","BMXRPC6",79,0) + S X="PDERR^BMXRPC6",@^%ZOSF("TRAP") +"RTN","BMXRPC6",80,0) + ; +"RTN","BMXRPC6",81,0) + ;Strip CR, LF, TAB, SPACE from BMXCOUNT parameter +"RTN","BMXRPC6",82,0) + S BMXCOUNT=$TR(BMXCOUNT,$C(13),"") +"RTN","BMXRPC6",83,0) + S BMXCOUNT=$TR(BMXCOUNT,$C(10),"") +"RTN","BMXRPC6",84,0) + S BMXCOUNT=$TR(BMXCOUNT,$C(9),"") +"RTN","BMXRPC6",85,0) + S BMXCOUNT=$TR(BMXCOUNT,$C(32),"") +"RTN","BMXRPC6",86,0) + ; +"RTN","BMXRPC6",87,0) + ;Iterate through the global and set the data nodes: +"RTN","BMXRPC6",88,0) + S:BMXPAT="" BMXPAT="A" +"RTN","BMXRPC6",89,0) + S BMXPAT=$O(^DPT("B",BMXPAT),-1) +"RTN","BMXRPC6",90,0) + S BMXD=0 +"RTN","BMXRPC6",91,0) + F S BMXPAT=$O(^DPT("B",BMXPAT)) Q:BMXPAT="" S BMXD=$O(^DPT("B",BMXPAT,0)) I +BMXD S BMXC=BMXC+1 Q:(BMXCOUNT)&(BMXC>BMXCOUNT) D +"RTN","BMXRPC6",92,0) + . Q:'$D(^DPT(BMXD,0)) +"RTN","BMXRPC6",93,0) + . S BMXI=BMXI+1 +"RTN","BMXRPC6",94,0) + . S BMXNODE=^DPT(BMXD,0) +"RTN","BMXRPC6",95,0) + . ;Convert the DOB from FM date +"RTN","BMXRPC6",96,0) + . S Y=$P(BMXNODE,U,3) +"RTN","BMXRPC6",97,0) + . I +Y X ^DD("DD") +"RTN","BMXRPC6",98,0) + . S BMXDOB=Y +"RTN","BMXRPC6",99,0) + . ;The data node fields are in the same order as the column header, i.e. NAME^SEX^DOB +"RTN","BMXRPC6",100,0) + . ;and terminated with a $C(30) +"RTN","BMXRPC6",101,0) + . S ^BMXTMP("BMXTEST",BMXUID,BMXI)=$P(BMXNODE,U)_U_$P(BMXNODE,U,2)_U_BMXDOB_$C(30) +"RTN","BMXRPC6",102,0) + ; +"RTN","BMXRPC6",103,0) + ;After all the data nodes have been set, set the final node to $C(31) to indicate +"RTN","BMXRPC6",104,0) + ;the end of the recordset +"RTN","BMXRPC6",105,0) + S BMXI=BMXI+1 +"RTN","BMXRPC6",106,0) + S ^BMXTMP("BMXTEST",BMXUID,BMXI)=$C(31) +"RTN","BMXRPC6",107,0) + Q +"RTN","BMXRPC6",108,0) + ; +"RTN","BMXRPC6",109,0) +PDERR ;Error trap for PDEMO +"RTN","BMXRPC6",110,0) + ; +"RTN","BMXRPC6",111,0) + S ^BMXTMP("BMXTEST",BMXUID,BMXI+1)=$C(31) +"RTN","BMXRPC6",112,0) + Q +"RTN","BMXRPC7") +0^94^B40496291 +"RTN","BMXRPC7",1,0) +BMXRPC7 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; +"RTN","BMXRPC7",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXRPC7",3,0) + ; +"RTN","BMXRPC7",4,0) + ; +"RTN","BMXRPC7",5,0) +WINVAL(BMXRET,BMXWINID) ;EP +"RTN","BMXRPC7",6,0) + ;Validates user based on Windows Identity +"RTN","BMXRPC7",7,0) + ; +"RTN","BMXRPC7",8,0) + ;Return R(0)=DUZ, R(1)=(0=OK, 1,2...=Can't sign-on for some reason) +"RTN","BMXRPC7",9,0) + ; R(2)=verify needs changing, R(3)=Message, R(4)=0, R(5)=msg cnt, R(5+n) +"RTN","BMXRPC7",10,0) + ; R(R(5)+6)=# div user must select from, R(R(5)+6+n)=div +"RTN","BMXRPC7",11,0) + I $$NEWERR^%ZTER N $ETRAP S $ETRAP="" +"RTN","BMXRPC7",12,0) + N X,BMXUSER,BMXUNOW,BMXUM,BMXUMSG,BMXVCOK K DUZ +"RTN","BMXRPC7",13,0) + S BMXRET(0)=0,BMXRET(5)=0,BMXUM=0,BMXUMSG=0 +"RTN","BMXRPC7",14,0) + S DUZ=0,DUZ(0)="",BMXVCOK=0 D NOW ;IHS/OIT/HMW SAC Exemption Applied For +"RTN","BMXRPC7",15,0) + S BMXUMSG=$$INHIBIT() I BMXUMSG S BMXUM=1 G VAX ;Logon inhibited +"RTN","BMXRPC7",16,0) + ; +"RTN","BMXRPC7",17,0) + S DUZ=$$WINUGET^BMXRPC3(BMXWINID) ;IHS/OIT/HMW SAC Exemption Applied For +"RTN","BMXRPC7",18,0) + I DUZ>0 D USER(DUZ) +"RTN","BMXRPC7",19,0) + S BMXUMSG=$$UVALID() G:BMXUMSG VAX +"RTN","BMXRPC7",20,0) + I DUZ>0 S BMXUMSG=$$POST(1) +"RTN","BMXRPC7",21,0) +VAX S:BMXUMSG>0 DUZ=0 D:DUZ>0 POST2 +"RTN","BMXRPC7",22,0) + S BMXRET(0)=DUZ,BMXRET(1)=BMXUM,BMXRET(2)=BMXVCOK,BMXRET(3)=$S(BMXUMSG:$$TXT(BMXUMSG),1:""),BMXRET(4)=0 +"RTN","BMXRPC7",23,0) + Q +"RTN","BMXRPC7",24,0) + ; +"RTN","BMXRPC7",25,0) +NOW S U="^",BMXUNOW=$$NOW^XLFDT(),DT=$P(BMXUNOW,".") +"RTN","BMXRPC7",26,0) + Q +"RTN","BMXRPC7",27,0) + ; +"RTN","BMXRPC7",28,0) +USER(IX) ;Build USER +"RTN","BMXRPC7",29,0) + S BMXUSER(0)=$G(^VA(200,+IX,0)),BMXUSER(1)=$G(^(.1)) +"RTN","BMXRPC7",30,0) + Q +"RTN","BMXRPC7",31,0) + ; +"RTN","BMXRPC7",32,0) +POST(CVC) ;Finish setup partition, I CVC don't log get +"RTN","BMXRPC7",33,0) + N X,BMXUM +"RTN","BMXRPC7",34,0) + K ^UTILITY($J),^TMP($J) +"RTN","BMXRPC7",35,0) + I '$D(USER(0)),DUZ D USER(DUZ) +"RTN","BMXRPC7",36,0) + S BMXUM=$$USER1A Q:BMXUM>0 BMXUM ;User can't sign on for some reason. +"RTN","BMXRPC7",37,0) + S BMXRET(5)=0 ;The next line sends the post sign-on msg +"RTN","BMXRPC7",38,0) + F BMXPT=1:1 Q:'$D(BMXUTEXT(BMXPT)) S BMXRET(5+BMXPT)=$E(BMXUTEXT(BMXPT),2,256),BMXRET(5)=BMXPT +"RTN","BMXRPC7",39,0) + S BMXRET(5)=0 ;This line stops the display of the msg. Remove this line to allow. +"RTN","BMXRPC7",40,0) + D:'$G(CVC) POST2 +"RTN","BMXRPC7",41,0) + Q 0 +"RTN","BMXRPC7",42,0) +POST2 D:'$D(BMXUNOW) NOW +"RTN","BMXRPC7",43,0) + D DUZ ;^XUS1A ;,SAVE^XUS1,LOG^XUS1,ABT^XQ12 +"RTN","BMXRPC7",44,0) + K BMXUTEXT,BMXOPT,BMXUER ;XUEON,XUEOFF,XUTT +"RTN","BMXRPC7",45,0) + Q +"RTN","BMXRPC7",46,0) + ; +"RTN","BMXRPC7",47,0) +DUZ ;Setup DUZ. SAC exemption applied for. +"RTN","BMXRPC7",48,0) + S:'$D(BMXUSER(0)) BMXUSER(0)=^VA(200,DUZ,0) D:$D(BMXOPT)[0 BMXOPT +"RTN","BMXRPC7",49,0) + S DUZ(0)=$P(BMXUSER(0),U,4),DUZ(1)="",DUZ("AUTO")=$P(BMXOPT,"^",6) ;IHS/OIT/HMW SAC Exemption Applied For +"RTN","BMXRPC7",50,0) + S DUZ(2)=$S($G(DUZ(2))>0:DUZ(2),1:+$P(BMXOPT,U,17)) ;IHS/OIT/HMW SAC Exemption Applied For +"RTN","BMXRPC7",51,0) + S X=$P($G(^DIC(4,DUZ(2),99)),U,5),DUZ("AG")=$S(X]"":X,1:$P(^XTV(8989.3,1,0),U,8)) +"RTN","BMXRPC7",52,0) + S DUZ("BUF")=($P(BMXOPT,U,9)="Y"),DUZ("LANG")=$P(BMXOPT,U,7) ;IHS/OIT/HMW SAC Exemption Applied For +"RTN","BMXRPC7",53,0) + Q +"RTN","BMXRPC7",54,0) + ; +"RTN","BMXRPC7",55,0) +USER1A() ; +"RTN","BMXRPC7",56,0) + N BMXPTB,BMXPTE,BMXPTT +"RTN","BMXRPC7",57,0) + S BMXUTEXT=0,DUZ(2)=0 +"RTN","BMXRPC7",58,0) + F I=0:0 S I=$O(^XTV(8989.3,1,"POST",I)) Q:I'>0 D SET("!"_$G(^(I,0))) +"RTN","BMXRPC7",59,0) + D SET("!"),BMXOPT +"RTN","BMXRPC7",60,0) + S BMXPTH=$P($H,",",2) +"RTN","BMXRPC7",61,0) + D SET("!Good "_$S(BMXPTH<43200:"morning ",BMXPTH<61200:"afternoon ",1:"evening ")_$S($P(BMXUSER(1),U,4)]"":$P(BMXUSER(1),U,4),1:$P(BMXUSER(0),U,1))) +"RTN","BMXRPC7",62,0) + S BMXI1=$G(^VA(200,DUZ,1.1)),X=(+BMXI1_"0000") +"RTN","BMXRPC7",63,0) + I X D SET("! You last signed on "_$S(X\1=DT:"today",X\1+1=DT:"yesterday",1:$$DD(X))_" at "_$E(X,9,10)_":"_$E(X,11,12)) +"RTN","BMXRPC7",64,0) + I $P(BMXI1,"^",2) S I=$P(BMXI1,"^",2) D SET("!There "_$S(I>1:"were ",1:"was ")_I_" unsuccessful attempt"_$S(I>1:"s",1:"")_" since you last signed on.") +"RTN","BMXRPC7",65,0) + I $P(BMXUSER(0),U,12),$$PROHIBIT(BMXPTH,$P(BMXUSER(0),U,12)) Q 17 ;Time frame +"RTN","BMXRPC7",66,0) + I +$P(BMXOPT,U,15) S BMXPT=$P(BMXOPT,U,15)-($H-BMXUSER(1)) I BMXPT<6,BMXPT>0 D SET("! Your Verify code will expire in "_BMXPT_" days") +"RTN","BMXRPC7",67,0) + S:$P(BMXOPT,"^",5) XUTT=1 S:'$D(DTIME) DTIME=$P(BMXOPT,U,10) +"RTN","BMXRPC7",68,0) + I ('X)!$P(BMXOPT,U,4) Q 0 +"RTN","BMXRPC7",69,0) + Q 9 +"RTN","BMXRPC7",70,0) + ; +"RTN","BMXRPC7",71,0) +BMXOPT ;Build the BMXOPT string +"RTN","BMXRPC7",72,0) + N X,I +"RTN","BMXRPC7",73,0) + S:'$D(BMXOPT) BMXOPT=$G(^XTV(8989.3,1,"XUS")) +"RTN","BMXRPC7",74,0) + S X=$G(^VA(200,DUZ,200)) +"RTN","BMXRPC7",75,0) + F I=4:1:7,9,10 I $P(X,U,I)]"" S $P(BMXOPT,"^",I)=$P(X,U,I) +"RTN","BMXRPC7",76,0) + Q +"RTN","BMXRPC7",77,0) + ; +"RTN","BMXRPC7",78,0) +SET(V) ;Set into BMXUTEXT(BMXUTEXT) +"RTN","BMXRPC7",79,0) + S BMXUTEXT=$G(BMXUTEXT)+1,BMXUTEXT(BMXUTEXT)=V +"RTN","BMXRPC7",80,0) + Q +"RTN","BMXRPC7",81,0) + ; +"RTN","BMXRPC7",82,0) +PROHIBIT(BMXPTT,BMXPTR) ;See if a prohibited time, (Current time, restrict range) +"RTN","BMXRPC7",83,0) + N XMSG,BMXPTB,BMXPTE +"RTN","BMXRPC7",84,0) + S BMXPTT=BMXPTT\60#60+(BMXPTT\3600*100),BMXPTB=$P(BMXPTR,"-",1),BMXPTE=$P(BMXPTR,"-",2) +"RTN","BMXRPC7",85,0) + S XMSG=$P($$FMTE^XLFDT(DT_"."_BMXPTB,"2P")," ",2,3)_" thru "_$P($$FMTE^XLFDT(DT_"."_BMXPTE,"2P")," ",2,3) +"RTN","BMXRPC7",86,0) + I $S(BMXPTE'BMXPTE&(BMXPTT'BMXPTB!(BMXPTT0:^XTV(8989.3,1,4,X,0),1:BMXQVOL_"^y^1") S:$P(BMXVOL,U,6)="y" XRTL=BMXCI_","_BMXQVOL +"RTN","BMXRPC7",95,0) + ;I '$D(BMXQVOL) Q 0 +"RTN","BMXRPC7",96,0) + ;I '$D(BMXVOL) Q 0 +"RTN","BMXRPC7",97,0) + I $G(^%ZIS(14.5,"LOGON",BMXQVOL)) Q 1 +"RTN","BMXRPC7",98,0) + I $D(^%ZOSF("ACTJ")) X ^("ACTJ") I $P(BMXVOL,U,3),($P(BMXVOL,U,3)'>Y) Q 2 +"RTN","BMXRPC7",99,0) + Q 0 +"RTN","BMXRPC7",100,0) + ; +"RTN","BMXRPC7",101,0) + ; +"RTN","BMXRPC7",102,0) +UVALID() ;EF. Is it valid for this user to sign on? +"RTN","BMXRPC7",103,0) + I '+$G(BMXWIN) Q 18 +"RTN","BMXRPC7",104,0) + I DUZ'>0 Q 4 +"RTN","BMXRPC7",105,0) + I $P(BMXUSER(0),U,11),$P(BMXUSER(0),U,11)'>DT Q 11 ;Access Terminated +"RTN","BMXRPC7",106,0) + I $P(BMXUSER(0),U,7) Q 5 ;Disuser flag set +"RTN","BMXRPC7",107,0) + Q 0 +"RTN","BMXRPC7",108,0) + ; +"RTN","BMXRPC7",109,0) +DD(Y) Q $S($E(Y,4,5):$P("Jan^Feb^Mar^Apr^May^Jun^Jul^Aug^Sep^Oct^Nov^Dec","^",+$E(Y,4,5))_" ",1:"")_$S($E(Y,6,7):+$E(Y,6,7)_",",1:"")_($E(Y,1,3)+1700) +"RTN","BMXRPC7",110,0) + Q +"RTN","BMXRPC7",111,0) + ; +"RTN","BMXRPC7",112,0) +TXT(BMXPT) ; +"RTN","BMXRPC7",113,0) + S BMXPT=$T(ZZ+BMXPT) +"RTN","BMXRPC7",114,0) + S BMXPT=$P(BMXPT,";",4,9) I BMXPT["|" S BMXPT=$P(BMXPT,"|",1)_$G(BMXUM(0))_$P(BMXPT,"|",2) +"RTN","BMXRPC7",115,0) + Q BMXPT +"RTN","BMXRPC7",116,0) +ZZ ;;Halt;Error Messages +"RTN","BMXRPC7",117,0) +1 ;;1;Signons not currently allowed on this processor. +"RTN","BMXRPC7",118,0) +2 ;;1;Maximum number of users already signed on to this processor. +"RTN","BMXRPC7",119,0) +3 ;;1;This device has not been defined to the system -- contact system manager. +"RTN","BMXRPC7",120,0) +4 ;;0;Not a valid Windows Identity map value. +"RTN","BMXRPC7",121,0) +5 ;;0;No Access Allowed for this User. +"RTN","BMXRPC7",122,0) +6 ;;0;Invalid device password. +"RTN","BMXRPC7",123,0) +7 ;;0;Device locked due to too many invalid sign-on attempts. +"RTN","BMXRPC7",124,0) +8 ;;1;This device is out of service. +"RTN","BMXRPC7",125,0) +9 ;;0;*** MULTIPLE SIGN-ONS NOT ALLOWED *** +"RTN","BMXRPC7",126,0) +10 ;;1;You don't have access to this device! +"RTN","BMXRPC7",127,0) +11 ;;0;Your access code has been terminated. Please see your site manager! +"RTN","BMXRPC7",128,0) +12 ;;0;VERIFY CODE MUST be changed before continued use. +"RTN","BMXRPC7",129,0) +13 ;;1;This device may only be used outside of this time frame | +"RTN","BMXRPC7",130,0) +14 ;;0;'|' is not a valid UCI! +"RTN","BMXRPC7",131,0) +15 ;;0;'|' is not a valid program name! +"RTN","BMXRPC7",132,0) +16 ;;0;No PRIMARY MENU assigned to user or User is missing KEY to menu! +"RTN","BMXRPC7",133,0) +17 ;;0;Your access to the system is prohibited from |. +"RTN","BMXRPC7",134,0) +18 ;;0;Windows Integrated Security Not Allowed on this port. +"RTN","BMXRPC8") +0^95^B5993639 +"RTN","BMXRPC8",1,0) +BMXRPC8 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; 12/7/10 8:12am +"RTN","BMXRPC8",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXRPC8",3,0) + ; +"RTN","BMXRPC8",4,0) + ; +"RTN","BMXRPC8",5,0) +BMXLOCKD(BMXY,BMXVAR,BMXINC,BMXTIME) ;EP +"RTN","BMXRPC8",6,0) + ;Entry point for debugging +"RTN","BMXRPC8",7,0) + ; +"RTN","BMXRPC8",8,0) + D DEBUG^%Serenji("BMXLOCK^BMXRPC8(.BMXY,BMXVAR,BMXINC,BMXTIME)") +"RTN","BMXRPC8",9,0) + Q +"RTN","BMXRPC8",10,0) + ; +"RTN","BMXRPC8",11,0) +BMXLOCK(BMXY,BMXVAR,BMXINC,BMXTIME) ;EP +"RTN","BMXRPC8",12,0) + ;Called by BMX LOCK rpc to lock variable BMXVAR +"RTN","BMXRPC8",13,0) + ;If BMXVAR = "", argumentless lock is performed to release all locks +"RTN","BMXRPC8",14,0) + ;BMXINC = increment lock if "+", decrement if "-" +"RTN","BMXRPC8",15,0) + ;BMXTIME = lock timeout +"RTN","BMXRPC8",16,0) + ;Returns 1 if lock successful, otherwise 0; +"RTN","BMXRPC8",17,0) + ; +"RTN","BMXRPC8",18,0) + S X="ERR^BMXRPC8",@^%ZOSF("TRAP") +"RTN","BMXRPC8",19,0) + ; +"RTN","BMXRPC8",20,0) + N BMXC +"RTN","BMXRPC8",21,0) + S:$E(BMXVAR,1,1)="~" BMXVAR="^"_$E(BMXVAR,2,$L(BMXVAR)) +"RTN","BMXRPC8",22,0) + S:BMXTIME="" BMXTIME=0 +"RTN","BMXRPC8",23,0) + I BMXVAR="" X "L" S BMXY=1 Q +"RTN","BMXRPC8",24,0) + S BMXC="L " +"RTN","BMXRPC8",25,0) + S BMXC=BMXC_$S(BMXINC="+":"+",BMXINC="-":"-",1:"") +"RTN","BMXRPC8",26,0) + S BMXC=BMXC_BMXVAR_":"_+BMXTIME +"RTN","BMXRPC8",27,0) + X BMXC +"RTN","BMXRPC8",28,0) + S BMXY=$T +"RTN","BMXRPC8",29,0) + Q +"RTN","BMXRPC8",30,0) + ; +"RTN","BMXRPC8",31,0) +ERR ;Error processing +"RTN","BMXRPC8",32,0) + S BMXY=0 +"RTN","BMXRPC8",33,0) + Q +"RTN","BMXRPC8",34,0) + ; +"RTN","BMXRPC8",35,0) +BMXVERD(BMXY,BMXNS,BMXLOC) ;EP +"RTN","BMXRPC8",36,0) + ;Entry point for debugging +"RTN","BMXRPC8",37,0) + ; +"RTN","BMXRPC8",38,0) + D DEBUG^%Serenji("BMXVER^BMXRPC8(.BMXY,BMXNS,BMXLOC)") +"RTN","BMXRPC8",39,0) + Q +"RTN","BMXRPC8",40,0) + ; +"RTN","BMXRPC8",41,0) +BMXVER(BMXY,BMXNS,BMXLOC) ;EP +"RTN","BMXRPC8",42,0) + ; +"RTN","BMXRPC8",43,0) + ;Called by BMX VERSION INFO rpc +"RTN","BMXRPC8",44,0) + ;Returns recordset of version info for server components in namespace BMXNS. +"RTN","BMXRPC8",45,0) + ;If BMXLOC is "", then the version info is assumed to be stored in piece 1-3 of +"RTN","BMXRPC8",46,0) + ;^APPL(1,0) +"RTN","BMXRPC8",47,0) + ; +"RTN","BMXRPC8",48,0) + ;TODO: +"RTN","BMXRPC8",49,0) + ;BMXLOC, if not null, is either a global reference such that $P(@BMXLOC,U,1,3) returns +"RTN","BMXRPC8",50,0) + ;MAJOR^MINOR^BUILD +"RTN","BMXRPC8",51,0) + ;Or BMXLOC can be an extrinsic function call that returns MAJOR^MINOR^BUILD. +"RTN","BMXRPC8",52,0) + ; +"RTN","BMXRPC8",53,0) + ;The returned error field is either "" or contains a text error message. +"RTN","BMXRPC8",54,0) + ; +"RTN","BMXRPC8",55,0) + N X,BMXI,BMXNOD,BMXDAT +"RTN","BMXRPC8",56,0) + ; +"RTN","BMXRPC8",57,0) + S X="VETRAP^BMXRPC8",@^%ZOSF("TRAP") +"RTN","BMXRPC8",58,0) + S BMXI=0 +"RTN","BMXRPC8",59,0) + K ^BMXTMP($J) +"RTN","BMXRPC8",60,0) + S BMXY="^BMXTMP("_$J_")" +"RTN","BMXRPC8",61,0) + S ^BMXTMP($J,BMXI)="T00030ERROR^T00030MAJOR_VERSION^T00030MINOR_VERSION^T00030BUILD"_$C(30) +"RTN","BMXRPC8",62,0) + S BMXI=BMXI+1 +"RTN","BMXRPC8",63,0) + I BMXNS="" D VERR(BMXI,"BMXRPC8: Invalid Null Application Namespace") Q +"RTN","BMXRPC8",64,0) + S BMXNOD="^"_BMXNS_"APPL(1,0)" +"RTN","BMXRPC8",65,0) + S BMXDAT=$G(@BMXNOD) +"RTN","BMXRPC8",66,0) + I BMXNS="" D VERR(BMXI,"BMXRPC8: No version info for Application Namespace") Q +"RTN","BMXRPC8",67,0) + S ^BMXTMP($J,BMXI)="^"_$P(BMXDAT,U,1,3)_$C(30) +"RTN","BMXRPC8",68,0) + Q +"RTN","BMXRPC8",69,0) + ; +"RTN","BMXRPC8",70,0) + ; +"RTN","BMXRPC8",71,0) +VERR(BMXI,BMXERR) ;Error processing +"RTN","BMXRPC8",72,0) + S BMXI=BMXI+1 +"RTN","BMXRPC8",73,0) + S ^BMXTMP($J,BMXI)=BMXERR_"^^^"_$C(30) +"RTN","BMXRPC8",74,0) + S BMXI=BMXI+1 +"RTN","BMXRPC8",75,0) + S ^BMXTMP($J,BMXI)=$C(31) +"RTN","BMXRPC8",76,0) + Q +"RTN","BMXRPC8",77,0) + ; +"RTN","BMXRPC8",78,0) +VETRAP ;EP Error trap entry +"RTN","BMXRPC8",79,0) + D ^%ZTER +"RTN","BMXRPC8",80,0) + I '$D(BMXI) N BMXI S BMXI=999999 +"RTN","BMXRPC8",81,0) + S BMXI=BMXI+1 +"RTN","BMXRPC8",82,0) + D VERR(BMXI,"BMXRPC8 Error: "_$G(%ZTERROR)) +"RTN","BMXRPC8",83,0) + Q +"RTN","BMXRPC8",84,0) + ; +"RTN","BMXRPC8",85,0) +IMHERE(BMXRES) ;EP +"RTN","BMXRPC8",86,0) + ;Entry point for BMX IM HERE remote procedure +"RTN","BMXRPC8",87,0) + S BMXRES=1 +"RTN","BMXRPC8",88,0) + Q +"RTN","BMXRPC8",89,0) + ; +"RTN","BMXRPC9") +0^96^B45877662 +"RTN","BMXRPC9",1,0) +BMXRPC9 ; IHS/OIT/HMW - RPC CALL FOR EXTENDED BROKER FUNCTIONALITY ; +"RTN","BMXRPC9",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXRPC9",3,0) + ; UPDATE FILEMAN WITH AN ADO RECORD SET FROM A WINDOWS APPLICATION +"RTN","BMXRPC9",4,0) + ; +"RTN","BMXRPC9",5,0) + ; +"RTN","BMXRPC9",6,0) + ; +"RTN","BMXRPC9",7,0) +SONLY(BMXY,BMXVAL) ;EP Schema Only +"RTN","BMXRPC9",8,0) + ; +"RTN","BMXRPC9",9,0) + I BMXVAL="TRUE" S BMX("SCHEMA ONLY")=1 +"RTN","BMXRPC9",10,0) + E S BMX("SCHEMA ONLY")=0 +"RTN","BMXRPC9",11,0) + S BMXY=BMX("SCHEMA ONLY") +"RTN","BMXRPC9",12,0) + ; +"RTN","BMXRPC9",13,0) + Q +"RTN","BMXRPC9",14,0) + ; +"RTN","BMXRPC9",15,0) +TESTRPC(BMXGBL,BMXSQL) ; +"RTN","BMXRPC9",16,0) + ;Test retrieval/update statement +"RTN","BMXRPC9",17,0) + ; +"RTN","BMXRPC9",18,0) + N BMXI,BMXERR,BMXN,BMXNOD,BMXNAM,BMXSEX,BMXDOB,BMXFAC,BMXTMP,BMXJ +"RTN","BMXRPC9",19,0) + S X="ETRAP^BMXRPC9",@^%ZOSF("TRAP") +"RTN","BMXRPC9",20,0) + S BMXGBL="^BMXTMP("_$J_")",BMXERR="",U="^" +"RTN","BMXRPC9",21,0) + K ^BMXTMP($J) +"RTN","BMXRPC9",22,0) + S BMXI=0 +"RTN","BMXRPC9",23,0) + ; +"RTN","BMXRPC9",24,0) + ;Old column info format: +"RTN","BMXRPC9",25,0) + ;S BMXI=BMXI+1,^BMXTMP($J,BMXI)="I00010BMXIEN"_U_"D00010DOB"_U_"T00030LOCAL_FACLILITY"_U_"T00030NAME"_U_"T00010SEX"_$C(30) +"RTN","BMXRPC9",26,0) + ; +"RTN","BMXRPC9",27,0) + ;New column info format is @@@meta@@@KEYFIELD|FILE# +"RTN","BMXRPC9",28,0) + ; For each field: ^FILE#|FIELD#|DATATYPE|LENGTH|FIELDNAME|READONLY|KEYFIELD|NULL ALLOWED +"RTN","BMXRPC9",29,0) + ;S BMXI=BMXI+1,^BMXTMP($J,BMXI)="@@@meta@@@" +"RTN","BMXRPC9",30,0) + ;S BMXI=BMXI+1,^BMXTMP($J,BMXI)="BMXIEN|2160010^" +"RTN","BMXRPC9",31,0) + ;S BMXI=BMXI+1,^BMXTMP($J,BMXI)="2160010|.001|I|10|BMXIEN|TRUE|TRUE^" +"RTN","BMXRPC9",32,0) + ;S BMXI=BMXI+1,^BMXTMP($J,BMXI)="2160010|.03|D|10|DOB|FALSE|FALSE^" +"RTN","BMXRPC9",33,0) + ;S BMXI=BMXI+1,^BMXTMP($J,BMXI)="2160010|.04|T|60|LOCAL_FACILITY|FALSE|FALSE^" +"RTN","BMXRPC9",34,0) + ;S BMXI=BMXI+1,^BMXTMP($J,BMXI)="2160010|.01|T|30|NAME|FALSE|FALSE^" +"RTN","BMXRPC9",35,0) + ;S BMXI=BMXI+1,^BMXTMP($J,BMXI)="2160010|.02|T|10|SEX|FALSE|FALSE" +"RTN","BMXRPC9",36,0) + ;S BMXI=BMXI+1,^BMXTMP($J,BMXI)=$C(30) +"RTN","BMXRPC9",37,0) + ; +"RTN","BMXRPC9",38,0) + D SS^BMXADO(.BMXTMP,"","TEST1") +"RTN","BMXRPC9",39,0) + I $G(BMXTMP)=$C(30) D ERR(99,"SCHEMA GENERATION FAILED") Q +"RTN","BMXRPC9",40,0) + S BMXJ=0 F S BMXJ=$O(BMXTMP(BMXJ)) Q:'+BMXJ D +"RTN","BMXRPC9",41,0) + . S BMXI=BMXI+1 +"RTN","BMXRPC9",42,0) + . S ^BMXTMP($J,BMXI)=BMXTMP(BMXJ) +"RTN","BMXRPC9",43,0) + I +$G(BMX("SCHEMA ONLY")) D Q +"RTN","BMXRPC9",44,0) + . S BMXI=BMXI+1 +"RTN","BMXRPC9",45,0) + . S ^BMXTMP($J,BMXI)=$C(31) +"RTN","BMXRPC9",46,0) + . Q +"RTN","BMXRPC9",47,0) + S BMXN=0 +"RTN","BMXRPC9",48,0) + F S BMXN=$O(^DIZ(2160010,BMXN)) Q:'+BMXN D +"RTN","BMXRPC9",49,0) + . Q:'$D(^DIZ(2160010,BMXN,0)) +"RTN","BMXRPC9",50,0) + . S BMXNOD=^DIZ(2160010,BMXN,0) +"RTN","BMXRPC9",51,0) + . S BMXNAM=$P(BMXNOD,U) +"RTN","BMXRPC9",52,0) + . S BMXSEX=$P(BMXNOD,U,2) +"RTN","BMXRPC9",53,0) + . S BMXDOB=$P(BMXNOD,U,3) +"RTN","BMXRPC9",54,0) + . S Y=BMXDOB X ^DD("DD") S BMXDOB=Y +"RTN","BMXRPC9",55,0) + . S BMXFAC=$P(BMXNOD,U,4) +"RTN","BMXRPC9",56,0) + . S:+BMXFAC BMXFAC=$P($G(^DIC(4,BMXFAC,0)),U) +"RTN","BMXRPC9",57,0) + . S BMXI=BMXI+1 +"RTN","BMXRPC9",58,0) + . S ^BMXTMP($J,BMXI)=BMXN_U_BMXDOB_U_BMXFAC_U_BMXNAM_U_BMXSEX_$C(30) +"RTN","BMXRPC9",59,0) + . Q +"RTN","BMXRPC9",60,0) + S BMXI=BMXI+1 +"RTN","BMXRPC9",61,0) + S ^BMXTMP($J,BMXI)=$C(31) +"RTN","BMXRPC9",62,0) + Q +"RTN","BMXRPC9",63,0) + ; +"RTN","BMXRPC9",64,0) +ERR(BMXID,BMXERR) ;Error processing +"RTN","BMXRPC9",65,0) + K ^BMXTMP($J) +"RTN","BMXRPC9",66,0) + S ^BMXTMP($J,0)="I00030ERRORID^T00030ERRORMSG"_$C(30) +"RTN","BMXRPC9",67,0) + S ^BMXTMP($J,1)=BMXID_"^"_BMXERR_$C(30) +"RTN","BMXRPC9",68,0) + S ^BMXTMP($J,2)=$C(31) +"RTN","BMXRPC9",69,0) + Q +"RTN","BMXRPC9",70,0) + ; +"RTN","BMXRPC9",71,0) +ETRAP ;EP Error trap entry +"RTN","BMXRPC9",72,0) + D ^%ZTER +"RTN","BMXRPC9",73,0) + D ERR(99,"BMXRPC9 Error: "_$G(%ZTERROR)) +"RTN","BMXRPC9",74,0) + Q +"RTN","BMXRPC9",75,0) + ; +"RTN","BMXRPC9",76,0) +TEST N OUT S OUT="" D ADO(.OUT,2160010,"1",(".01|A,A"_$C(30)_".02|M"_$C(30)_".03|1/5/1946"_$C(30)_".04|SAN XAVIER"_$C(31))) W !,OUT +"RTN","BMXRPC9",77,0) + Q +"RTN","BMXRPC9",78,0) + ; +"RTN","BMXRPC9",79,0) +ADOX(OUT,FILE,IEN,DATA) ; +"RTN","BMXRPC9",80,0) + ; +"RTN","BMXRPC9",81,0) + D DEBUG^%Serenji("ADOX^BMXRPC9(.OUT,FILE,IEN,DATA)") +"RTN","BMXRPC9",82,0) + ; +"RTN","BMXRPC9",83,0) + Q +"RTN","BMXRPC9",84,0) + ; +"RTN","BMXRPC9",85,0) +ADO(OUT,FILE,IEN,DATA) ; RPC CALL: OUT = OUTBOUND MESSAGE, FILE = FILEMAN FILE NUMBER, IEN = FILE INTERNAL ENTRY NUMBER, DATA = DATA STRING +"RTN","BMXRPC9",86,0) + N OREF,CREF,DIC,DIE,DA,DR,X,Y,%,FLD,CNT,FNO,VAL,TFLG,DFLG,TOT,UFLG,XTFLG,GTFLG,GDFLG +"RTN","BMXRPC9",87,0) + S OUT="",FLD="",GTFLG=0,GDFLG=0 +"RTN","BMXRPC9",88,0) + S IEN=$G(IEN) +"RTN","BMXRPC9",89,0) + I $E(IEN)="-" S IEN=$E(IEN,2,99),GDFLG=1 ; GLOBAL DELETE FLAG +"RTN","BMXRPC9",90,0) + I $E(IEN)="+" S IEN=$E(IEN,2,99),GTFLG=1 ; GLOBAL TRANSACTION FLAG, ROLLBACK IF ANY FIELD FAILS TO UPDATE +"RTN","BMXRPC9",91,0) + I IEN="Add"!(IEN="ADD") S IEN="" +"RTN","BMXRPC9",92,0) + I '$D(^DIC(+$G(FILE),0,"GL")) S OUT="Update cancelled. Invalid FILE number" Q +"RTN","BMXRPC9",93,0) + S OREF=^DIC(FILE,0,"GL") I '$L(OREF) S OUT="Update cancelled. Invalid file definition" Q +"RTN","BMXRPC9",94,0) + S CREF=$E(OREF,1,$L(OREF)-1) I $E(OREF,$L(OREF))="," S CREF=CREF_")" ; CONVERT OREF TO CREF +"RTN","BMXRPC9",95,0) + I IEN,'$D(@CREF@(IEN)) S OUT="Update cancelled. Invalid IEN" Q +"RTN","BMXRPC9",96,0) + I 'GDFLG,IEN,(DATA["-.01|"!(DATA[".01|@")) S GDFLG=1 +"RTN","BMXRPC9",97,0) + I GDFLG,'IEN S OUT="Deletion cancelled. Missing IEN" Q +"RTN","BMXRPC9",98,0) + I GDFLG D DIK(OREF,IEN) S OUT="Record deleted|"_IEN Q +"RTN","BMXRPC9",99,0) + S UFLG=$S($G(IEN):"E",1:"A") ; UPDATE FLAG: ADD OR EDIT +"RTN","BMXRPC9",100,0) + I '$L($G(DATA)) S OUT="Update cancelled. Missing/invalid data string" Q +"RTN","BMXRPC9",101,0) + S TOT=$L(DATA,$C(30)) I 'TOT S OUT="Update cancelled. Missing data string" Q +"RTN","BMXRPC9",102,0) + F CNT=1:1:TOT S DATA(CNT)=$P(DATA,$C(30),CNT) ; BUILD PRIMARY FIELD ARRAY +"RTN","BMXRPC9",103,0) + S %=DATA(1) I %=""!(%=$C(31)) S OUT="Update cancelled. Missing data string" Q +"RTN","BMXRPC9",104,0) + S %=DATA(CNT) I %[$C(31) S %=$P(%,$C(31),1),DATA(CNT)=% ; STRIP OFF END OF FILE MARKER +"RTN","BMXRPC9",105,0) + F CNT=1:1:TOT S X=DATA(CNT) I $L(X) D ; BUILD SECONDARY FIELD ARRAY +"RTN","BMXRPC9",106,0) + . S TFLG=0,DFLG=0 +"RTN","BMXRPC9",107,0) + . I $E(X)="+" S TFLG=1,X=$E(X,2,999),$P(FLD,U)=1 +"RTN","BMXRPC9",108,0) + . I $E(X)="-" S DFLG=1,X=$E(X,2,999) +"RTN","BMXRPC9",109,0) + . S FNO=$P(X,"|"),VAL=$P(X,"|",2) +"RTN","BMXRPC9",110,0) + . I '$D(^DD(FILE,+$G(FNO),0)) S:$L(OUT) OUT=OUT_"~" S OUT=OUT_FNO_"|Invalid field number" Q +"RTN","BMXRPC9",111,0) + . I DFLG,VAL'="" S:$L(OUT) OUT=OUT_"~" S OUT=OUT_FNO_"|Invalid deletion syntax" Q ; CANT DELETE IF A VALUE IS SENT +"RTN","BMXRPC9",112,0) + . I DFLG!(VAL="") S VAL="@" ; SYNC DFLG AND VAL +"RTN","BMXRPC9",113,0) + . I VAL="@" S DFLG=1 ; SYNC DFLG AND VAL +"RTN","BMXRPC9",114,0) + . S FLD(FNO)=VAL_U_TFLG_U_DFLG +"RTN","BMXRPC9",115,0) + . I FNO=.01,TFLG S $P(FLD,U,2)=1 ; +"RTN","BMXRPC9",116,0) + . Q +"RTN","BMXRPC9",117,0) + I $P($G(FLD(.01)),U,3),UFLG="A" S OUT="Record deletion cancelled. Missing IEN" Q ; CAN'T DELETE A RECORD WITHOUT A VALID IEN +"RTN","BMXRPC9",118,0) +DELREC I $P($G(FLD(.01)),U,3) D DIK(OREF,IEN) S OUT="OK" Q ; DELETE THE RECORD +"RTN","BMXRPC9",119,0) + I UFLG="A",'$L($P($G(FLD(.01)),U)) S OUT="Record addition cancelled. Missing .01 field" Q ; CAN'T ADD A RECORD WITHOUT A VALID .01 FIELD +"RTN","BMXRPC9",120,0) +ADDREC I UFLG="A" D ADD(OREF) Q ; ADD A NEW ENTRY TO A FILE +"RTN","BMXRPC9",121,0) +EDITREC I UFLG="E" D EDIT(OREF,IEN) Q ; EDIT AN EXISTING RECORD +"RTN","BMXRPC9",122,0) + Q +"RTN","BMXRPC9",123,0) + ; +"RTN","BMXRPC9",124,0) +DIK(DIK,DA) ; DELETE A RECORD +"RTN","BMXRPC9",125,0) + D ^DIK +"RTN","BMXRPC9",126,0) + D ^XBFMK +"RTN","BMXRPC9",127,0) + Q +"RTN","BMXRPC9",128,0) + ; +"RTN","BMXRPC9",129,0) +ADD(DIC) ; ADD A NEW ENTRY TO A FILE +"RTN","BMXRPC9",130,0) + N X,Y +"RTN","BMXRPC9",131,0) + S X=""""_$P($G(FLD(.01)),U)_"""" +"RTN","BMXRPC9",132,0) + S DIC(0)="L" +"RTN","BMXRPC9",133,0) + D ^DIC +"RTN","BMXRPC9",134,0) + I Y=-1 S OUT="Unable to add a new record" G AX +"RTN","BMXRPC9",135,0) + I $O(FLD(.01)) D EDIT(DIC,+Y) Q +"RTN","BMXRPC9",136,0) + S OUT="OK"_"|"_+Y +"RTN","BMXRPC9",137,0) +AX D ^XBFMK +"RTN","BMXRPC9",138,0) + Q +"RTN","BMXRPC9",139,0) + ; +"RTN","BMXRPC9",140,0) +EDIT(DIE,DA) ; EDIT AN EXISTING RECORD +"RTN","BMXRPC9",141,0) + N DR,RFLG,ERR,FNO,VAL,TFLG,RESULT,MSG,DIERR,DISYS +"RTN","BMXRPC9",142,0) + S FNO=$O(FLD(.01),-1),DR="" ;HMW Changed to include .01 in DR string +"RTN","BMXRPC9",143,0) + I UFLG="A" S OUT="New record added|"_DA +"RTN","BMXRPC9",144,0) + F S FNO=$O(FLD(FNO)) Q:'FNO S X=FLD(FNO) I $L(X) D I $G(RFLG) Q ; CHECK EA FIELD AND BUILD THE DR STRING AND ERROR STRING +"RTN","BMXRPC9",145,0) + . S VAL(FNO)=$P(X,U),TFLG=$P(X,U,2) I '$L(VAL(FNO)) Q +"RTN","BMXRPC9",146,0) + . K ERR,RESULT +"RTN","BMXRPC9",147,0) + . I VAL(FNO)="@"!(VAL(FNO)="") S RESULT="@" +"RTN","BMXRPC9",148,0) + . E D CHK^DIE(FILE,FNO,"",VAL(FNO),.RESULT,"ERR") +"RTN","BMXRPC9",149,0) + . I RESULT=U D Q +"RTN","BMXRPC9",150,0) + .. S MSG=$G(ERR("DIERR",1,"TEXT",1),"Failed FileMan data validation") +"RTN","BMXRPC9",151,0) + .. I $L(OUT) S OUT=OUT_"~" +"RTN","BMXRPC9",152,0) + .. I TFLG!GTFLG S RFLG=1,OUT=FNO_"|"_MSG Q +"RTN","BMXRPC9",153,0) + .. S OUT=OUT_FNO_"|"_MSG +"RTN","BMXRPC9",154,0) + .. Q +"RTN","BMXRPC9",155,0) + . S VAL(FNO)=RESULT +"RTN","BMXRPC9",156,0) + . I $L(DR) S DR=DR_";" +"RTN","BMXRPC9",157,0) + . S DR=DR_FNO_"////^S X=VAL("_FNO_")" ; BUILD DR STRING +"RTN","BMXRPC9",158,0) + . Q +"RTN","BMXRPC9",159,0) + I $G(RFLG) D:UFLG="A" DIK(DIE,DA) S OUT="Record update cancelled"_"|"_OUT G EX ; TRANSACTION ROLLBACK FLAG IS SET, ENTRY DELETED (ADD MODE) OR UPDATE CANCELLED (EDIT MODE) +"RTN","BMXRPC9",160,0) + L +@CREF@(DA):2 I $T D ^DIE L -@CREF@(DA) G:OUT["valid" EX S OUT="OK" S:UFLG="A" OUT=OUT_"|"_DA G EX ; SUCCESS!!!! +"RTN","BMXRPC9",161,0) + S OUT="Update cancelled. File locked" ; FILE LOCKED. UNABLE TO UPDATE +"RTN","BMXRPC9",162,0) + I $L(FLD),UFLG="A" D DIK(DIE,DA) ; ROLLBACK THE NEW RECORD +"RTN","BMXRPC9",163,0) +EX D ^XBFMK ; CLEANUP +"RTN","BMXRPC9",164,0) + Q +"RTN","BMXRPC9",165,0) + ; +"RTN","BMXSQL") +0^97^B109951806 +"RTN","BMXSQL",1,0) +BMXSQL ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; +"RTN","BMXSQL",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXSQL",3,0) + ; +"RTN","BMXSQL",4,0) + ; +"RTN","BMXSQL",5,0) + Q +"RTN","BMXSQL",6,0) + ; +"RTN","BMXSQL",7,0) +FLDNDX(BMXGBL,BMXFL,BMXFLD) ; +"RTN","BMXSQL",8,0) + ;Returns index name and set code for all indexes on field +"RTN","BMXSQL",9,0) + ;on field BMXFLD in file BMXFL +"RTN","BMXSQL",10,0) + S BMX31=$C(31)_$C(31) +"RTN","BMXSQL",11,0) + K ^BMXTMP($J),^BMXTEMP($J) +"RTN","BMXSQL",12,0) + S BMXGBL="^BMXTEMP("_$J_")" +"RTN","BMXSQL",13,0) + I +BMXFL'=BMXFL D +"RTN","BMXSQL",14,0) + . S BMXFL=$TR(BMXFL,"_"," ") +"RTN","BMXSQL",15,0) + . I '$D(^DIC("B",BMXFL)) S BMXFL="" Q +"RTN","BMXSQL",16,0) + . S BMXFL=$O(^DIC("B",BMXFL,0)) +"RTN","BMXSQL",17,0) + I '$G(BMXFL) D ERROUT("File number not provided.",1) Q +"RTN","BMXSQL",18,0) + ; +"RTN","BMXSQL",19,0) + ;Check for field name +"RTN","BMXSQL",20,0) + I +BMXFLD'=BMXFLD D +"RTN","BMXSQL",21,0) + . S BMXFLD=$TR(BMXFLD,"_"," ") +"RTN","BMXSQL",22,0) + . I '$D(^DD(BMXFL,"B",BMXFLD)) S BMXFLD="" Q +"RTN","BMXSQL",23,0) + . S BMXFLD=$O(^DD(BMXFL,"B",BMXFLD,0)) +"RTN","BMXSQL",24,0) + I '$G(BMXFLD) D ERROUT("Field not provided",1) Q +"RTN","BMXSQL",25,0) + ; +"RTN","BMXSQL",26,0) + ;Set up Column names +"RTN","BMXSQL",27,0) + S ^BMXTEMP($J,0)="T"_$$NUMCHAR(30)_"INDEX^T"_$$NUMCHAR(200)_"CODE"_$C(30) +"RTN","BMXSQL",28,0) + ; +"RTN","BMXSQL",29,0) + ;Write field data to BMXTEMP +"RTN","BMXSQL",30,0) + S BMXI=0,I=0 +"RTN","BMXSQL",31,0) + N BMXNAM,BMXCOD,BMXNOD,BMXTYP +"RTN","BMXSQL",32,0) + F S BMXI=$O(^DD(BMXFL,BMXFLD,1,BMXI)) Q:'+BMXI Q:$D(BMXERR) D +"RTN","BMXSQL",33,0) + . S I=I+1 +"RTN","BMXSQL",34,0) + . S BMXNOD=$G(^DD(BMXFL,BMXFLD,1,BMXI,0)) +"RTN","BMXSQL",35,0) + . S BMXNAM=$P(BMXNOD,U,2) +"RTN","BMXSQL",36,0) + . S BMXTYP=$P(BMXNOD,U,3) +"RTN","BMXSQL",37,0) + . S:BMXTYP="" BMXTYP="REGULAR" +"RTN","BMXSQL",38,0) + . S BMXCOD=$G(^DD(BMXFL,BMXFLD,1,BMXI,1)) +"RTN","BMXSQL",39,0) + . S BMXCOD=$TR(BMXCOD,"^","~") +"RTN","BMXSQL",40,0) + . S ^BMXTEMP($J,I)=BMXNAM_U_BMXTYP_U_BMXCOD_$C(30) +"RTN","BMXSQL",41,0) + Q +"RTN","BMXSQL",42,0) + ; +"RTN","BMXSQL",43,0) +TLIST(BMXGBL,BMXFROM,BMXTO) ; +"RTN","BMXSQL",44,0) + ;Returns list of Fileman files to which user has READ access +"RTN","BMXSQL",45,0) + ;TODO: Pass in type of access (RD,DL,WR) in BMXPAR +"RTN","BMXSQL",46,0) + ; +"RTN","BMXSQL",47,0) + N A,F,BMXF,BMXFLD,D0,BMXU,I,BMXCNT,BMXMFL,BMXRD,BMXMAX +"RTN","BMXSQL",48,0) + S U="^" +"RTN","BMXSQL",49,0) + S:$G(BMXFROM)="RD" BMXFROM="" +"RTN","BMXSQL",50,0) + K ^BMXTMP($J),^BMXTEMP($J) +"RTN","BMXSQL",51,0) + S BMXGBL="^BMXTEMP("_$J_")" +"RTN","BMXSQL",52,0) + S BMXF=1 +"RTN","BMXSQL",53,0) + S BMXF("FILE")=1 +"RTN","BMXSQL",54,0) + S BMXFLD("FILE")="1^.01" +"RTN","BMXSQL",55,0) + S BMXFLD("NUMBER")="1^.001" ;ADDED +"RTN","BMXSQL",56,0) + S BMXFLDN=$P(BMXFLD("FILE"),"^",2) +"RTN","BMXSQL",57,0) + S BMXFLDN(1,BMXFLDN)="FILE" +"RTN","BMXSQL",58,0) + S BMXFLDN=$P(BMXFLD("NUMBER"),"^",2) ;ADDED +"RTN","BMXSQL",59,0) + S BMXFLDN(1,BMXFLDN)="NUMBER" ;ADDED +"RTN","BMXSQL",60,0) + S BMXFLDO=2 ;CHANGED FROM 1 TO 2 +"RTN","BMXSQL",61,0) + S BMXFLDO(0)="1^.01" +"RTN","BMXSQL",62,0) + S BMXFLDOX(1,.01,"E")=0 +"RTN","BMXSQL",63,0) + S BMXFLDO(1)="1^.001" ;ADDED +"RTN","BMXSQL",64,0) + S BMXFLDOX(1,.001,"E")=1 ;ADDED +"RTN","BMXSQL",65,0) + S BMXFNX(1)="FILE" +"RTN","BMXSQL",66,0) + S BMXFO(1)="1" +"RTN","BMXSQL",67,0) + S BMXU=$G(DUZ(0)) +"RTN","BMXSQL",68,0) + S BMXRD=$C(30) +"RTN","BMXSQL",69,0) + S ^BMXTEMP($J,0)="T00030FILE^N00010NUMBER"_BMXRD +"RTN","BMXSQL",70,0) + S BMXSET="S I=I+1,^BMXTEMP($J,I)=$P($G(^DIC(D0,0)),U)_U_D0_BMXRD,BMXCNT=BMXCNT+1" +"RTN","BMXSQL",71,0) + S D0=0,I=0,BMXCNT=0,BMXMAX=2000 +"RTN","BMXSQL",72,0) + S BMXFROM=$G(BMXFROM),BMXTO=$G(BMXTO) +"RTN","BMXSQL",73,0) + I +BMXFROM=BMXFROM D ;BMXFROM is a filenumber +"RTN","BMXSQL",74,0) + . S F=(+BMXFROM-1),T=+BMXTO +"RTN","BMXSQL",75,0) + . S:BMXTOT Q:BMXCNT>BMXMAX I $D(^DD(D0)) D TLIST1 +"RTN","BMXSQL",77,0) + I +BMXFROM'=BMXFROM D ;F is a filename or is null +"RTN","BMXSQL",78,0) + . S F="",T="zzzzzzz" +"RTN","BMXSQL",79,0) + . S:$G(BMXFROM)]"" F=$O(^DIC("B",BMXFROM),-1) +"RTN","BMXSQL",80,0) + . S:$G(BMXTO)]"" T=BMXTO +"RTN","BMXSQL",81,0) + . F S F=$O(^DIC("B",F)) Q:F="" Q:F]T Q:BMXCNT>BMXMAX D +"RTN","BMXSQL",82,0) + . . S D0=0 F S D0=$O(^DIC("B",F,D0)) Q:'+D0 D TLIST1 +"RTN","BMXSQL",83,0) + ; +"RTN","BMXSQL",84,0) + S I=I+1,^BMXTEMP($J,I)=$C(31) +"RTN","BMXSQL",85,0) + Q +"RTN","BMXSQL",86,0) + ; +"RTN","BMXSQL",87,0) +TLIST1 ; +"RTN","BMXSQL",88,0) + I BMXU="@" X BMXSET Q +"RTN","BMXSQL",89,0) + Q:$D(^DIC(D0,0))'=11 +"RTN","BMXSQL",90,0) + S A=$G(^DIC(D0,0,"RD")) +"RTN","BMXSQL",91,0) + I $D(^VA(200,DUZ,"FOF",D0,0)) D Q +"RTN","BMXSQL",92,0) + . ;I $P(^(0),U,5)="1" X BMXSET Q +"RTN","BMXSQL",93,0) + . I $P(^VA(200,DUZ,"FOF",D0,0),U,5)="1" X BMXSET Q +"RTN","BMXSQL",94,0) + F J=1:1:$L(A) I DUZ(0)[$E(A,J) X BMXSET +"RTN","BMXSQL",95,0) + Q +"RTN","BMXSQL",96,0) + ; +"RTN","BMXSQL",97,0) +SQLCOL(BMXGBL,BMXSQL) ;EP +"RTN","BMXSQL",98,0) + D INTSQL(.BMXGBL,.BMXSQL,1) +"RTN","BMXSQL",99,0) + Q +"RTN","BMXSQL",100,0) + ; +"RTN","BMXSQL",101,0) +SQLD(BMXGBL,BMXSQL) ;EP Serenji Debug Entrypoint +"RTN","BMXSQL",102,0) + D DEBUG^%Serenji("SQL^BMXSQL(.BMXGBL,.BMXSQL)","10.10.10.104") +"RTN","BMXSQL",103,0) + Q +"RTN","BMXSQL",104,0) + ; +"RTN","BMXSQL",105,0) +SQL(BMXGBL,BMXSQL) ;EP +"RTN","BMXSQL",106,0) + D INTSQL(.BMXGBL,.BMXSQL,0) +"RTN","BMXSQL",107,0) + Q +"RTN","BMXSQL",108,0) + ; +"RTN","BMXSQL",109,0) +INTSQL(BMXGBL,BMXSQL,BMXCOL) ;EP +"RTN","BMXSQL",110,0) + ; +"RTN","BMXSQL",111,0) + ;SQL Top Wait for debug break +"RTN","BMXSQL",112,0) + ;D +"RTN","BMXSQL",113,0) + ;. F J=1:1:10 S K=$H H 1 +"RTN","BMXSQL",114,0) + ;. Q +"RTN","BMXSQL",115,0) + ; +"RTN","BMXSQL",116,0) + S X="ERRTRAP^BMXSQL",@^%ZOSF("TRAP") +"RTN","BMXSQL",117,0) + I $G(BMXSQL)="" S BMXSQL="" D +"RTN","BMXSQL",118,0) + . N C S C=0 F S C=$O(BMXSQL(C)) Q:'+C D +"RTN","BMXSQL",119,0) + . . S BMXSQL=BMXSQL_BMXSQL(C) +"RTN","BMXSQL",120,0) + ; +"RTN","BMXSQL",121,0) + I BMXSQL["call SHAPE" S BMXSQL="SELECT JUNKNAME, MULTCOLOR FROM JUNKMULT" +"RTN","BMXSQL",122,0) + ; Global-scope variables +"RTN","BMXSQL",123,0) + K BMXTK +"RTN","BMXSQL",124,0) + N BMXF,BMXTK,T,BMXFLD,BMXTMP,BMXM,BMXXMAX,BMXFLDN,BMXV +"RTN","BMXSQL",125,0) + N BMXX,BMXFG,BMXFF,BMXSCR,BMXPFP +"RTN","BMXSQL",126,0) + N BMXERR,BMXFLDO,BMXFLDOX,BMXFJ,BMXFO,BMXFNX +"RTN","BMXSQL",127,0) + N BMXMFL,BMXFLDA +"RTN","BMXSQL",128,0) + D ^XBKVAR +"RTN","BMXSQL",129,0) + S U="^" +"RTN","BMXSQL",130,0) + I $D(^%ZOSF("MAXSIZ")) S X=640 X ^%ZOSF("MAXSIZ") +"RTN","BMXSQL",131,0) + K ^BMXTMP($J),^BMXTEMP($J),^BMXTMPD($J) +"RTN","BMXSQL",132,0) + S BMXGBL="^BMXTEMP("_$J_")" +"RTN","BMXSQL",133,0) + ;Remove CR and LF from BMXSQL +"RTN","BMXSQL",134,0) + S BMXSQL=$TR(BMXSQL,$C(13)," ") +"RTN","BMXSQL",135,0) + S BMXSQL=$TR(BMXSQL,$C(10)," ") +"RTN","BMXSQL",136,0) + S BMXSQL=$TR(BMXSQL,$C(9)," ") +"RTN","BMXSQL",137,0) + S BMXSQL=$TR(BMXSQL,$C(34),"") +"RTN","BMXSQL",138,0) + D PARSE^BMXPRS(BMXSQL) +"RTN","BMXSQL",139,0) + S BMXXMAX=1000000 ;Default Maximum records to return. +"RTN","BMXSQL",140,0) + D KW^BMXSQL1(.BMXTK) +"RTN","BMXSQL",141,0) + Q:$D(BMXERR) +"RTN","BMXSQL",142,0) + ; +"RTN","BMXSQL",143,0) + ;Get file names into BMXF("NAME")="NUMBER" +"RTN","BMXSQL",144,0) + ;Get file numbers into BMXFNX(NUMBER)="NAME" +"RTN","BMXSQL",145,0) + ; Files are ordered in BMXFO(order)="NUMBER" +"RTN","BMXSQL",146,0) + ; +"RTN","BMXSQL",147,0) +FROM S T=$G(BMXTK("FROM")) +"RTN","BMXSQL",148,0) + I '+T S BMXERR="'FROM' CLAUSE NOT FOUND" D ERROR Q +"RTN","BMXSQL",149,0) + S BMXF=0 +"RTN","BMXSQL",150,0) + F S T=$O(BMXTK(T)) Q:'+T Q:T=$G(BMXTK("WHERE")) Q:T=$G(BMXTK("ORDER BY")) Q:T=$G(BMXTK("GROUP BY")) D Q:$D(BMXERR) +"RTN","BMXSQL",151,0) + . Q:BMXTK(T)="," +"RTN","BMXSQL",152,0) + . N BMXFNT +"RTN","BMXSQL",153,0) + . I BMXTK(T)["'" S BMXTK(T)=$P(BMXTK(T),"'",2) +"RTN","BMXSQL",154,0) + . S BMXTK(T)=$TR(BMXTK(T),"_"," ") +"RTN","BMXSQL",155,0) + . I '(BMXTK(T)?.N),'$D(^DIC("B",BMXTK(T))) S BMXERR="FILE NOT FOUND" D ERROR Q +"RTN","BMXSQL",156,0) + . S BMXF=BMXF+1 +"RTN","BMXSQL",157,0) + . I BMXTK(T)?.N S BMXFNT=BMXTK(T) +"RTN","BMXSQL",158,0) + . E S BMXFNT=$O(^DIC("B",BMXTK(T),0)) +"RTN","BMXSQL",159,0) + . S BMXMFL(BMXFNT,"GLOC")=^DIC(BMXFNT,0,"GL") +"RTN","BMXSQL",160,0) + . D F1(BMXF,BMXTK(T),BMXFNT) +"RTN","BMXSQL",161,0) + . I '+BMXF(BMXTK(T)) S BMXERR="FILE NUMBER NOT FOUND" D ERROR Q +"RTN","BMXSQL",162,0) + . D ;Test alias +"RTN","BMXSQL",163,0) + . . Q:'+$O(BMXTK(T)) +"RTN","BMXSQL",164,0) + . . N V +"RTN","BMXSQL",165,0) + . . S V=T+1 +"RTN","BMXSQL",166,0) + . . Q:$G(BMXTK(V))="," +"RTN","BMXSQL",167,0) + . . Q:V=$G(BMXTK("WHERE")) +"RTN","BMXSQL",168,0) + . . Q:V=$G(BMXTK("ORDER BY")) +"RTN","BMXSQL",169,0) + . . Q:V=$G(BMXTK("GROUP BY")) +"RTN","BMXSQL",170,0) + . . S BMXTK(T,"ALIAS")=BMXTK(V) +"RTN","BMXSQL",171,0) + . . K BMXTK(V) +"RTN","BMXSQL",172,0) + . . Q +"RTN","BMXSQL",173,0) + . Q +"RTN","BMXSQL",174,0) + ; +"RTN","BMXSQL",175,0) + D SELECT^BMXSQL5 +"RTN","BMXSQL",176,0) + I $D(BMXERR) G END +"RTN","BMXSQL",177,0) + D POST2^BMXPRS ;Remove commas from BMXTK +"RTN","BMXSQL",178,0) + D KW^BMXSQL1(.BMXTK) +"RTN","BMXSQL",179,0) + ; +"RTN","BMXSQL",180,0) + D WHERE^BMXSQL7 +"RTN","BMXSQL",181,0) + ; +"RTN","BMXSQL",182,0) + ;Find the first WHERE field that has an index +"RTN","BMXSQL",183,0) + I $D(BMXERR) G END +"RTN","BMXSQL",184,0) + ; +"RTN","BMXSQL",185,0) + D INDEX(.BMXFF,.BMXX,.BMXTMP) +"RTN","BMXSQL",186,0) + ; +"RTN","BMXSQL",187,0) + S:BMXTMP BMXX=BMXTMP +"RTN","BMXSQL",188,0) + ; +"RTN","BMXSQL",189,0) + ;Set up screen logic for where fields +"RTN","BMXSQL",190,0) + D SCREEN^BMXSQL1 +"RTN","BMXSQL",191,0) + D SETX^BMXSQL2(.BMXX,.BMXFG,.BMXSCR) +"RTN","BMXSQL",192,0) + ; +"RTN","BMXSQL",193,0) + ; +"RTN","BMXSQL",194,0) +EXEC ;Execute enumerator and screen code to call Output routine +"RTN","BMXSQL",195,0) + ; +"RTN","BMXSQL",196,0) + N BMXOUT,J,BMXC +"RTN","BMXSQL",197,0) + S BMXOUT=0 +"RTN","BMXSQL",198,0) + ;Debug lines (retain): +"RTN","BMXSQL",199,0) + ;K ^HW("BMXX") S J=0 F S J=$O(BMXX(J)) Q:'+J S ^HW("BMXX",J)=BMXX(J) +"RTN","BMXSQL",200,0) + ;K ^HW("BMXSCR") S ^HW("BMXSCR")=$G(BMXSCR) S J=0 F S J=$O(BMXSCR(J)) Q:'+J S ^HW("BMXSCR",J)=BMXSCR(J) +"RTN","BMXSQL",201,0) + ;Test for SHOWPLAN +"RTN","BMXSQL",202,0) + I $G(BMXTK("SHOWPLAN"))="TRUE" D WPLAN Q +"RTN","BMXSQL",203,0) + S BMXM=0 +"RTN","BMXSQL",204,0) + I 'BMXCOL S J=0 F S J=$O(BMXX(J)) Q:'+J D Q:BMXM>BMXXMAX +"RTN","BMXSQL",205,0) + . X BMXX(J) +"RTN","BMXSQL",206,0) + ; +"RTN","BMXSQL",207,0) + D WRITE^BMXSQL6 +"RTN","BMXSQL",208,0) + ; +"RTN","BMXSQL",209,0) +END Q +"RTN","BMXSQL",210,0) + ; +"RTN","BMXSQL",211,0) + ; +"RTN","BMXSQL",212,0) +F1(BMXC,BMXNAM,BMXNUM) ;EP +"RTN","BMXSQL",213,0) + S BMXF(BMXNAM)=BMXNUM +"RTN","BMXSQL",214,0) + S BMXFNX(BMXNUM)=BMXNAM +"RTN","BMXSQL",215,0) + S BMXFO(BMXC)=BMXF(BMXNAM) +"RTN","BMXSQL",216,0) + Q +"RTN","BMXSQL",217,0) + ; +"RTN","BMXSQL",218,0) +OUT ;Set result in ^BMXTMP +"RTN","BMXSQL",219,0) + S BMXOUT=BMXOUT+1 +"RTN","BMXSQL",220,0) + S ^BMXTMP($J,"O",D0)="" +"RTN","BMXSQL",221,0) + S ^BMXTMP($J,BMXOUT)=D0 +"RTN","BMXSQL",222,0) + S BMXM=BMXM+1 +"RTN","BMXSQL",223,0) + Q +"RTN","BMXSQL",224,0) + ; +"RTN","BMXSQL",225,0) +WPLAN ;Write execution plan +"RTN","BMXSQL",226,0) + ;Set up Column Names +"RTN","BMXSQL",227,0) + N BMXLEN,BMXTYP,BMXT,J,BMXSCRT,BMXXT +"RTN","BMXSQL",228,0) + S I=1 +"RTN","BMXSQL",229,0) + F BMXT="VARIABLE^","VALUE"_$C(30) D +"RTN","BMXSQL",230,0) + . S ^BMXTEMP($J,I)=BMXT,BMXLEN(I)=15,BMXTYP(I)="T" +"RTN","BMXSQL",231,0) + . S I=I+1 +"RTN","BMXSQL",232,0) + S J=0 +"RTN","BMXSQL",233,0) + I $D(BMXX) F S J=$O(BMXX(J)) Q:'+J D +"RTN","BMXSQL",234,0) + . S ^BMXTEMP($J,I)="INDEX("_J_")^" +"RTN","BMXSQL",235,0) + . S I=I+1 +"RTN","BMXSQL",236,0) + . S BMXXT(J)=BMXX(J) +"RTN","BMXSQL",237,0) + . S BMXXT(J)=$P(BMXXT(J)," X BMXSCR") +"RTN","BMXSQL",238,0) + . S ^BMXTEMP($J,I)=$TR(BMXXT(J),"^","~")_$C(30) +"RTN","BMXSQL",239,0) + . S:$L(^BMXTEMP($J,I))>BMXLEN(2) BMXLEN(2)=$L(^BMXTEMP($J,I)) +"RTN","BMXSQL",240,0) + . S I=I+1 +"RTN","BMXSQL",241,0) + S ^BMXTEMP($J,I)="SCREEN^" +"RTN","BMXSQL",242,0) + S I=I+1 +"RTN","BMXSQL",243,0) + S BMXSCRT=$G(BMXSCR) +"RTN","BMXSQL",244,0) + S BMXSCRT=$P(BMXSCRT,"D:'$D(^BMXTMP") +"RTN","BMXSQL",245,0) + S ^BMXTEMP($J,I)=$TR(BMXSCRT,"^","~")_$C(30) +"RTN","BMXSQL",246,0) + S:$L(^BMXTEMP($J,I))>BMXLEN(2) BMXLEN(2)=$L(^BMXTEMP($J,I)) +"RTN","BMXSQL",247,0) + S I=I+1 +"RTN","BMXSQL",248,0) + S J=0 +"RTN","BMXSQL",249,0) + I $D(BMXSCR("C")) F S J=$O(BMXSCR("C",J)) Q:'+J D +"RTN","BMXSQL",250,0) + . S ^BMXTEMP($J,I)="SCREEN("_J_")^" +"RTN","BMXSQL",251,0) + . S I=I+1 +"RTN","BMXSQL",252,0) + . S ^BMXTEMP($J,I)=$TR(BMXSCR("C",J),"^","~")_$C(30) +"RTN","BMXSQL",253,0) + . S:$L(^BMXTEMP($J,I))>BMXLEN(2) BMXLEN(2)=$L(^BMXTEMP($J,I)) +"RTN","BMXSQL",254,0) + . S I=I+1 +"RTN","BMXSQL",255,0) + D COLTYPE +"RTN","BMXSQL",256,0) + S I=I+1 +"RTN","BMXSQL",257,0) + D ERRTACK(I) +"RTN","BMXSQL",258,0) + Q +"RTN","BMXSQL",259,0) + ; +"RTN","BMXSQL",260,0) + ; +"RTN","BMXSQL",261,0) +COLTYPE ;EP - Append column types and widths to output global +"RTN","BMXSQL",262,0) + ;REQUIRES - BMXLEN(),BMXTYP(),^BMXTEMP +"RTN","BMXSQL",263,0) + ;IHS/SET/HMW 4-22-2004 Modified to use new schema string +"RTN","BMXSQL",264,0) + ; +"RTN","BMXSQL",265,0) + ;"@@@meta@@@BMXIEN|FILE #|DA STRING" +"RTN","BMXSQL",266,0) + ; +"RTN","BMXSQL",267,0) + N C +"RTN","BMXSQL",268,0) + S C=0 +"RTN","BMXSQL",269,0) + F S C=$O(BMXLEN(C)) Q:'C D +"RTN","BMXSQL",270,0) + . I BMXLEN(C)>99999 S BMXLEN(C)=99999 +"RTN","BMXSQL",271,0) + . I BMXLEN(C)=0 S BMXLEN(C)=50 ;Default column length +"RTN","BMXSQL",272,0) + . S ^BMXTEMP($J,C)=BMXTYP(C)_$$NUMCHAR(BMXLEN(C))_^BMXTEMP($J,C) +"RTN","BMXSQL",273,0) + Q +"RTN","BMXSQL",274,0) + ; +"RTN","BMXSQL",275,0) + ;S ^BXTEMP($J,0)="@@@meta@@@BMXIEN|"_BMXF_"|" ;Last |-piece will be DA string +"RTN","BMXSQL",276,0) + ;N C +"RTN","BMXSQL",277,0) + ;S C=0 +"RTN","BMXSQL",278,0) + ;F S C=$O(BMXLEN(C)) Q:'C D +"RTN","BMXSQL",279,0) + ;. I BMXLEN(C)>99999 S BMXLEN(C)=99999 +"RTN","BMXSQL",280,0) + ;. I BMXLEN(C)=0 S BMXLEN(C)=50 ;Default column length +"RTN","BMXSQL",281,0) + ;. S ^BMXTEMP($J,C)=BMXTYP(C)_$$NUMCHAR(BMXLEN(C))_^BMXTEMP($J,C) +"RTN","BMXSQL",282,0) + ;Q +"RTN","BMXSQL",283,0) + ; +"RTN","BMXSQL",284,0) +ERRTACK(I) ;EP +"RTN","BMXSQL",285,0) + ; +"RTN","BMXSQL",286,0) + S ^BMXTEMP($J,I)=$C(31) +"RTN","BMXSQL",287,0) + S:$D(BMXERR) ^BMXTEMP($J,I)=^BMXTEMP($J,I)_BMXERR +"RTN","BMXSQL",288,0) + Q +"RTN","BMXSQL",289,0) + ; +"RTN","BMXSQL",290,0) +NUMCHAR(BMXN) ;EP +"RTN","BMXSQL",291,0) + ;---> Returns Field Length left-padded with 0 +"RTN","BMXSQL",292,0) + ; +"RTN","BMXSQL",293,0) + N BMXC +"RTN","BMXSQL",294,0) + S BMXC="00000"_BMXN +"RTN","BMXSQL",295,0) + Q $E(BMXC,$L(BMXC)-4,$L(BMXC)) +"RTN","BMXSQL",296,0) + ; +"RTN","BMXSQL",297,0) + ; +"RTN","BMXSQL",298,0) +INDEX(BMXFF,BMXRET,BMXXCNT) ; +"RTN","BMXSQL",299,0) + ;Returns executable enumerator on first where field with an index +"RTN","BMXSQL",300,0) + ;or "" if no indexed where field +"RTN","BMXSQL",301,0) + ;IN: BMXFF() +"RTN","BMXSQL",302,0) + ;OUT: BMXRET() +"RTN","BMXSQL",303,0) + ; BMXXCNT - size of BMXRET array +"RTN","BMXSQL",304,0) + ; +"RTN","BMXSQL",305,0) + N F,BMXNOD,BMXFNUM,BMXFLDNUM,BMXHIT,BMXREF,BMXRNAM,BMXOP,Q,BMXGL +"RTN","BMXSQL",306,0) + N BMXTMP,BMXTMPV,BMXTMPI,BMXTMPL,BMXTMPN,BMXV,BMXRNOD,BMXTMPP +"RTN","BMXSQL",307,0) + S BMXXCNT=0 +"RTN","BMXSQL",308,0) + S Q=$C(34) +"RTN","BMXSQL",309,0) + I 'BMXFF Q +"RTN","BMXSQL",310,0) + S F=0,BMXHIT=0 +"RTN","BMXSQL",311,0) + ; +"RTN","BMXSQL",312,0) + ;--->Search BMXFF for special case WHERE clause 1 = "0" +"RTN","BMXSQL",313,0) + ; reset BMXX(1) to return no records +"RTN","BMXSQL",314,0) + F F=1:1:BMXFF S BMXNOD=BMXFF(F) D Q:$D(BMXERR) Q:BMXHIT +"RTN","BMXSQL",315,0) + . I ($P(BMXFF(F),"^",2,4)="1^=^0")!($P(BMXFF(F),"^",2,4)="0^=^1") S BMXRET(1)="Q ",BMXHIT=1,BMXXCNT=1 +"RTN","BMXSQL",316,0) + . Q +"RTN","BMXSQL",317,0) + Q:BMXHIT +"RTN","BMXSQL",318,0) + ; +"RTN","BMXSQL",319,0) + ;Organize the first level into AND- and OR-parts +"RTN","BMXSQL",320,0) + N BMXR1,BMXR2,BMXE,BMXR3,BMXRNAM +"RTN","BMXSQL",321,0) + N BMXSTOP,BMXOR +"RTN","BMXSQL",322,0) + D PLEVEL^BMXSQL3(.BMXFF,.BMXR1,.BMXR2) +"RTN","BMXSQL",323,0) + ; +"RTN","BMXSQL",324,0) + N BMXPFF S BMXPFF=0 +"RTN","BMXSQL",325,0) + S BMXR3=0 +"RTN","BMXSQL",326,0) + ;Look for an AND-part with only one element. +"RTN","BMXSQL",327,0) + ; If found, build an iterator on it and quit +"RTN","BMXSQL",328,0) + F J=1:1:$L(BMXR2,"&") D Q:BMXHIT +"RTN","BMXSQL",329,0) + . S BMXE=$P(BMXR2,"&",J) +"RTN","BMXSQL",330,0) + . I +BMXE=BMXE,BMXR1(BMXE,"ELEMENTS")=1 D +"RTN","BMXSQL",331,0) + . . ;Test index for element +"RTN","BMXSQL",332,0) + . . F K=BMXR1(BMXE,"BEGIN"):1:BMXR1(BMXE,"END") I "(^)"'[BMXFF(K) D Q ;I'm not sure why this quit was here +"RTN","BMXSQL",333,0) + . . . Q:$D(BMXFF(K,"JOIN")) +"RTN","BMXSQL",334,0) + . . . S BMXPFP=K,BMXPFF=0 +"RTN","BMXSQL",335,0) + . . . D XRTST^BMXSQL3(.BMXFF,K,.BMXR3,.BMXRNAM,.BMXPFP) +"RTN","BMXSQL",336,0) + . . . I BMXR3 S BMXHIT=1,BMXFF(K,"INDEXED")=1 +"RTN","BMXSQL",337,0) + . Q:'BMXHIT +"RTN","BMXSQL",338,0) + . ;Build iterator and quit +"RTN","BMXSQL",339,0) + . D BLDIT^BMXSQL3(.BMXFF,K,.BMXRNAM,.BMXOR,.BMXPFP) +"RTN","BMXSQL",340,0) + . S BMXXCNT=1 +"RTN","BMXSQL",341,0) + . S BMXRET(BMXXCNT)=BMXOR +"RTN","BMXSQL",342,0) + . Q +"RTN","BMXSQL",343,0) + Q:BMXHIT +"RTN","BMXSQL",344,0) + ; +"RTN","BMXSQL",345,0) + ;None of the single-element AND parts has a good index or +"RTN","BMXSQL",346,0) + ; there are no single-element AND parts +"RTN","BMXSQL",347,0) + ;If there are no OR-parts, then there are no good indexes so quit +"RTN","BMXSQL",348,0) + I $L(BMXR2,"!")=1 Q +"RTN","BMXSQL",349,0) + ; +"RTN","BMXSQL",350,0) + ;Test each OR-part for a good index. +"RTN","BMXSQL",351,0) + ;If an OR-part is multi-element or +"RTN","BMXSQL",352,0) + ;if one OR-part doesn't have an index +"RTN","BMXSQL",353,0) + ;then set up to do a table scan and quit +"RTN","BMXSQL",354,0) + S BMXSTOP=0 +"RTN","BMXSQL",355,0) + F J=1:1:$L(BMXR2,"!") D Q:BMXSTOP +"RTN","BMXSQL",356,0) + . S BMXE=$P(BMXR2,"!",J) +"RTN","BMXSQL",357,0) + . I +BMXE=BMXE D +"RTN","BMXSQL",358,0) + . . I BMXR1(BMXE,"ELEMENTS")'=1 S BMXSTOP=1 Q ;Multiple elements +"RTN","BMXSQL",359,0) + . . ;Test index elements +"RTN","BMXSQL",360,0) + . . F K=BMXR1(BMXE,"BEGIN"):1:BMXR1(BMXE,"END") I "(^)"'[BMXFF(K) D Q +"RTN","BMXSQL",361,0) + . . . S BMXPFP=K,BMXPFF=0 +"RTN","BMXSQL",362,0) + . . . D XRTST^BMXSQL3(.BMXFF,K,.BMXR3,.BMXRNAM,.BMXPFP) +"RTN","BMXSQL",363,0) + . . . I 'BMXR3 S BMXSTOP=1 Q +"RTN","BMXSQL",364,0) + . . . S BMXFF(K,"INDEXED")=1 +"RTN","BMXSQL",365,0) + . . . S BMXR1(BMXE,"XREF")=BMXRNAM +"RTN","BMXSQL",366,0) + ; +"RTN","BMXSQL",367,0) + ;Build iterator and quit +"RTN","BMXSQL",368,0) + I BMXSTOP D Q ;One of the elements had no index +"RTN","BMXSQL",369,0) + . S J=0 F S J=$O(BMXFF(J)) Q:'+J K BMXFF(J,"INDEXED") +"RTN","BMXSQL",370,0) + S BMXXCNT=0 +"RTN","BMXSQL",371,0) + F J=1:1:$L(BMXR2,"!") D +"RTN","BMXSQL",372,0) + . S BMXE=$P(BMXR2,"!",J) +"RTN","BMXSQL",373,0) + . I +BMXE=BMXE,BMXR1(BMXE,"ELEMENTS")=1 D +"RTN","BMXSQL",374,0) + . . F K=BMXR1(BMXE,"BEGIN"):1:BMXR1(BMXE,"END") I "(^)"'[BMXFF(K) D Q +"RTN","BMXSQL",375,0) + . . . D BLDIT^BMXSQL3(.BMXFF,K,BMXR1(BMXE,"XREF"),.BMXOR,.BMXPFP) +"RTN","BMXSQL",376,0) + . . . S BMXXCNT=BMXXCNT+1 +"RTN","BMXSQL",377,0) + . . . S BMXRET(BMXXCNT)=BMXOR +"RTN","BMXSQL",378,0) + . Q +"RTN","BMXSQL",379,0) + Q +"RTN","BMXSQL",380,0) + ; +"RTN","BMXSQL",381,0) + ; +"RTN","BMXSQL",382,0) + ; +"RTN","BMXSQL",383,0) +ERROR ;EP - Error processing +"RTN","BMXSQL",384,0) + ;W !,BMXERR +"RTN","BMXSQL",385,0) + ;N A +"RTN","BMXSQL",386,0) + ;S A=0 +"RTN","BMXSQL",387,0) + ;I $D(I) S A=I +"RTN","BMXSQL",388,0) + ;D ERROUT(BMXERR,A) +"RTN","BMXSQL",389,0) + ;B ;ERROR in BMXSQL +"RTN","BMXSQL",390,0) + Q +"RTN","BMXSQL",391,0) + ; +"RTN","BMXSQL",392,0) +ERROUT(BMXERR,I) ;EP +"RTN","BMXSQL",393,0) + ;---> Save next line for Error Code File if ever used. +"RTN","BMXSQL",394,0) + ;---> If necessary, use I>1 to avoid overwriting valid data. +"RTN","BMXSQL",395,0) + D ERRTACK(I) +"RTN","BMXSQL",396,0) + Q +"RTN","BMXSQL",397,0) + ; +"RTN","BMXSQL",398,0) +ERRTRAP ; +"RTN","BMXSQL",399,0) + ; +"RTN","BMXSQL",400,0) + K ^BMXTEMP($J) +"RTN","BMXSQL",401,0) + S ^BMXTEMP($J,0)="T00030M_ERROR"_$C(30) +"RTN","BMXSQL",402,0) + S BMXZE=$$EC^%ZOSV +"RTN","BMXSQL",403,0) + S BMXZE=$TR(BMXZE,"^","~") +"RTN","BMXSQL",404,0) + S ^BMXTEMP($J,1)=BMXZE_$C(30) +"RTN","BMXSQL",405,0) + S ^BMXTEMP($J,2)=$C(31) +"RTN","BMXSQL",406,0) + Q +"RTN","BMXSQL1") +0^98^B112955506 +"RTN","BMXSQL1",1,0) +BMXSQL1 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; +"RTN","BMXSQL1",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXSQL1",3,0) + ; +"RTN","BMXSQL1",4,0) + ; +"RTN","BMXSQL1",5,0) +KW(BMXTK) ;EP +"RTN","BMXSQL1",6,0) + ;Identify and mark keywords in BMXTK +"RTN","BMXSQL1",7,0) + ;MODIFIES BMXTK +"RTN","BMXSQL1",8,0) + ; +"RTN","BMXSQL1",9,0) + N J,BMXSTOP,BMXTMP +"RTN","BMXSQL1",10,0) + ;Combine ORDER BY and GROUP BY into a single token +"RTN","BMXSQL1",11,0) + ; +"RTN","BMXSQL1",12,0) + S J=0 +"RTN","BMXSQL1",13,0) + F S J=$O(BMXTK(J)) Q:'+J D +"RTN","BMXSQL1",14,0) + . S BMXTMP=$$UCASE(BMXTK(J)) +"RTN","BMXSQL1",15,0) + . I BMXTMP="ORDER"!(BMXTMP="GROUP") D +"RTN","BMXSQL1",16,0) + . . I $D(BMXTK(J+1)),$$UCASE(BMXTK(J+1))="BY" D +"RTN","BMXSQL1",17,0) + . . . S BMXTK(J)=BMXTK(J)_" "_BMXTK(J+1) +"RTN","BMXSQL1",18,0) + . . . S BMXTK(J)=$$UCASE(BMXTK(J)) +"RTN","BMXSQL1",19,0) + . . . S BMXTK(BMXTK(J))=J +"RTN","BMXSQL1",20,0) + . . . K BMXTK(J+1) +"RTN","BMXSQL1",21,0) + . . . Q +"RTN","BMXSQL1",22,0) + . . Q +"RTN","BMXSQL1",23,0) + . Q +"RTN","BMXSQL1",24,0) + ; +"RTN","BMXSQL1",25,0) + ;Find SELECT +"RTN","BMXSQL1",26,0) + S J=0,BMXSTOP=0 +"RTN","BMXSQL1",27,0) + F S J=$O(BMXTK(J)) Q:'+J D Q:BMXSTOP +"RTN","BMXSQL1",28,0) + . I $$UCASE(BMXTK(J))="SELECT" D +"RTN","BMXSQL1",29,0) + . . S BMXTK(J)=$$UCASE(BMXTK(J)) +"RTN","BMXSQL1",30,0) + . . S BMXTK("SELECT")=J +"RTN","BMXSQL1",31,0) + . . S BMXSTOP=1 +"RTN","BMXSQL1",32,0) + . . Q +"RTN","BMXSQL1",33,0) + . Q +"RTN","BMXSQL1",34,0) + I '+J S BMXERR="SELECT KEYWORD NOT FOUND" Q +"RTN","BMXSQL1",35,0) + ; +"RTN","BMXSQL1",36,0) + ;DISTINCT +"RTN","BMXSQL1",37,0) + S BMXSTOP=0 +"RTN","BMXSQL1",38,0) + F S J=$O(BMXTK(J)) Q:'+J Q:$$UCASE(BMXTK(J))="FROM" D Q:BMXSTOP +"RTN","BMXSQL1",39,0) + . I $$UCASE(BMXTK(J))="DISTINCT" D +"RTN","BMXSQL1",40,0) + . . S BMXTK("DISTINCT")="TRUE" +"RTN","BMXSQL1",41,0) + . . K BMXTK(J) +"RTN","BMXSQL1",42,0) + . . S J=J-1 +"RTN","BMXSQL1",43,0) + . . S BMXSTOP=1 +"RTN","BMXSQL1",44,0) + . Q +"RTN","BMXSQL1",45,0) + ; +"RTN","BMXSQL1",46,0) + ;FROM +"RTN","BMXSQL1",47,0) + S BMXSTOP=0 +"RTN","BMXSQL1",48,0) + S J=J-1 +"RTN","BMXSQL1",49,0) + F S J=$O(BMXTK(J)) Q:'+J Q:$$UCASE(BMXTK(J))="WHERE" D Q:BMXSTOP +"RTN","BMXSQL1",50,0) + . I $$UCASE(BMXTK(J))="FROM" D +"RTN","BMXSQL1",51,0) + . . S BMXTK(J)=$$UCASE(BMXTK(J)) +"RTN","BMXSQL1",52,0) + . . S BMXTK("FROM")=J +"RTN","BMXSQL1",53,0) + . . S BMXSTOP=1 +"RTN","BMXSQL1",54,0) + . . Q +"RTN","BMXSQL1",55,0) + . Q +"RTN","BMXSQL1",56,0) + ; +"RTN","BMXSQL1",57,0) + I '$D(BMXTK("FROM")) S BMXERR="'FROM' KEYWORD NOT FOUND" Q +"RTN","BMXSQL1",58,0) + ; +"RTN","BMXSQL1",59,0) + ;WHERE +"RTN","BMXSQL1",60,0) + S BMXSTOP=0 +"RTN","BMXSQL1",61,0) + F S J=$O(BMXTK(J)) Q:'+J Q:BMXTK(J)="ORDER BY" Q:BMXTK(J)="GROUP BY" D Q:BMXSTOP +"RTN","BMXSQL1",62,0) + . I $$UCASE(BMXTK(J))="WHERE" D +"RTN","BMXSQL1",63,0) + . . S BMXTK(J)=$$UCASE(BMXTK(J)) +"RTN","BMXSQL1",64,0) + . . S BMXTK("WHERE")=J +"RTN","BMXSQL1",65,0) + . . S BMXSTOP=1 +"RTN","BMXSQL1",66,0) + . Q +"RTN","BMXSQL1",67,0) + ; +"RTN","BMXSQL1",68,0) + ;SHOWPLAN +"RTN","BMXSQL1",69,0) + S J=BMXTK("FROM") +"RTN","BMXSQL1",70,0) + S BMXSTOP=0 +"RTN","BMXSQL1",71,0) + F S J=$O(BMXTK(J)) Q:'+J D Q:BMXSTOP +"RTN","BMXSQL1",72,0) + . I $$UCASE(BMXTK(J))="SHOWPLAN" D +"RTN","BMXSQL1",73,0) + . . S BMXTK("SHOWPLAN")="TRUE" +"RTN","BMXSQL1",74,0) + . . K BMXTK(J) +"RTN","BMXSQL1",75,0) + . . S J=J-1 +"RTN","BMXSQL1",76,0) + . . S BMXSTOP=1 +"RTN","BMXSQL1",77,0) + . Q +"RTN","BMXSQL1",78,0) + ; +"RTN","BMXSQL1",79,0) + ;MAXRECORDS +"RTN","BMXSQL1",80,0) + S J=BMXTK("FROM") +"RTN","BMXSQL1",81,0) + S BMXSTOP=0 +"RTN","BMXSQL1",82,0) + F S J=$O(BMXTK(J)) Q:'+J D Q:BMXSTOP +"RTN","BMXSQL1",83,0) + . I $$UCASE(BMXTK(J))["MAXRECORDS" D +"RTN","BMXSQL1",84,0) + . . S BMXXMAX=+$P(BMXTK(J),":",2)-1 +"RTN","BMXSQL1",85,0) + . . S:+BMXXMAX<0 BMXXMAX=0 +"RTN","BMXSQL1",86,0) + . . K BMXTK(J) +"RTN","BMXSQL1",87,0) + . . S J=J-1 +"RTN","BMXSQL1",88,0) + . . S BMXSTOP=1 +"RTN","BMXSQL1",89,0) + . Q +"RTN","BMXSQL1",90,0) + Q +"RTN","BMXSQL1",91,0) + ; +"RTN","BMXSQL1",92,0) +SCREEN ;EP +"RTN","BMXSQL1",93,0) + ;Set up BMXFG() array of executable screen code +"RTN","BMXSQL1",94,0) + N F,BMXNOD,BMXFNUM,BMXFLDNUM,BMXHIT,BMXREF +"RTN","BMXSQL1",95,0) + N BMXRNAM,BMXRET,BMXOP,Q,BMXPC,BMXV,BMXFLDLO,BMXFLDNO +"RTN","BMXSQL1",96,0) + N BMXGL +"RTN","BMXSQL1",97,0) + S BMXRET="" +"RTN","BMXSQL1",98,0) + S Q=$C(34) +"RTN","BMXSQL1",99,0) + S BMXFG=BMXFF +"RTN","BMXSQL1",100,0) + S BMXFG("C")=0 +"RTN","BMXSQL1",101,0) + I 'BMXFF Q +"RTN","BMXSQL1",102,0) + S F=0,BMXHIT=0 +"RTN","BMXSQL1",103,0) + F F=1:1:BMXFF S BMXNOD=BMXFF(F) D Q:$D(BMXERR) Q:BMXHIT +"RTN","BMXSQL1",104,0) + . I $G(BMXFF(F,"INDEXED"))=1 D Q +"RTN","BMXSQL1",105,0) + . . S BMXFG(F)="1" +"RTN","BMXSQL1",106,0) + . . Q +"RTN","BMXSQL1",107,0) + . I $D(BMXFF(F,"JOIN")) D Q +"RTN","BMXSQL1",108,0) + . . S BMXFG(F)="1" +"RTN","BMXSQL1",109,0) + . . Q +"RTN","BMXSQL1",110,0) + . I "(^)"[BMXFF(F) D Q +"RTN","BMXSQL1",111,0) + . . S BMXFG(F)=BMXFF(F) +"RTN","BMXSQL1",112,0) + . . Q +"RTN","BMXSQL1",113,0) + . I "AND^OR"[BMXFF(F) D Q +"RTN","BMXSQL1",114,0) + . . I BMXFF(F)="AND" S BMXFG(F)="&" Q +"RTN","BMXSQL1",115,0) + . . S BMXFG(F)="!" +"RTN","BMXSQL1",116,0) + . . Q +"RTN","BMXSQL1",117,0) + . S BMXFNUM=$S(+$P(BMXNOD,U):$P(BMXNOD,U),1:$O(^DIC("B",$P(BMXNOD,U),0))) +"RTN","BMXSQL1",118,0) + . I '+BMXFNUM D ;Not a fileman field +"RTN","BMXSQL1",119,0) + . . S BMXFLDNUM=0,BMXFLDNO="" +"RTN","BMXSQL1",120,0) + . . S BMXFLDLO=$P(BMXFF(F),U,2) +"RTN","BMXSQL1",121,0) + . . ; +"RTN","BMXSQL1",122,0) + . E D ;Get fileman field data +"RTN","BMXSQL1",123,0) + . . S BMXGL=^DIC(BMXFNUM,0,"GL") +"RTN","BMXSQL1",124,0) + . . I $D(BMXFF(F,"IEN")) D +"RTN","BMXSQL1",125,0) + . . . S BMXFLDNUM=".001" +"RTN","BMXSQL1",126,0) + . . . S BMXFLDNO="IEN" +"RTN","BMXSQL1",127,0) + . . E D +"RTN","BMXSQL1",128,0) + . . . S BMXFLDNUM=$O(^DD(BMXFNUM,"B",$P(BMXNOD,U,2),0)) +"RTN","BMXSQL1",129,0) + . . . S BMXFLDNO=^DD(BMXFNUM,BMXFLDNUM,0) +"RTN","BMXSQL1",130,0) + . I BMXFLDNO="IEN" D ;BMXIEN field +"RTN","BMXSQL1",131,0) + . . N BMXEXT,C S BMXEXT=0 +"RTN","BMXSQL1",132,0) + . . ;S BMXPC=$P(BMXFLDNO,U,4) +"RTN","BMXSQL1",133,0) + . . I $P(BMXFF(F),U,5)'=BMXFO(1) S BMXEXT=1 D EXP ;Extended pointer +"RTN","BMXSQL1",134,0) + . . S BMXFLDLO="D0" +"RTN","BMXSQL1",135,0) + . . I BMXEXT S BMXFG("C",C)=BMXFG("C",C)_BMXFLDLO,BMXFLDLO="BMXSCR(""X"","_C_")" +"RTN","BMXSQL1",136,0) + . I $P(BMXFLDNO,U,2)["D" D ;Date field +"RTN","BMXSQL1",137,0) + . . N BMXEXT,C S BMXEXT=0 +"RTN","BMXSQL1",138,0) + . . S BMXPC=$P(BMXFLDNO,U,4) +"RTN","BMXSQL1",139,0) + . . I $P(BMXFF(F),U,5)'=BMXFO(1) S BMXEXT=1 D EXP ;Extended pointer +"RTN","BMXSQL1",140,0) + . . S BMXFLDLO="$P($G("_BMXGL_"D0,"_Q_$P(BMXPC,";")_Q_")),U,"_$P(BMXPC,";",2)_")" +"RTN","BMXSQL1",141,0) + . . I BMXEXT S BMXFG("C",C)=BMXFG("C",C)_BMXFLDLO,BMXFLDLO="BMXSCR(""X"","_C_")" +"RTN","BMXSQL1",142,0) + . I $P(BMXFLDNO,U,2)["S" D ;Set field +"RTN","BMXSQL1",143,0) + . . N BMXEXT,C S BMXEXT=0 +"RTN","BMXSQL1",144,0) + . . S BMXPC=$P(BMXFLDNO,U,4) +"RTN","BMXSQL1",145,0) + . . I $P(BMXFF(F),U,5)'=BMXFO(1) S BMXEXT=1 D EXP ;Extended pointer +"RTN","BMXSQL1",146,0) + . . S BMXFLDLO="$P("_BMXGL_"D0,"_$P(BMXPC,";")_"),U,"_$P(BMXPC,";",2)_")" +"RTN","BMXSQL1",147,0) + . . I BMXEXT S BMXFG("C",C)=BMXFG("C",C)_BMXFLDLO,BMXFLDLO="BMXSCR(""X"","_C_")" +"RTN","BMXSQL1",148,0) + . ; +"RTN","BMXSQL1",149,0) + . I $P(BMXFLDNO,U,2)["P" D ;Pointer field +"RTN","BMXSQL1",150,0) + . . N C,BMXEXT +"RTN","BMXSQL1",151,0) + . . S BMXEXT=0 +"RTN","BMXSQL1",152,0) + . . I $P(BMXFF(F),U,5)'=BMXFO(1) D +"RTN","BMXSQL1",153,0) + . . . N R,G,BMXJN,BMXMSCR +"RTN","BMXSQL1",154,0) + . . . S BMXMXCR=1 ;Remove after testing. Find out if the field is from a subfile. +"RTN","BMXSQL1",155,0) + . . . I BMXMXCR D Q +"RTN","BMXSQL1",156,0) + . . . . ;Set up a screen in BMXSCR and in BMXMFL( +"RTN","BMXSQL1",157,0) + . . . . Q +"RTN","BMXSQL1",158,0) + . . . ; +"RTN","BMXSQL1",159,0) + . . . ;Find the node of BMXFF that has the join info +"RTN","BMXSQL1",160,0) + . . . S BMXEXT=1 +"RTN","BMXSQL1",161,0) + . . . S BMXFG("C")=BMXFG("C")+1 +"RTN","BMXSQL1",162,0) + . . . S C=BMXFG("C") +"RTN","BMXSQL1",163,0) + . . . S R=0 F S R=$O(BMXFJ("JOIN",R)) Q:'+R I R=$P(BMXFF(F),U,5) S G=BMXFJ("JOIN",R) Q +"RTN","BMXSQL1",164,0) + . . . S BMXJN=BMXFF(G,"JOIN") +"RTN","BMXSQL1",165,0) + . . . S BMXJN=$P(BMXJN,"IEN0",1)_"D0"_$P(BMXJN,"IEN0",2) +"RTN","BMXSQL1",166,0) + . . . S BMXJN="S X="""","_BMXFF(G,"JOIN","IEN")_"=D0 N D0 "_BMXJN_"I +D0 S X=" +"RTN","BMXSQL1",167,0) + . . . S BMXFG("C",C)=BMXJN +"RTN","BMXSQL1",168,0) + . . S BMXFLDLO=$$SCRNP(F,BMXGL,BMXFLDNUM,BMXFLDNO) +"RTN","BMXSQL1",169,0) + . . I BMXEXT S BMXFG("C",C)=BMXFG("C",C)_BMXFLDLO,BMXFLDLO="BMXSCR(""X"","_C_")" +"RTN","BMXSQL1",170,0) + . I $P(BMXFLDNO,U,2)["C" D ;Computed field +"RTN","BMXSQL1",171,0) + . . N C +"RTN","BMXSQL1",172,0) + . . S BMXPC=$P(BMXFLDNO,U,5,99) +"RTN","BMXSQL1",173,0) + . . S BMXFG("C")=BMXFG("C")+1 +"RTN","BMXSQL1",174,0) + . . S C=BMXFG("C") +"RTN","BMXSQL1",175,0) + . . ;If computed field not in primary file, connect navigation code +"RTN","BMXSQL1",176,0) + . . I $P(BMXFF(F),U,5)'=BMXFO(1) D +"RTN","BMXSQL1",177,0) + . . . ;Find the node of BMXFF that has the join info +"RTN","BMXSQL1",178,0) + . . . N R,G,BMXJN +"RTN","BMXSQL1",179,0) + . . . S R=0 F S R=$O(BMXFJ("JOIN",R)) Q:'+R I R=$P(BMXFF(F),U,5) S G=BMXFJ("JOIN",R) Q +"RTN","BMXSQL1",180,0) + . . . S BMXJN=BMXFF(G,"JOIN") +"RTN","BMXSQL1",181,0) + . . . S BMXJN=$P(BMXJN,"IEN0",1)_"D0"_$P(BMXJN,"IEN0",2) +"RTN","BMXSQL1",182,0) + . . . S BMXJN="S X="""","_BMXFF(G,"JOIN","IEN")_"=D0 N D0 "_BMXJN_"I +D0 " +"RTN","BMXSQL1",183,0) + . . . S BMXJN=BMXJN_BMXPC +"RTN","BMXSQL1",184,0) + . . . S BMXFF(F,0)=$P(BMXFF(F,0),U,1,4) +"RTN","BMXSQL1",185,0) + . . . S $P(BMXFF(F,0),U,5)=BMXJN +"RTN","BMXSQL1",186,0) + . . . S BMXPC=BMXJN +"RTN","BMXSQL1",187,0) + . . S BMXFG("C",C)=BMXPC +"RTN","BMXSQL1",188,0) + . . S BMXFLDLO="BMXSCR(""X"","_C_")" +"RTN","BMXSQL1",189,0) + . I $P(BMXFLDNO,U,2)["N" D ;Numeric field +"RTN","BMXSQL1",190,0) + . . N BMXEXT,C S BMXEXT=0 +"RTN","BMXSQL1",191,0) + . . S BMXPC=$P(BMXFLDNO,U,4) +"RTN","BMXSQL1",192,0) + . . I $P(BMXFF(F),U,5)'=BMXFO(1) S BMXEXT=1 D EXP ;Extended pointer +"RTN","BMXSQL1",193,0) + . . S BMXFLDLO="$P("_BMXGL_"D0,"_$P(BMXPC,";")_"),U,"_$P(BMXPC,";",2)_")" +"RTN","BMXSQL1",194,0) + . . I BMXEXT S BMXFG("C",C)=BMXFG("C",C)_BMXFLDLO,BMXFLDLO="BMXSCR(""X"","_C_")" +"RTN","BMXSQL1",195,0) + . ; +"RTN","BMXSQL1",196,0) + . I $P(BMXFLDNO,U,2)["F" D ;Free Text field +"RTN","BMXSQL1",197,0) + . . N BMXEXT,C S BMXEXT=0,C=0 +"RTN","BMXSQL1",198,0) + . . S BMXPC=$P(BMXFLDNO,U,4) +"RTN","BMXSQL1",199,0) + . . I $P(BMXFF(F),U,5)'=BMXFO(1) S BMXEXT=1 D +"RTN","BMXSQL1",200,0) + . . . N R,G,BMXJN +"RTN","BMXSQL1",201,0) + . . . S BMXFG("C")=BMXFG("C")+1 +"RTN","BMXSQL1",202,0) + . . . S C=BMXFG("C") +"RTN","BMXSQL1",203,0) + . . . S R=0 F S R=$O(BMXFJ("JOIN",R)) Q:'+R I R=$P(BMXFF(F),U,5) S G=BMXFJ("JOIN",R) Q +"RTN","BMXSQL1",204,0) + . . . S BMXJN=BMXFF(G,"JOIN") +"RTN","BMXSQL1",205,0) + . . . S BMXJN=$P(BMXJN,"IEN0",1)_"D0"_$P(BMXJN,"IEN0",2) +"RTN","BMXSQL1",206,0) + . . . S BMXJN="S X="""","_BMXFF(G,"JOIN","IEN")_"=D0 N D0 "_BMXJN +"RTN","BMXSQL1",207,0) + . . . S BMXJN=BMXJN_"I +D0 S X=" +"RTN","BMXSQL1",208,0) + . . . S BMXFG("C",C)=BMXJN +"RTN","BMXSQL1",209,0) + . . . S BMXFLDLO="BMXSCR(""X"","_C_")" +"RTN","BMXSQL1",210,0) + . . I $P(BMXFLDNO,U,4)["E" D +"RTN","BMXSQL1",211,0) + . . . N BMXPC2,BMXTMP +"RTN","BMXSQL1",212,0) + . . . S BMXPC2=$P(BMXPC,"E",2) +"RTN","BMXSQL1",213,0) + . . . S BMXTMP="$E("_BMXGL_"D0,"_$P(BMXPC,";")_"),"_$P(BMXPC2,",")_","_$P(BMXPC2,",",2)_")" +"RTN","BMXSQL1",214,0) + . . . I BMXEXT S BMXFG("C",C)=BMXFG("C",C)_BMXTMP +"RTN","BMXSQL1",215,0) + . . . E S BMXFLDLO=BMXTMP +"RTN","BMXSQL1",216,0) + . . E D +"RTN","BMXSQL1",217,0) + . . . N BMXTMP +"RTN","BMXSQL1",218,0) + . . . S BMXTMP="$P("_BMXGL_"D0,"_$P(BMXPC,";")_"),U,"_$P(BMXPC,";",2)_")" +"RTN","BMXSQL1",219,0) + . . . S BMXTMP="$S($D("_BMXGL_"D0,"_$P(BMXPC,";")_")):"_BMXTMP_",1:"""")" +"RTN","BMXSQL1",220,0) + . . . I BMXEXT S BMXFG("C",C)=BMXFG("C",C)_BMXTMP +"RTN","BMXSQL1",221,0) + . . . E S BMXFLDLO=BMXTMP +"RTN","BMXSQL1",222,0) + . ; +"RTN","BMXSQL1",223,0) + . S BMXOP=$P(BMXNOD,U,3) +"RTN","BMXSQL1",224,0) + . S BMXV=$P(BMXFF(F),U,4) +"RTN","BMXSQL1",225,0) + . I "<^>^=^["[BMXOP D +"RTN","BMXSQL1",226,0) + . . I BMXOP=">",BMXV?.A S BMXOP="]" +"RTN","BMXSQL1",227,0) + . . I BMXOP="<",BMXV?.A S BMXOP="']" +"RTN","BMXSQL1",228,0) + . . S BMXRET="("_BMXFLDLO_BMXOP_Q_BMXV_Q_")" +"RTN","BMXSQL1",229,0) + . . Q +"RTN","BMXSQL1",230,0) + . I "<>"=BMXOP D +"RTN","BMXSQL1",231,0) + . . S BMXOP="'=" +"RTN","BMXSQL1",232,0) + . . S BMXRET="("_BMXFLDLO_BMXOP_Q_BMXV_Q_")" +"RTN","BMXSQL1",233,0) + . I ">="=BMXOP D +"RTN","BMXSQL1",234,0) + . . I BMXV="" S BMXRET="(I 1)" Q +"RTN","BMXSQL1",235,0) + . . I +BMXV=BMXV D Q +"RTN","BMXSQL1",236,0) + . . . S BMXOP="'<" +"RTN","BMXSQL1",237,0) + . . . S BMXRET="("_BMXFLDLO_BMXOP_Q_BMXV_Q_")" +"RTN","BMXSQL1",238,0) + . . S BMXV=$$DECSTR^BMXSQL2(BMXV) +"RTN","BMXSQL1",239,0) + . . S BMXOP="]" +"RTN","BMXSQL1",240,0) + . . S BMXRET="("_BMXFLDLO_BMXOP_Q_BMXV_Q_")" +"RTN","BMXSQL1",241,0) + . I "<="=BMXOP D +"RTN","BMXSQL1",242,0) + . . I BMXV="" S BMXRET="(I 0)" Q +"RTN","BMXSQL1",243,0) + . . I +BMXV=BMXV D Q +"RTN","BMXSQL1",244,0) + . . . S BMXOP="'>" +"RTN","BMXSQL1",245,0) + . . . S BMXRET="("_BMXFLDLO_BMXOP_Q_BMXV_Q_")" +"RTN","BMXSQL1",246,0) + . . S BMXV=$$INCSTR^BMXSQL2(BMXV) +"RTN","BMXSQL1",247,0) + . . S BMXOP="']" +"RTN","BMXSQL1",248,0) + . . S BMXRET="("_BMXFLDLO_BMXOP_Q_BMXV_Q_")" +"RTN","BMXSQL1",249,0) + . I BMXOP="BETWEEN" D +"RTN","BMXSQL1",250,0) + . . I +$P(BMXV,"~")'=$P(BMXV,"~") D ;BMXV a string +"RTN","BMXSQL1",251,0) + . . . N W,X,Y,Z +"RTN","BMXSQL1",252,0) + . . . S X=$P(BMXV,"~") +"RTN","BMXSQL1",253,0) + . . . S Y=$E(X,1,$L(X)-1) +"RTN","BMXSQL1",254,0) + . . . S Z=$E(X,$L(X)) +"RTN","BMXSQL1",255,0) + . . . S Z=$A(Z) +"RTN","BMXSQL1",256,0) + . . . S Z=Z-1 +"RTN","BMXSQL1",257,0) + . . . S Z=$C(Z) +"RTN","BMXSQL1",258,0) + . . . S W=Y_Z +"RTN","BMXSQL1",259,0) + . . . S $P(BMXV,"~")=W +"RTN","BMXSQL1",260,0) + . . . S BMXRET="(("_BMXFLDLO_"]"_Q_$P(BMXV,"~")_Q_")&("_BMXFLDLO_"']"_Q_$P(BMXV,"~",2)_Q_"))" +"RTN","BMXSQL1",261,0) + . . E D ;BMXV a number +"RTN","BMXSQL1",262,0) + . . . S BMXRET="(("_BMXFLDLO_"'<"_$P(BMXV,"~")_")&("_BMXFLDLO_"'>"_$P(BMXV,"~",2)_"))" +"RTN","BMXSQL1",263,0) + . . Q +"RTN","BMXSQL1",264,0) + . I BMXOP="LIKE" D +"RTN","BMXSQL1",265,0) + . . S BMXRET="("_BMXFLDLO_"?1"_Q_BMXV_Q_".E)" +"RTN","BMXSQL1",266,0) + . I BMXRET]"" D +"RTN","BMXSQL1",267,0) + . . S BMXFG(F)=BMXRET +"RTN","BMXSQL1",268,0) + . . Q +"RTN","BMXSQL1",269,0) + . ;TODO: Pointer fields +"RTN","BMXSQL1",270,0) + . ;TODO: Computed fields +"RTN","BMXSQL1",271,0) + . ;TODO: Sets of codes +"RTN","BMXSQL1",272,0) + . ;TODO: Dates +"RTN","BMXSQL1",273,0) + . Q +"RTN","BMXSQL1",274,0) + Q +"RTN","BMXSQL1",275,0) + ; +"RTN","BMXSQL1",276,0) +SCRNP(F,BMXGL,BMXFLDNU,BMXFLDNO) ; +"RTN","BMXSQL1",277,0) + ;Requires BMXFF() +"RTN","BMXSQL1",278,0) + ;Sets up expression for pointer field +"RTN","BMXSQL1",279,0) + N BMX,BMXCOR,BMXRET,BMXPC +"RTN","BMXSQL1",280,0) + S BMXPC=$P(BMXFLDNO,U,4) +"RTN","BMXSQL1",281,0) + S BMXCOR="$P($G("_BMXGL_"D0,"_Q_$P(BMXPC,";")_Q_")),U,"_$P(BMXPC,";",2)_")" +"RTN","BMXSQL1",282,0) + S BMXRET=BMXCOR +"RTN","BMXSQL1",283,0) + Q:$D(BMXFF(F,"INTERNAL")) BMXRET +"RTN","BMXSQL1",284,0) + S BMXFNUM=$P(BMXFLDNO,U,2) +"RTN","BMXSQL1",285,0) + S BMXFNUM=+$P(BMXFNUM,"P",2) +"RTN","BMXSQL1",286,0) + S BMXGL=^DIC(BMXFNUM,0,"GL") +"RTN","BMXSQL1",287,0) + S BMXFLDNUM=".01" +"RTN","BMXSQL1",288,0) + S BMXFLDNO=^DD(BMXFNUM,BMXFLDNUM,0) +"RTN","BMXSQL1",289,0) + F D:$P(BMXFLDNO,U,2)["P" Q:$P(BMXFLDNO,U,2)'["P" +"RTN","BMXSQL1",290,0) + . S BMXPC=$P(BMXFLDNO,U,4) +"RTN","BMXSQL1",291,0) + . S BMXRET="$P($G("_BMXGL_BMXRET_","_Q_$P(BMXPC,";")_Q_")),U,"_$P(BMXPC,";",2)_")" +"RTN","BMXSQL1",292,0) + . S BMXFNUM=$P(BMXFLDNO,U,2) +"RTN","BMXSQL1",293,0) + . S BMXFNUM=+$P(BMXFNUM,"P",2) +"RTN","BMXSQL1",294,0) + . S BMXGL=^DIC(BMXFNUM,0,"GL") +"RTN","BMXSQL1",295,0) + . S BMXFLDNUM=".01" +"RTN","BMXSQL1",296,0) + . S BMXFLDNO=^DD(BMXFNUM,BMXFLDNUM,0) +"RTN","BMXSQL1",297,0) + ;B ;SCRN2 After chain +"RTN","BMXSQL1",298,0) + ;I 0 D ;$P(BMXFLDNO,U,2)["D" D ;Pointer to a date +"RTN","BMXSQL1",299,0) + ;. Q:+$G(BMXFF(F,"INDEXED")) ;Dates converted when iterator built +"RTN","BMXSQL1",300,0) + ;. N BMXD,J +"RTN","BMXSQL1",301,0) + ;. S BMXD=$P(BMXFF(F),U,4) +"RTN","BMXSQL1",302,0) + ;. S %DT="T" +"RTN","BMXSQL1",303,0) + ;. F J=1:1:$L(BMXD,"~") D +"RTN","BMXSQL1",304,0) + ;. . S X=$P(BMXD,"~",J) +"RTN","BMXSQL1",305,0) + ;. . D ^%DT +"RTN","BMXSQL1",306,0) + ;. . S $P(BMXD,"~",J)=Y +"RTN","BMXSQL1",307,0) + ;. S $P(BMXFF(F),U,4)=BMXD +"RTN","BMXSQL1",308,0) + S BMXRET="$P($G("_BMXGL_BMXRET_",0)),U,1)" +"RTN","BMXSQL1",309,0) + S BMXRET="$S(+"_BMXCOR_":"_BMXRET_",1:"""")" +"RTN","BMXSQL1",310,0) + Q BMXRET +"RTN","BMXSQL1",311,0) + ; +"RTN","BMXSQL1",312,0) +CASE(BMXTK) ;EP +"RTN","BMXSQL1",313,0) + ;Convert keywords to uppercase +"RTN","BMXSQL1",314,0) + N J +"RTN","BMXSQL1",315,0) + S J=0 +"RTN","BMXSQL1",316,0) + F S J=$O(BMXTK(J)) Q:'+J D +"RTN","BMXSQL1",317,0) + . F K="DISTINCT","SELECT","WHERE","FROM","SHOWPLAN" D +"RTN","BMXSQL1",318,0) + . . I $$UCASE(BMXTK(J))=K S BMXTK(J)=$$UCASE(BMXTK(J)) +"RTN","BMXSQL1",319,0) + . Q +"RTN","BMXSQL1",320,0) + Q +"RTN","BMXSQL1",321,0) + ; +"RTN","BMXSQL1",322,0) +UCASE(X) ;EP Convert X to uppercase +"RTN","BMXSQL1",323,0) + F %=1:1:$L(X) S:$E(X,%)?1L X=$E(X,0,%-1)_$C($A(X,%)-32)_$E(X,%+1,999) +"RTN","BMXSQL1",324,0) + Q X +"RTN","BMXSQL1",325,0) + ; +"RTN","BMXSQL1",326,0) +EXP ;Extended pointer +"RTN","BMXSQL1",327,0) + N R,G,BMXJN +"RTN","BMXSQL1",328,0) + S BMXEXT=1 +"RTN","BMXSQL1",329,0) + S BMXFG("C")=BMXFG("C")+1 +"RTN","BMXSQL1",330,0) + S C=BMXFG("C") +"RTN","BMXSQL1",331,0) + S R=0 F S R=$O(BMXFJ("JOIN",R)) Q:'+R I R=$P(BMXFF(F),U,5) S G=BMXFJ("JOIN",R) Q +"RTN","BMXSQL1",332,0) + S BMXJN=BMXFF(G,"JOIN") +"RTN","BMXSQL1",333,0) + S BMXJN=$P(BMXJN,"IEN0",1)_"D0"_$P(BMXJN,"IEN0",2) +"RTN","BMXSQL1",334,0) + S BMXJN="S X="""","_BMXFF(G,"JOIN","IEN")_"=D0 N D0 "_BMXJN_"I +D0 S X=" +"RTN","BMXSQL1",335,0) + S BMXFG("C",C)=BMXJN +"RTN","BMXSQL1",336,0) + Q +"RTN","BMXSQL2") +0^99^B9590811 +"RTN","BMXSQL2",1,0) +BMXSQL2 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; +"RTN","BMXSQL2",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXSQL2",3,0) + ; +"RTN","BMXSQL2",4,0) + ; +"RTN","BMXSQL2",5,0) +FLDFILE(BMXIN) ;EP - Returns name of file containing field BMXIN +"RTN","BMXSQL2",6,0) + ;in the form FILE^FIELD^FILENUMBER^FIELDNUMBER +"RTN","BMXSQL2",7,0) + ;Based on data contained in the BMXF() array +"RTN","BMXSQL2",8,0) + ;BMXIN can be either an unambiguous field name or FILE.FIELDNAME +"RTN","BMXSQL2",9,0) + ; +"RTN","BMXSQL2",10,0) + N C,BMXA,BMXB,BMXRET,BMXFILN,BMXFLDN,BMXFILNA +"RTN","BMXSQL2",11,0) + S BMXRET="" +"RTN","BMXSQL2",12,0) + I BMXTMPLT D Q BMXRET +"RTN","BMXSQL2",13,0) + . S BMXFILNA=BMXIN +"RTN","BMXSQL2",14,0) + . I '$D(BMXF(BMXFILNA)) S BMXERR="FILE NOT FOUND" S BMXRET="" D ERROR^BMXSQL Q +"RTN","BMXSQL2",15,0) + . I BMXF(BMXFILNA)'=BMXFO(1) S BMXERR="TEMPLATES ONLY SUPPORTED ON PRIMARY FILE" D ERROR^BMXSQL Q +"RTN","BMXSQL2",16,0) + . S BMXRET=BMXFILNA_U_"BMXIEN"_U_BMXF(BMXFILNA)_U_".001" +"RTN","BMXSQL2",17,0) + ; +"RTN","BMXSQL2",18,0) + I BMXIN["." D Q BMXRET +"RTN","BMXSQL2",19,0) + . S BMXFILNA=$P(BMXIN,".") ;File Name +"RTN","BMXSQL2",20,0) + . I '$D(BMXF(BMXFILNA)) S BMXERR="FILE NOT FOUND" S BMXRET="" D ERROR^BMXSQL Q +"RTN","BMXSQL2",21,0) + . S BMXRET=BMXFILNA_U_$P(BMXIN,".",2) +"RTN","BMXSQL2",22,0) + . S $P(BMXRET,U,3)=BMXF(BMXFILNA) +"RTN","BMXSQL2",23,0) + . S BMXFLDN=0 +"RTN","BMXSQL2",24,0) + . I $P(BMXIN,".",2)'="",$D(^DD(BMXF(BMXFILNA),"B",$P(BMXIN,".",2))) D +"RTN","BMXSQL2",25,0) + . . S BMXFLDN=$O(^DD(BMXF(BMXFILNA),"B",$P(BMXIN,".",2),0)) +"RTN","BMXSQL2",26,0) + . I BMXIN["BMXIEN" S BMXFLDN=".001" +"RTN","BMXSQL2",27,0) + . I '+BMXFLDN S BMXERR="FIELD NOT FOUND",BMXRET="" D ERROR^BMXSQL Q +"RTN","BMXSQL2",28,0) + . S $P(BMXRET,U,4)=BMXFLDN +"RTN","BMXSQL2",29,0) + . Q +"RTN","BMXSQL2",30,0) + ;Loop through files in BMXF to locate field name +"RTN","BMXSQL2",31,0) + S C=0,BMXA="" +"RTN","BMXSQL2",32,0) + I 'BMXIEN F S BMXA=$O(BMXF(BMXA)) Q:BMXA="" D Q:$D(BMXERR) +"RTN","BMXSQL2",33,0) + . I $D(^DD(BMXF(BMXA),"B",BMXIN)) S BMXRET=BMXA_U_BMXIN D Q:$D(BMXERR) +"RTN","BMXSQL2",34,0) + . . S C=C+1 +"RTN","BMXSQL2",35,0) + . . I C>1 S BMXERR="AMBIGUOUS FIELD NAME" D ERROR^BMXSQL Q +"RTN","BMXSQL2",36,0) + . . Q +"RTN","BMXSQL2",37,0) + . Q +"RTN","BMXSQL2",38,0) + I BMXIEN D +"RTN","BMXSQL2",39,0) + . S BMXA=BMXFO(1) +"RTN","BMXSQL2",40,0) + . S BMXA=BMXFNX(BMXA) +"RTN","BMXSQL2",41,0) + . S BMXRET=BMXA_U_BMXIN +"RTN","BMXSQL2",42,0) + . S C=1 +"RTN","BMXSQL2",43,0) + I C=0 D Q BMXRET +"RTN","BMXSQL2",44,0) + . S BMXRET="0^"_BMXIN ;String or numeric literal +"RTN","BMXSQL2",45,0) + S BMXFILNA=$P(BMXRET,U) +"RTN","BMXSQL2",46,0) + S BMXFILN=BMXF(BMXFILNA) +"RTN","BMXSQL2",47,0) + S $P(BMXRET,U,3)=BMXFILN +"RTN","BMXSQL2",48,0) + I $D(^DD(BMXFILN,"B",BMXIN)) D +"RTN","BMXSQL2",49,0) + . S BMXFLDN=$O(^DD(BMXFILN,"B",BMXIN,0)) +"RTN","BMXSQL2",50,0) + I BMXIEN S BMXFLDN=".001" +"RTN","BMXSQL2",51,0) + I '+BMXFLDN S BMXERR="FIELD NOT FOUND",BMXRET="" D ERROR^BMXSQL Q +"RTN","BMXSQL2",52,0) + S $P(BMXRET,U,4)=BMXFLDN +"RTN","BMXSQL2",53,0) + Q BMXRET +"RTN","BMXSQL2",54,0) + ; +"RTN","BMXSQL2",55,0) +DECSTR(BMXSTR) ;EP +"RTN","BMXSQL2",56,0) + ;Decrements string collation value by 1 +"RTN","BMXSQL2",57,0) + ; +"RTN","BMXSQL2",58,0) + N A,E,S,L,BMXRET +"RTN","BMXSQL2",59,0) + I BMXSTR="" Q BMXSTR +"RTN","BMXSQL2",60,0) + S L=$L(BMXSTR) +"RTN","BMXSQL2",61,0) + S E=$E(BMXSTR,L) +"RTN","BMXSQL2",62,0) + S B=$E(BMXSTR,1,L-1) +"RTN","BMXSQL2",63,0) + S A=$A(E) +"RTN","BMXSQL2",64,0) + S A=A-1 +"RTN","BMXSQL2",65,0) + S E=$C(A) +"RTN","BMXSQL2",66,0) + S BMXRET=B_E +"RTN","BMXSQL2",67,0) + Q BMXRET +"RTN","BMXSQL2",68,0) + ; +"RTN","BMXSQL2",69,0) +INCSTR(BMXSTR) ;EP +"RTN","BMXSQL2",70,0) + ;Increments string collation value by 1 +"RTN","BMXSQL2",71,0) + Q BMXSTR_$C(1) +"RTN","BMXSQL2",72,0) + ; +"RTN","BMXSQL2",73,0) +SETX(BMXX,BMXFG,BMXSCR) ;EP +"RTN","BMXSQL2",74,0) + ;Set up executable screen code +"RTN","BMXSQL2",75,0) + ;by assembling pieces in BMXFG +"RTN","BMXSQL2",76,0) + ;and attach to executable iterator(s) +"RTN","BMXSQL2",77,0) + ; +"RTN","BMXSQL2",78,0) + ;IN: BMXFG() +"RTN","BMXSQL2",79,0) + ; BMXX() -- modified +"RTN","BMXSQL2",80,0) + ;OUT: BMXSCR +"RTN","BMXSQL2",81,0) + ; +"RTN","BMXSQL2",82,0) + N J +"RTN","BMXSQL2",83,0) + Q:'$D(BMXFG) +"RTN","BMXSQL2",84,0) + S BMXSCR="" +"RTN","BMXSQL2",85,0) + S J=0 F S J=$O(BMXX(J)) Q:'+J D +"RTN","BMXSQL2",86,0) + . S BMXX(J)=BMXX(J)_"X BMXSCR" +"RTN","BMXSQL2",87,0) + F J=1:1:BMXFG S BMXSCR=BMXSCR_BMXFG(J) +"RTN","BMXSQL2",88,0) + S BMXSCR=$S(BMXSCR]"":"I "_BMXSCR_" ",1:"") +"RTN","BMXSQL2",89,0) + S BMXSCR=BMXSCR_"D:'$D(^BMXTMP($J,""O"",D0)) OUT^BMXSQL" +"RTN","BMXSQL2",90,0) + I BMXFG("C") D +"RTN","BMXSQL2",91,0) + . N C +"RTN","BMXSQL2",92,0) + . S C=BMXFG("C") +"RTN","BMXSQL2",93,0) + . S BMXSCR("C")="F BMXC=1:1:"_C_" X BMXSCR(""C"",BMXC) S BMXSCR(""X"",BMXC)=X" +"RTN","BMXSQL2",94,0) + . F C=1:1:BMXFG("C") S BMXSCR("C",C)=BMXFG("C",C) +"RTN","BMXSQL2",95,0) + . S BMXSCR="X BMXSCR(""C"") "_BMXSCR +"RTN","BMXSQL2",96,0) + ; +"RTN","BMXSQL2",97,0) + Q +"RTN","BMXSQL3") +0^100^B190410807 +"RTN","BMXSQL3",1,0) +BMXSQL3 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; +"RTN","BMXSQL3",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXSQL3",3,0) + ; +"RTN","BMXSQL3",4,0) + ; +"RTN","BMXSQL3",5,0) +PLEVEL(BMXFF,BMXLVL,BMXRET) ;EP +"RTN","BMXSQL3",6,0) + ;Analyze WHERE statement according to paren level +"RTN","BMXSQL3",7,0) + ;Return a string to guide building of iterator(s) +"RTN","BMXSQL3",8,0) + ; +"RTN","BMXSQL3",9,0) + ;Basically, count the number of OR clauses on the +"RTN","BMXSQL3",10,0) + ;same paren level +"RTN","BMXSQL3",11,0) + ;IN: BMXFF() +"RTN","BMXSQL3",12,0) + ;OUT: BMXLVL(), BMXRET +"RTN","BMXSQL3",13,0) + ; +"RTN","BMXSQL3",14,0) + ;BMXRET = 1&/!2&/!...&/!n clauses +"RTN","BMXSQL3",15,0) + ;BMXLVL(E,"BEGIN")=Index where element E begins +"RTN","BMXSQL3",16,0) + ;BMXLVL(E,"END") =Index where element E ends +"RTN","BMXSQL3",17,0) + ;BMXLVL(E,"ELEMENTS")=Number of subelements in element E +"RTN","BMXSQL3",18,0) + ; +"RTN","BMXSQL3",19,0) + N BMXNOR,BMXNAND,J,C,BMXTMP +"RTN","BMXSQL3",20,0) + N E,L,BMXCNT +"RTN","BMXSQL3",21,0) + ;Test for no ORs or no ANDs +"RTN","BMXSQL3",22,0) + S BMXNOR=1,BMXNAND=1 +"RTN","BMXSQL3",23,0) + S J=0 F S J=$O(BMXFF(J)) Q:'+J D ;Q:'BMXNOR Q:'BMXNAND +"RTN","BMXSQL3",24,0) + . I BMXFF(J)="OR" S BMXNOR=0 +"RTN","BMXSQL3",25,0) + . I BMXFF(J)="AND" S BMXNAND=0 +"RTN","BMXSQL3",26,0) + . Q +"RTN","BMXSQL3",27,0) + ;If no ORs or no ANDs then take all parens out of BMXFF +"RTN","BMXSQL3",28,0) + I ((BMXNOR)!(BMXNAND)) D +"RTN","BMXSQL3",29,0) + . S:$D(BMXFF("INDEX")) BMXTMP("INDEX")=BMXFF("INDEX") +"RTN","BMXSQL3",30,0) + . S J=0,C=0 F S J=$O(BMXFF(J)) Q:'+J D:"(^)"'[BMXFF(J) +"RTN","BMXSQL3",31,0) + . . S C=C+1 +"RTN","BMXSQL3",32,0) + . . S BMXTMP(C)=BMXFF(J) +"RTN","BMXSQL3",33,0) + . . S:$D(BMXFF(J,0)) BMXTMP(C,0)=BMXFF(J,0) +"RTN","BMXSQL3",34,0) + . . S:$D(BMXFF(J,"INTERNAL")) BMXTMP(J,"INTERNAL")=BMXFF(J,"INTERNAL") +"RTN","BMXSQL3",35,0) + . . S:$D(BMXFF(J,"TYPE")) BMXTMP(C,"TYPE")=BMXFF(J,"TYPE") +"RTN","BMXSQL3",36,0) + . . S:$D(BMXFF(J,"IEN")) BMXTMP(C,"IEN")=BMXFF(J,"IEN") +"RTN","BMXSQL3",37,0) + . . S:$D(BMXFF(J,"JOIN")) BMXTMP(C,"JOIN")=BMXFF(J,"JOIN") +"RTN","BMXSQL3",38,0) + . . S:$D(BMXFF(J,"JOIN","IEN")) BMXTMP(C,"JOIN","IEN")=BMXFF(J,"JOIN","IEN") +"RTN","BMXSQL3",39,0) + . . ;I $D(BMXFF(J,"JOIN")) D +"RTN","BMXSQL3",40,0) + . . ;. N K S K=0 F S K=$O(BMXFF(J,"JOIN",K)) Q:'+K D +"RTN","BMXSQL3",41,0) + . . ;. . N L S L=0 F S L=$O(BMXFF(J,"JOIN",K,L)) Q:'+L D +"RTN","BMXSQL3",42,0) + . . ;. . . S BMXTMP(C,"JOIN",K,L)=BMXFF(J,"JOIN",K,L) +"RTN","BMXSQL3",43,0) + . . I $D(BMXFF(J,"SET")) D +"RTN","BMXSQL3",44,0) + . . . N BMXSS +"RTN","BMXSQL3",45,0) + . . . S BMXSS="" F S BMXSS=$O(BMXFF(J,"SET",BMXSS)) Q:BMXSS="" D +"RTN","BMXSQL3",46,0) + . . . . S BMXTMP(C,"SET",BMXSS)=BMXFF(J,"SET",BMXSS) +"RTN","BMXSQL3",47,0) + . K BMXFF +"RTN","BMXSQL3",48,0) + . I $D(BMXTMP("INDEX")) S BMXFF("INDEX")=BMXTMP("INDEX") +"RTN","BMXSQL3",49,0) + . S J=0 F S J=$O(BMXTMP(J)) Q:'+J D +"RTN","BMXSQL3",50,0) + . . S BMXFF(J)=BMXTMP(J) +"RTN","BMXSQL3",51,0) + . . S:$D(BMXTMP(J,0)) BMXFF(J,0)=BMXTMP(J,0) +"RTN","BMXSQL3",52,0) + . . S:$D(BMXTMP(J,"TYPE")) BMXFF(J,"TYPE")=BMXTMP(J,"TYPE") +"RTN","BMXSQL3",53,0) + . . I $D(BMXTMP(J,"JOIN")) S BMXFF(J,"JOIN")=BMXTMP(J,"JOIN") S:$D(BMXTMP(J,"JOIN","IEN")) BMXFF(J,"JOIN","IEN")=BMXTMP(J,"JOIN","IEN") S BMXFJ("JOIN",+$P($P(BMXFF(J,0),U,2),"P",2))=J +"RTN","BMXSQL3",54,0) + . . ;I $D(BMXTMP(J,"JOIN")) D +"RTN","BMXSQL3",55,0) + . . ;. N K S K=0 F S K=$O(BMXTMP(J,"JOIN",K)) Q:'+K D +"RTN","BMXSQL3",56,0) + . . ;. . N L S L=0 F S L=$O(BMXTMP(J,"JOIN",K,L)) Q:'+L D +"RTN","BMXSQL3",57,0) + . . ;. . . S BMXFF(J,"JOIN",K,L)=BMXTMP(J,"JOIN",K,L) +"RTN","BMXSQL3",58,0) + . . I $D(BMXTMP(J,"SET")) D +"RTN","BMXSQL3",59,0) + . . . N BMXSS +"RTN","BMXSQL3",60,0) + . . . S BMXSS="" F S BMXSS=$O(BMXTMP(J,"SET",BMXSS)) Q:BMXSS="" D +"RTN","BMXSQL3",61,0) + . . . . S BMXFF(J,"SET",BMXSS)=BMXTMP(J,"SET",BMXSS) +"RTN","BMXSQL3",62,0) + . . I $D(BMXTMP(J,"INTERNAL")) S BMXFF(J,"INTERNAL")=BMXTMP(J,"INTERNAL") +"RTN","BMXSQL3",63,0) + . . I $D(BMXTMP(J,"IEN")) S BMXFF(J,"IEN")=BMXTMP(J,"IEN") +"RTN","BMXSQL3",64,0) + . S BMXFF=C +"RTN","BMXSQL3",65,0) + . Q +"RTN","BMXSQL3",66,0) + ; +"RTN","BMXSQL3",67,0) + ;Remove excess leading and trailing parens +"RTN","BMXSQL3",68,0) + ;Find close paren corresponding to BMXFF(1) +"RTN","BMXSQL3",69,0) + ;If its the last paren, then remove the first and last parens +"RTN","BMXSQL3",70,0) + ;Else, quit +"RTN","BMXSQL3",71,0) + N BMXEND +"RTN","BMXSQL3",72,0) + S BMXEND=0 +"RTN","BMXSQL3",73,0) + F Q:'((BMXFF(1)="(")&(BMXFF(BMXFF)=")")) Q:BMXEND D +"RTN","BMXSQL3",74,0) + . S L=1,J=1 +"RTN","BMXSQL3",75,0) + . F S J=$O(BMXFF(J)) Q:'+J D:"(^)"[BMXFF(J) Q:BMXEND +"RTN","BMXSQL3",76,0) + . . I BMXFF(J)="(" S L=L+1 Q +"RTN","BMXSQL3",77,0) + . . I BMXFF(J)=")" S L=L-1 +"RTN","BMXSQL3",78,0) + . . I L=0,J0 D Q +"RTN","BMXSQL3",194,0) + . . . S BMXPFF(BMXPFF,1)=BMXREF +"RTN","BMXSQL3",195,0) + . . . S $P(BMXPFF(BMXPFF,1),U,2)=BMXRNAM +"RTN","BMXSQL3",196,0) + . . . S BMXPFP(BMXPFP,BMXPFF,1)=BMXREF +"RTN","BMXSQL3",197,0) + . . . S $P(BMXPFP(BMXPFP,BMXPFF,1),U,2)=BMXRNAM +"RTN","BMXSQL3",198,0) + . . Q +"RTN","BMXSQL3",199,0) + . Q +"RTN","BMXSQL3",200,0) + Q +"RTN","BMXSQL3",201,0) + ; +"RTN","BMXSQL3",202,0) + ; +"RTN","BMXSQL3",203,0) +BLDIT(BMXFF,F,BMXRNAM,BMXRET,BMXPFP) ;EP - Build iterator +"RTN","BMXSQL3",204,0) + ; +"RTN","BMXSQL3",205,0) + K BMXRET +"RTN","BMXSQL3",206,0) + N BMXNOD,BMXOP,BMXV,BMXGL,Q +"RTN","BMXSQL3",207,0) + S BMXNOD=BMXFF(F) +"RTN","BMXSQL3",208,0) + S BMXOP=$P(BMXNOD,U,3) +"RTN","BMXSQL3",209,0) + S BMXV=$P(BMXNOD,U,4) +"RTN","BMXSQL3",210,0) + S BMXGL=$P(BMXNOD,U,7,8) +"RTN","BMXSQL3",211,0) + S Q=$C(34) +"RTN","BMXSQL3",212,0) + I $D(BMXPFP(F)) D BLDIT2 Q ;Pointer +"RTN","BMXSQL3",213,0) + ;TODO Set BMXV to the pointer or set or FM date that corresponds +"RTN","BMXSQL3",214,0) + ; to the user-entered value +"RTN","BMXSQL3",215,0) + I $D(BMXFF(F,"IEN")),BMXFF(F,"IEN")="TEMPLATE" D Q +"RTN","BMXSQL3",216,0) + . N BMXTNUM +"RTN","BMXSQL3",217,0) + . S BMXTNUM=$O(^DIBT("B",$P(BMXFF(F),U,4),0)) +"RTN","BMXSQL3",218,0) + . S BMXRET="S D0=0 F S D0=$O(^DIBT("_BMXTNUM_",1,D0)) Q:'+D0 Q:BMXM>BMXXMAX " +"RTN","BMXSQL3",219,0) + . Q +"RTN","BMXSQL3",220,0) + I BMXOP="=" D Q +"RTN","BMXSQL3",221,0) + . I $D(BMXFF(F,"IEN")) S BMXRET="S D0="_BMXV_" Q:'+D0 Q:BMXM>BMXXMAX " Q +"RTN","BMXSQL3",222,0) + . S BMXRET="S D0="""" F S D0=$O("_BMXGL_Q_BMXRNAM_Q_","_Q_BMXV_Q_",D0)) Q:D0="""" Q:BMXM>BMXXMAX " +"RTN","BMXSQL3",223,0) + . Q +"RTN","BMXSQL3",224,0) + ; +"RTN","BMXSQL3",225,0) + I BMXOP=">=" D Q +"RTN","BMXSQL3",226,0) + . I $D(BMXFF(F,"IEN")) S BMXV=BMXV-1,BMXRET="S D0="_BMXV_" F S D0=$O("_BMXGL_"D0)) Q:'+D0 Q:BMXM>BMXXMAX " Q +"RTN","BMXSQL3",227,0) + . N BMXTMP +"RTN","BMXSQL3",228,0) + . S BMXTMP="BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1)" +"RTN","BMXSQL3",229,0) + . S @BMXTMP +"RTN","BMXSQL3",230,0) + . S BMXRET="S BMXV="_Q_BMXV_Q_" F S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV)) Q:BMXV="""" Q:BMXM>BMXXMAX S D0="""" F S D0=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D0)) Q:D0="""" Q:BMXM>BMXXMAX " +"RTN","BMXSQL3",231,0) + ; +"RTN","BMXSQL3",232,0) + I BMXOP=">" D Q +"RTN","BMXSQL3",233,0) + . I $D(BMXFF(F,"IEN")) S BMXRET="S D0="_BMXV_" F S D0=$O("_BMXGL_"D0)) Q:'+D0 Q:BMXM>BMXXMAX " Q +"RTN","BMXSQL3",234,0) + . S BMXRET="S BMXV="_Q_BMXV_Q_" F S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV)) Q:BMXV="""" Q:BMXM>BMXXMAX S D0="""" F S D0=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D0)) Q:D0="""" Q:BMXM>BMXXMAX " +"RTN","BMXSQL3",235,0) + ; +"RTN","BMXSQL3",236,0) + I BMXOP="<>" D Q +"RTN","BMXSQL3",237,0) + . I $D(BMXFF(F,"IEN")) S BMXRET="S D0=0 F S D0=$O("_BMXGL_"D0)) Q:'+D0 I D0'="_BMXV_" Q:BMXM>BMXXMAX " Q +"RTN","BMXSQL3",238,0) + . S BMXRET="S BMXV=0 F S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV)) Q:BMXV="""" Q:BMXM>BMXXMAX I BMXV'="_Q_BMXV_Q_" S D0="""" F S D0=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D0)) Q:D0="""" Q:BMXM>BMXXMAX " +"RTN","BMXSQL3",239,0) + ; +"RTN","BMXSQL3",240,0) + I BMXOP="<=" D Q +"RTN","BMXSQL3",241,0) + . I $D(BMXFF(F,"IEN")) S BMXRET="S D0=0 F S D0=$O("_BMXGL_"D0)) Q:'+D0 Q:D0>"_BMXV_" Q:BMXM>BMXXMAX " Q +"RTN","BMXSQL3",242,0) + . N BMXTMP +"RTN","BMXSQL3",243,0) + . S BMXTMP="BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV))" +"RTN","BMXSQL3",244,0) + . S @BMXTMP +"RTN","BMXSQL3",245,0) + . S BMXRET="S BMXV="_Q_BMXV_Q_" F S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1) Q:BMXV="""" Q:BMXM>BMXXMAX S D0="""" F S D0=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D0)) Q:D0="""" Q:BMXM>BMXXMAX " +"RTN","BMXSQL3",246,0) + ; +"RTN","BMXSQL3",247,0) + I BMXOP="<" D Q +"RTN","BMXSQL3",248,0) + . I $D(BMXFF(F,"IEN")) S BMXRET="S D0=0 F S D0=$O("_BMXGL_"D0)) Q:'+D0 Q:D0'<"_BMXV_" Q:BMXM>BMXXMAX " Q +"RTN","BMXSQL3",249,0) + . S BMXRET="S BMXV="_Q_BMXV_Q_" F S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1) Q:BMXV="""" Q:BMXM>BMXXMAX S D0="""" F S D0=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D0)) Q:D0="""" Q:BMXM>BMXXMAX " +"RTN","BMXSQL3",250,0) + ; +"RTN","BMXSQL3",251,0) + I BMXOP="BETWEEN" D Q ;changed '< to > (inclusive BETWEEN) +"RTN","BMXSQL3",252,0) + . I $D(BMXFF(F,"IEN")) D Q +"RTN","BMXSQL3",253,0) + . . S BMXRET="S D0="_(+$P(BMXV,"~")-1)_" F S D0=$O("_BMXGL_"D0)) Q:'+D0 Q:D0>"_$P(BMXV,"~",2)_" Q:BMXM>BMXXMAX " +"RTN","BMXSQL3",254,0) + . I +$P(BMXV,"~")=$P(BMXV,"~") D ;BMXV is a number +"RTN","BMXSQL3",255,0) + . . S BMXRET="S BMXV="_$P(BMXV,"~")_",BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1) F S BMXV=$O("_BMXGL_Q_BMXRNAM_Q +"RTN","BMXSQL3",256,0) + . . S BMXRET=BMXRET_",BMXV)) Q:BMXV="""" Q:BMXV>"_$P(BMXV,"~",2)_" Q:BMXM>BMXXMAX S D0="""" F S D0=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D0)) Q:D0="""" Q:BMXM>BMXXMAX " +"RTN","BMXSQL3",257,0) + . E D ;BMXV is a string +"RTN","BMXSQL3",258,0) + . . S BMXRET="S BMXV="_Q_$P(BMXV,"~")_Q_",BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1) F S BMXV=$O("_BMXGL_Q_BMXRNAM_Q +"RTN","BMXSQL3",259,0) + . . S BMXRET=BMXRET_",BMXV)) Q:BMXV="""" Q:BMXV]"_Q_$P(BMXV,"~",2)_Q_" Q:BMXM>BMXXMAX S D0="""" F S D0=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D0)) Q:D0="""" Q:BMXM>BMXXMAX " +"RTN","BMXSQL3",260,0) + ; +"RTN","BMXSQL3",261,0) + I BMXOP="LIKE" D Q +"RTN","BMXSQL3",262,0) + . N BMXTMP,BMXV1 +"RTN","BMXSQL3",263,0) + . S BMXV1=BMXV +"RTN","BMXSQL3",264,0) + . S BMXTMP="BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1)" +"RTN","BMXSQL3",265,0) + . S @BMXTMP +"RTN","BMXSQL3",266,0) + . S BMXRET="S BMXV="_Q_BMXV_Q_" F S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV)) Q:BMXV="""" Q:BMXV'?1"_Q_BMXV1_Q_".E Q:BMXM>BMXXMAX S D0="""" F S D0=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D0)) Q:D0="""" Q:BMXM>BMXXMAX " +"RTN","BMXSQL3",267,0) + Q +"RTN","BMXSQL3",268,0) + ; +"RTN","BMXSQL3",269,0) +BLDIT2 ;Pointer +"RTN","BMXSQL3",270,0) + N BMXPS,J +"RTN","BMXSQL3",271,0) + S BMXPS=$O(BMXPFP(F,999),-1) +"RTN","BMXSQL3",272,0) + S BMXNOD=BMXPFP(F,BMXPS) +"RTN","BMXSQL3",273,0) + S BMXGL=$P(BMXNOD,U,7,8) +"RTN","BMXSQL3",274,0) + I BMXOP="=" D +"RTN","BMXSQL3",275,0) + . S BMXRNAM=$P(BMXPFP(F,BMXPS,1),U,2) +"RTN","BMXSQL3",276,0) + . S BMXRET="S D"_BMXPS_"="""" F S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_","_Q_BMXV_Q_",D"_BMXPS_")) Q:'+D"_BMXPS_" Q:BMXM>BMXXMAX " +"RTN","BMXSQL3",277,0) + ; +"RTN","BMXSQL3",278,0) + I BMXOP=">" D +"RTN","BMXSQL3",279,0) + . S BMXRNAM=$P(BMXPFP(F,BMXPS,1),U,2) +"RTN","BMXSQL3",280,0) + . S BMXRET="S BMXV="_Q_BMXV_Q_" F S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV)) Q:BMXV="""" Q:BMXM>BMXXMAX S D"_BMXPS_"="""" F S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D"_BMXPS_")) Q:'+D"_BMXPS_" Q:BMXM>BMXXMAX " +"RTN","BMXSQL3",281,0) + ; +"RTN","BMXSQL3",282,0) + I BMXOP=">=" D +"RTN","BMXSQL3",283,0) + . N BMXTMP +"RTN","BMXSQL3",284,0) + . S BMXRNAM=$P(BMXPFP(F,BMXPS,1),U,2) +"RTN","BMXSQL3",285,0) + . S BMXTMP="BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1)" +"RTN","BMXSQL3",286,0) + . S @BMXTMP +"RTN","BMXSQL3",287,0) + . S BMXRET="S BMXV="_Q_BMXV_Q_" F S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV)) Q:BMXV="""" Q:BMXM>BMXXMAX S D"_BMXPS_"="""" F S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D"_BMXPS_")) Q:'+D"_BMXPS_" Q:BMXM>BMXXMAX " +"RTN","BMXSQL3",288,0) + ; +"RTN","BMXSQL3",289,0) + I BMXOP="<=" D +"RTN","BMXSQL3",290,0) + . N BMXTMP +"RTN","BMXSQL3",291,0) + . S BMXRNAM=$P(BMXPFP(F,BMXPS,1),U,2) +"RTN","BMXSQL3",292,0) + . S BMXTMP="BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV))" +"RTN","BMXSQL3",293,0) + . S @BMXTMP +"RTN","BMXSQL3",294,0) + . S BMXRET="S BMXV="_Q_BMXV_Q_" F S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1) Q:BMXV="""" Q:BMXM>BMXXMAX S D"_BMXPS_"="""" F S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D"_BMXPS_")) Q:'+D"_BMXPS_" Q:BMXM>BMXXMAX " +"RTN","BMXSQL3",295,0) + ; +"RTN","BMXSQL3",296,0) + I BMXOP="<>" D +"RTN","BMXSQL3",297,0) + . S BMXRNAM=$P(BMXPFP(F,BMXPS,1),U,2) +"RTN","BMXSQL3",298,0) + . S BMXRET="S BMXV=0 F S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV)) Q:BMXV="""" Q:BMXM>BMXXMAX I BMXV'="_Q_BMXV_Q_" S D"_BMXPS_"="""" F S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D"_BMXPS_")) Q:'+D"_BMXPS_" Q:BMXM>BMXXMAX " +"RTN","BMXSQL3",299,0) + ; +"RTN","BMXSQL3",300,0) + I BMXOP="<" D +"RTN","BMXSQL3",301,0) + . S BMXRNAM=$P(BMXPFP(F,BMXPS,1),U,2) +"RTN","BMXSQL3",302,0) + . S BMXRET="S BMXV="_Q_BMXV_Q_" F S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1) Q:BMXV="""" Q:BMXM>BMXXMAX S D"_BMXPS_"="""" F S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D"_BMXPS_")) Q:'+D"_BMXPS_" Q:BMXM>BMXXMAX " +"RTN","BMXSQL3",303,0) + ; +"RTN","BMXSQL3",304,0) + I BMXOP="BETWEEN" D +"RTN","BMXSQL3",305,0) + . S BMXRNAM=$P(BMXPFP(F,BMXPS,1),U,2) +"RTN","BMXSQL3",306,0) + . I +$P(BMXV,"~")=$P(BMXV,"~") D ;BMXV is a number +"RTN","BMXSQL3",307,0) + . . S BMXRET="S BMXV="_$P(BMXV,"~")_",BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1) F S BMXV=$O("_BMXGL_Q_BMXRNAM_Q +"RTN","BMXSQL3",308,0) + . . S BMXRET=BMXRET_",BMXV)) Q:BMXV="""" Q:BMXV>"_$P(BMXV,"~",2)_" Q:BMXM>BMXXMAX S D"_BMXPS_"=0 F S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D"_BMXPS_")) Q:'+D"_BMXPS_" Q:BMXM>BMXXMAX " +"RTN","BMXSQL3",309,0) + . E D ;BMXV is a string +"RTN","BMXSQL3",310,0) + . . S BMXRET="S BMXV="_Q_$P(BMXV,"~")_Q_",BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1) F S BMXV=$O("_BMXGL_Q_BMXRNAM_Q +"RTN","BMXSQL3",311,0) + . . S BMXRET=BMXRET_",BMXV)) Q:BMXV="""" Q:BMXV]"_Q_$P(BMXV,"~",2)_Q_" Q:BMXM>BMXXMAX S D"_BMXPS_"=0 F S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D"_BMXPS_")) Q:'+D"_BMXPS_" Q:BMXM>BMXXMAX " +"RTN","BMXSQL3",312,0) + ; +"RTN","BMXSQL3",313,0) + I BMXOP="LIKE" D +"RTN","BMXSQL3",314,0) + . N BMXTMP,BMXV1 +"RTN","BMXSQL3",315,0) + . S BMXRNAM=$P(BMXPFP(F,BMXPS,1),U,2) +"RTN","BMXSQL3",316,0) + . S BMXV1=BMXV +"RTN","BMXSQL3",317,0) + . S BMXTMP="BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1)" +"RTN","BMXSQL3",318,0) + . S @BMXTMP +"RTN","BMXSQL3",319,0) + . S BMXRET="S BMXV="_Q_BMXV_Q_" F S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV)) Q:BMXV="""" Q:BMXV'?1"_Q_BMXV1_Q_".E Q:BMXM>BMXXMAX S D"_BMXPS_"="""" F S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D"_BMXPS_")) Q:'+D"_BMXPS_" Q:BMXM>BMXXMAX " +"RTN","BMXSQL3",320,0) + ; +"RTN","BMXSQL3",321,0) + F J=BMXPS-1:-1:0 D +"RTN","BMXSQL3",322,0) + . S BMXNOD=BMXPFP(F,J) +"RTN","BMXSQL3",323,0) + . S BMXGL=$P(BMXNOD,U,7,8) +"RTN","BMXSQL3",324,0) + . S BMXRNAM=$P(BMXPFP(F,J,1),U,2) +"RTN","BMXSQL3",325,0) + . S BMXRET=BMXRET_"S D"_J_"=0 F S D"_J_"=$O("_BMXGL_Q_BMXRNAM_Q_",D"_(J+1)_",D"_J_")) Q:'+D"_J_" Q:BMXM>BMXXMAX " +"RTN","BMXSQL3",326,0) + Q +"RTN","BMXSQL3",327,0) + ;TODO: Computed fields +"RTN","BMXSQL3",328,0) + ;TODO: Sets of codes +"RTN","BMXSQL3",329,0) + ;TODO: User-specified index +"RTN","BMXSQL3",330,0) + Q +"RTN","BMXSQL4") +0^101^B3594616 +"RTN","BMXSQL4",1,0) +BMXSQL4 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; +"RTN","BMXSQL4",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXSQL4",3,0) + ; +"RTN","BMXSQL4",4,0) + ; +"RTN","BMXSQL4",5,0) +JOIN ;EP - Join processing +"RTN","BMXSQL4",6,0) + ;Create a pointer chain back to the primary file +"RTN","BMXSQL4",7,0) + ;or to a reverse pointer file, E.G.: +"RTN","BMXSQL4",8,0) + ;Either executable code or an expression that returns the +"RTN","BMXSQL4",9,0) + ;IEN of the terminal pointed-to file +"RTN","BMXSQL4",10,0) + ; +"RTN","BMXSQL4",11,0) + ; S IEN1=$P(^DIZ(1000,IEN2,0),U,4) +"RTN","BMXSQL4",12,0) + ; I +IEN1 S IEN=$P(^AUTTLOC(IEN1,0),U,23) +"RTN","BMXSQL4",13,0) + ; +"RTN","BMXSQL4",14,0) + Q:'$D(BMXFJ("JOIN")) +"RTN","BMXSQL4",15,0) + N C,D,E,BMXSTOP,BMXPTF,BMXPTG,BMXPTL,BMXPTN,BMXPTP,BMXPTC +"RTN","BMXSQL4",16,0) + S C=0 F S C=$O(BMXFF(C)) Q:'+C D +"RTN","BMXSQL4",17,0) + . Q:'$D(BMXFF(C,"JOIN")) +"RTN","BMXSQL4",18,0) + . S BMXPTL=1,BMXPTC="",D=C ;Pointer level +"RTN","BMXSQL4",19,0) + . F S BMXPTF=$P(BMXFF(D),U,5) D Q:BMXPTF=BMXFO(1) +"RTN","BMXSQL4",20,0) + . . S BMXPTG=$P(BMXFF(D),U,7,99) ;Pf Global +"RTN","BMXSQL4",21,0) + . . S BMXPTN=$P(BMXFF(D,0),U,4) ;Pf Node +"RTN","BMXSQL4",22,0) + . . S BMXPTP=$P(BMXPTN,";",2) ;Pf Piece +"RTN","BMXSQL4",23,0) + . . S BMXPTN=$P(BMXPTN,";") +"RTN","BMXSQL4",24,0) + . . S BMXPTC="I +IEN"_BMXPTL_" S IEN"_(BMXPTL-1)_"=$P($G("_BMXPTG_"IEN"_BMXPTL_","_BMXPTN_")),U,"_BMXPTP_") "_BMXPTC +"RTN","BMXSQL4",25,0) + . . S BMXPTL=BMXPTL+1 +"RTN","BMXSQL4",26,0) + . . ;S D To the index of the pointed to file's entry in BMXFF +"RTN","BMXSQL4",27,0) + . . Q:BMXPTF=BMXFO(1) +"RTN","BMXSQL4",28,0) + . . S E=0,BMXSTOP=0 F S E=$O(BMXFF(E)) Q:'+E Q:BMXSTOP D +"RTN","BMXSQL4",29,0) + . . . I $D(BMXFF(E,0)),+$P($P(BMXFF(E,0),U,2),"P",2)=BMXPTF S D=E,BMXSTOP=1 Q +"RTN","BMXSQL4",30,0) + . . . I $D(BMXFF(E,0)),BMXPTF=9000001,+$P($P(BMXFF(E,0),U,2),"P",2)=2 S D=E,BMXSTOP=1 Q ;IHS auto join PATIENT to VA PATIENT +"RTN","BMXSQL4",31,0) + . S BMXFF(C,"JOIN")=BMXPTC +"RTN","BMXSQL4",32,0) + . S BMXFF(C,"JOIN","IEN")="IEN"_(BMXPTL-1) +"RTN","BMXSQL4",33,0) + Q +"RTN","BMXSQL5") +0^102^B51902207 +"RTN","BMXSQL5",1,0) +BMXSQL5 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; +"RTN","BMXSQL5",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXSQL5",3,0) + ; +"RTN","BMXSQL5",4,0) + ; +"RTN","BMXSQL5",5,0) +SELECT ;EP - Get field names into BMXFLD("NAME")="FILE#^FIELD#" +"RTN","BMXSQL5",6,0) + N BMXA,BMXB,BMXS,BMXSINGL +"RTN","BMXSQL5",7,0) + N BMXINTNL +"RTN","BMXSQL5",8,0) + S T=$G(BMXTK("SELECT")) +"RTN","BMXSQL5",9,0) + I '+T S BMXERR="'SELECT' CLAUSE NOT FOUND" D ERRTACK^BMXSQL(1) Q +"RTN","BMXSQL5",10,0) + S BMXFLD=0 +"RTN","BMXSQL5",11,0) + N BMXOFF,BMXGS1,BMXLVL +"RTN","BMXSQL5",12,0) + F S T=$O(BMXTK(T)) Q:'+T Q:T=$G(BMXTK("FROM")) I BMXTK(T)'="," S BMXOFF=1,BMXLVL=0 D S1 Q:$D(BMXERR) +"RTN","BMXSQL5",13,0) + Q +"RTN","BMXSQL5",14,0) + ; +"RTN","BMXSQL5",15,0) +SALIAS ; +"RTN","BMXSQL5",16,0) + Q:'+$O(BMXTK(T)) +"RTN","BMXSQL5",17,0) + N V +"RTN","BMXSQL5",18,0) + S V=T+1 +"RTN","BMXSQL5",19,0) + Q:$G(BMXTK(V))="," +"RTN","BMXSQL5",20,0) + Q:V=$G(BMXTK("FROM")) +"RTN","BMXSQL5",21,0) + S:BMXTK(V)["'" BMXTK(V)=$P(BMXTK(V),"'",2) +"RTN","BMXSQL5",22,0) + S BMXFLDA(BMXFILE,BMXFLDN)=BMXTK(V) +"RTN","BMXSQL5",23,0) + S $P(BMXFLDO(BMXFLDO-1),U,6)=BMXTK(V) +"RTN","BMXSQL5",24,0) + S T=T+1 +"RTN","BMXSQL5",25,0) + Q +"RTN","BMXSQL5",26,0) + ; +"RTN","BMXSQL5",27,0) +S1 ; +"RTN","BMXSQL5",28,0) + S BMXTK(T)=$TR(BMXTK(T),"_"," ") +"RTN","BMXSQL5",29,0) + ;Check for INTERNAL[ modifier +"RTN","BMXSQL5",30,0) + S BMXGS1=0 +"RTN","BMXSQL5",31,0) + S BMXINTNL="E" +"RTN","BMXSQL5",32,0) + I BMXTK(T)["[" S BMXINTNL="I",BMXTK(T)=$P(BMXTK(T),"[",2),BMXTK(T)=$P(BMXTK(T),"]",1) +"RTN","BMXSQL5",33,0) + ;If explicit file name +"RTN","BMXSQL5",34,0) + S BMXSINGL=0 +"RTN","BMXSQL5",35,0) + I BMXTK(T)["." D G:BMXGS1 S1 G:BMXSINGL NOTEXP Q +"RTN","BMXSQL5",36,0) + . ;Before FILE.FIELD Parsing +"RTN","BMXSQL5",37,0) + . S BMXA=$P(BMXTK(T),".",1,BMXOFF) ;File Name +"RTN","BMXSQL5",38,0) + . I '$D(BMXF(BMXA)) D Q:$D(BMXERR) Q:BMXSINGL +"RTN","BMXSQL5",39,0) + . . I $D(^DD(BMXFO(1),"B",BMXTK(T))),BMXOFF=1 S BMXSINGL=1 Q +"RTN","BMXSQL5",40,0) + . . S BMXERR="FILE NOT FOUND" D ERRTACK^BMXSQL(1) Q +"RTN","BMXSQL5",41,0) + . S BMXB=$P(BMXTK(T),".",1+BMXOFF,99) ;Field Name TODO: Test here for multiple in extended pointer -- FILE.MULTIPLE.FIELD +"RTN","BMXSQL5",42,0) + . N BMXLAST S BMXLAST=0 +"RTN","BMXSQL5",43,0) + . I $L(BMXB,".")>1 D Q:'BMXLAST ;Multiple +"RTN","BMXSQL5",44,0) + . . N BMXFNUM,BMXFNAM,BMXFNOD,BMXSUBFN,BMXUPFN,BMXGL,W,BMXFOUND +"RTN","BMXSQL5",45,0) + . . ;Multiple or Field-name with period? +"RTN","BMXSQL5",46,0) + . . S BMXFOUND=0 +"RTN","BMXSQL5",47,0) + . . F W=1:1:$L(BMXTK(T),".") D Q:BMXFOUND +"RTN","BMXSQL5",48,0) + . . . S BMXOFF=BMXOFF+1 +"RTN","BMXSQL5",49,0) + . . . I $D(^DD(BMXF(BMXA),"B",$P(BMXB,".",1,W))) D +"RTN","BMXSQL5",50,0) + . . . . S BMXFNAM=$P(BMXB,".",1,W) +"RTN","BMXSQL5",51,0) + . . . . S BMXFOUND=1 +"RTN","BMXSQL5",52,0) + . . . . S:W=$L(BMXB,".") BMXLAST=1 +"RTN","BMXSQL5",53,0) + . . . . S BMXLVL=BMXLVL+1 +"RTN","BMXSQL5",54,0) + . . ; +"RTN","BMXSQL5",55,0) + . . Q:BMXLAST +"RTN","BMXSQL5",56,0) + . . S BMXF=BMXF+1 +"RTN","BMXSQL5",57,0) + . . S BMXFNUM=$O(^DD(BMXF(BMXA),"B",BMXFNAM,0)) ;FieldNumber +"RTN","BMXSQL5",58,0) + . . S BMXFNOD=^DD(BMXF(BMXA),BMXFNUM,0) +"RTN","BMXSQL5",59,0) + . . S BMXGL=$P(BMXFNOD,U,4),BMXGL=$P(BMXGL,";") +"RTN","BMXSQL5",60,0) + . . S BMXSUBFN=+$P(BMXFNOD,U,2) ;Subfile Number +"RTN","BMXSQL5",61,0) + . . S BMXUPFN=^DD(BMXSUBFN,0,"UP") ;Parent File Number +"RTN","BMXSQL5",62,0) + . . D SETMFL(BMXUPFN,BMXSUBFN,BMXGL,BMXLVL,0) +"RTN","BMXSQL5",63,0) + . . S BMXGS1=1 +"RTN","BMXSQL5",64,0) + . S:BMXB["'" BMXB=$P(BMXB,"'",2) +"RTN","BMXSQL5",65,0) + . I BMXB="BMXIEN" D Q +"RTN","BMXSQL5",66,0) + . . S BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA) +"RTN","BMXSQL5",67,0) + . . S $P(BMXFLD(BMXA_"."_BMXB),"^",2)=".001" +"RTN","BMXSQL5",68,0) + . . D SELECT1 +"RTN","BMXSQL5",69,0) + . I BMXB="*" D Q ;All fields in file BMXA +"RTN","BMXSQL5",70,0) + . . ;BMXIEN Has to be first because ADO doesn't handle it well if a DATE type column is returned first +"RTN","BMXSQL5",71,0) + . . S BMXB="BMXIEN" +"RTN","BMXSQL5",72,0) + . . S BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA) +"RTN","BMXSQL5",73,0) + . . S $P(BMXFLD(BMXA_"."_BMXB),"^",2)=".001" +"RTN","BMXSQL5",74,0) + . . D SELECT1 +"RTN","BMXSQL5",75,0) + . . S BMXB=0 F S BMXB=$O(^DD(BMXF(BMXA),"B",BMXB)) Q:BMXB="" D +"RTN","BMXSQL5",76,0) + . . . S BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA) +"RTN","BMXSQL5",77,0) + . . . S $P(BMXFLD(BMXA_"."_BMXB),"^",2)=$O(^DD(BMXF(BMXA),"B",BMXB,0)) +"RTN","BMXSQL5",78,0) + . . . D SELECT1 +"RTN","BMXSQL5",79,0) + . S BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA) +"RTN","BMXSQL5",80,0) + . I '$D(^DD(BMXF(BMXA),"B",BMXB)) S BMXERR="FIELD NOT FOUND" D ERRTACK^BMXSQL(1) Q +"RTN","BMXSQL5",81,0) + . S $P(BMXFLD(BMXA_"."_BMXB),"^",2)=$O(^DD(BMXF(BMXA),"B",BMXB,0)) +"RTN","BMXSQL5",82,0) + . D SELECT1 +"RTN","BMXSQL5",83,0) + . Q +"RTN","BMXSQL5",84,0) + ; +"RTN","BMXSQL5",85,0) +NOTEXP ;File not explicit so Loop through files in BMXF to locate field name +"RTN","BMXSQL5",86,0) + ; +"RTN","BMXSQL5",87,0) + I BMXTK(T)["'" S BMXTK(T)=$P(BMXTK(T),"'",2) +"RTN","BMXSQL5",88,0) + S C=0,BMXA="" +"RTN","BMXSQL5",89,0) + I BMXTK(T)="BMXIEN" D Q +"RTN","BMXSQL5",90,0) + . S BMXB=BMXTK(T) +"RTN","BMXSQL5",91,0) + . S BMXA=BMXFO(1) ;File defaults to first named file in FROM +"RTN","BMXSQL5",92,0) + . S BMXA=BMXFNX(BMXA) +"RTN","BMXSQL5",93,0) + . S BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA) +"RTN","BMXSQL5",94,0) + . S $P(BMXFLD(BMXA_"."_BMXB),"^",2)=".001" +"RTN","BMXSQL5",95,0) + . D SELECT1 +"RTN","BMXSQL5",96,0) + F S BMXA=$O(BMXF(BMXA)) Q:BMXA="" D Q:$D(BMXERR) +"RTN","BMXSQL5",97,0) + . S BMXB=BMXTK(T) +"RTN","BMXSQL5",98,0) + . I BMXB="*" D Q ;All fields in file BMXA +"RTN","BMXSQL5",99,0) + . . S BMXB="BMXIEN" +"RTN","BMXSQL5",100,0) + . . S BMXA=BMXFO(1) ;File defaults to first named file in FROM +"RTN","BMXSQL5",101,0) + . . S BMXA=BMXFNX(BMXA) +"RTN","BMXSQL5",102,0) + . . S BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA) +"RTN","BMXSQL5",103,0) + . . S $P(BMXFLD(BMXA_"."_BMXB),"^",2)=".001" +"RTN","BMXSQL5",104,0) + . . D SELECT1 +"RTN","BMXSQL5",105,0) + . . S BMXB=0 F S BMXB=$O(^DD(BMXF(BMXA),"B",BMXB)) Q:BMXB="" D +"RTN","BMXSQL5",106,0) + . . . S BMXS=BMXA_"."_BMXB +"RTN","BMXSQL5",107,0) + . . . S BMXFLD(BMXS)=BMXF(BMXA) +"RTN","BMXSQL5",108,0) + . . . S $P(BMXFLD(BMXS),"^",2)=$O(^DD(BMXF(BMXA),"B",BMXB,0)) +"RTN","BMXSQL5",109,0) + . . . D SELECT1 +"RTN","BMXSQL5",110,0) + . . . S C=1 +"RTN","BMXSQL5",111,0) + . I $D(^DD(BMXF(BMXA),"B",BMXTK(T))) D Q:$D(BMXERR) +"RTN","BMXSQL5",112,0) + . . S C=C+1 +"RTN","BMXSQL5",113,0) + . . I C>1 S BMXERR="AMBIGUOUS FIELD NAME" D ERRTACK^BMXSQL(1) Q +"RTN","BMXSQL5",114,0) + . . S BMXB=BMXTK(T) ;Field Name +"RTN","BMXSQL5",115,0) + . . I BMXB["'" S BMXB=$P(BMXB,"'",2) +"RTN","BMXSQL5",116,0) + . . S BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA) +"RTN","BMXSQL5",117,0) + . . S $P(BMXFLD(BMXA_"."_BMXB),"^",2)=$O(^DD(BMXF(BMXA),"B",BMXB,0)) +"RTN","BMXSQL5",118,0) + . . D SELECT1 +"RTN","BMXSQL5",119,0) + . . Q +"RTN","BMXSQL5",120,0) + . Q +"RTN","BMXSQL5",121,0) + I C=0 S BMXERR="FIELD NOT FOUND" D ERRTACK^BMXSQL(1) Q +"RTN","BMXSQL5",122,0) + Q +"RTN","BMXSQL5",123,0) + ; +"RTN","BMXSQL5",124,0) +SELECT1 ; +"RTN","BMXSQL5",125,0) + N BMXGNOD,BMXFILE,BMXGNOD1 +"RTN","BMXSQL5",126,0) + S BMXFLDN=$P(BMXFLD(BMXA_"."_BMXB),"^",2) +"RTN","BMXSQL5",127,0) + S BMXFILE=$P(BMXFLD(BMXA_"."_BMXB),U) +"RTN","BMXSQL5",128,0) + S BMXFLDN(BMXFILE,BMXFLDN)=BMXB +"RTN","BMXSQL5",129,0) + I BMXFLDN=".001" S BMXGNOD="IEN",BMXGNOD1="",$P(BMXGNOD1,U,2)="N" +"RTN","BMXSQL5",130,0) + E S BMXGNOD1=^DD(BMXFILE,BMXFLDN,0) +"RTN","BMXSQL5",131,0) + S BMXGNOD=$P(BMXGNOD1,"^",4) +"RTN","BMXSQL5",132,0) + S $P(BMXFLD(BMXA_"."_BMXB),"^",3)=$P(BMXGNOD,";") +"RTN","BMXSQL5",133,0) + S $P(BMXFLD(BMXA_"."_BMXB),"^",4)=$P(BMXGNOD,";",2) +"RTN","BMXSQL5",134,0) + S $P(BMXFLD(BMXA_"."_BMXB),"^",5)=BMXINTNL +"RTN","BMXSQL5",135,0) + S BMXFLDO(BMXFLD)=BMXFILE_"^"_BMXFLDN_"^"_BMXINTNL +"RTN","BMXSQL5",136,0) + I +$P(BMXGNOD1,U,2) D ;Check for WP +"RTN","BMXSQL5",137,0) + . S BMXGNOD1=+$P(BMXGNOD1,U,2) +"RTN","BMXSQL5",138,0) + . Q:'$D(^DD(BMXGNOD1,.01,0)) +"RTN","BMXSQL5",139,0) + . I $P(^DD(BMXGNOD1,.01,0),U,2)["W" S $P(BMXFLDO(BMXFLD),U,4)="W" +"RTN","BMXSQL5",140,0) + ;HMW20030630 Modified next line to make data type of Internal[] for pointer an Integer. +"RTN","BMXSQL5",141,0) + I $P(BMXGNOD1,U,2)["P" S BMXGNOD1=$$PTYPE(BMXGNOD1) Q:BMXGNOD1="" S:$G(BMXINTNL)="I" $P(BMXGNOD1,U,2)="N" ;I BMXGNOD1="" then Pointed-to file doesn't exist +"RTN","BMXSQL5",142,0) + I $P(BMXGNOD1,U,2)["D" S $P(BMXFLDO(BMXFLD),U,5)="D" +"RTN","BMXSQL5",143,0) + I $P(BMXGNOD1,U,2)["N" D +"RTN","BMXSQL5",144,0) + . N Z +"RTN","BMXSQL5",145,0) + . S Z=$P(BMXGNOD1,U,2) +"RTN","BMXSQL5",146,0) + . I +$P(Z,",",2)=0 S $P(BMXFLDO(BMXFLD),U,5)="I" ;Integer +"RTN","BMXSQL5",147,0) + S BMXFLDOX(BMXFILE,BMXFLDN,BMXINTNL)=BMXFLD +"RTN","BMXSQL5",148,0) + S BMXFLD=BMXFLD+1 +"RTN","BMXSQL5",149,0) + S BMXFLDO=BMXFLD +"RTN","BMXSQL5",150,0) + D SALIAS +"RTN","BMXSQL5",151,0) + Q +"RTN","BMXSQL5",152,0) + ; +"RTN","BMXSQL5",153,0) +SETMFL(BMXUPFN,BMXSUBFN,BMXGL,BMXOFF,BMXOTM) ;EP +"RTN","BMXSQL5",154,0) + ; +"RTN","BMXSQL5",155,0) + ;BMXOTM = One-To-Many +"RTN","BMXSQL5",156,0) + N BMXUPG +"RTN","BMXSQL5",157,0) + S BMXMFL("PARENT",BMXSUBFN)=BMXUPFN +"RTN","BMXSQL5",158,0) + S BMXMFL(BMXUPFN,"SUBFILE",BMXSUBFN)="" +"RTN","BMXSQL5",159,0) + S BMXMFL("SUBFILE",BMXUPFN,BMXSUBFN)="" +"RTN","BMXSQL5",160,0) + S BMXUPG=BMXMFL(BMXUPFN,"GLOC") ;Parent File Global Set in FROM clause +"RTN","BMXSQL5",161,0) + S BMXFNAM=BMXA_"."_BMXFNAM ;TODO: Regression test this line with OTM +"RTN","BMXSQL5",162,0) + I 'BMXOTM S BMXMFL(BMXSUBFN,"GLOC")=BMXUPG_"IEN"_(BMXOFF-1)_","_$C(34)_BMXGL_$C(34)_"," +"RTN","BMXSQL5",163,0) + E S BMXMFL(BMXSUBFN,"GLOC")=BMXGL,BMXMFL(BMXSUBFN,"OTM")="" +"RTN","BMXSQL5",164,0) + S BMXMFL(BMXSUBFN,"MULT")="S IEN"_BMXOFF_"=0 F S IEN"_BMXOFF_"=$O("_BMXMFL(BMXSUBFN,"GLOC")_"IEN"_BMXOFF_")) Q:'+IEN"_BMXOFF_" " +"RTN","BMXSQL5",165,0) + I $D(BMXMFL(BMXUPFN,"MULT")) S BMXMFL(BMXSUBFN,"MULT")=BMXMFL(BMXUPFN,"MULT")_" "_BMXMFL(BMXSUBFN,"MULT") +"RTN","BMXSQL5",166,0) + I 'BMXOTM S BMXMFL(BMXSUBFN,"IENS")="N J S BMXIENS="""" F J=0:1:"_BMXOFF_" S BMXIENS=@(""IEN""_J)_"",""_BMXIENS" +"RTN","BMXSQL5",167,0) + E S BMXMFL(BMXSUBFN,"IENS")="N J S BMXIENS="""" S J=1 S BMXIENS=@(""IEN""_J)_"",""_BMXIENS" +"RTN","BMXSQL5",168,0) + S BMXMFL(BMXSUBFN,"EXEC")=BMXMFL(BMXSUBFN,"MULT")_"X BMXMFL(BMXFN,""IENS"")"_" D GETS^DIQ(BMXFN,BMXIENS,BMXGF(BMXFN),""E"",BMXA) D SETIEN(IEN"_BMXOFF_",BMXFN)" +"RTN","BMXSQL5",169,0) + D F1^BMXSQL(BMXF,BMXFNAM,BMXSUBFN) +"RTN","BMXSQL5",170,0) + ; +"RTN","BMXSQL5",171,0) + Q +"RTN","BMXSQL5",172,0) + ; +"RTN","BMXSQL5",173,0) +PTYPE(BMXGNOD1) ; +"RTN","BMXSQL5",174,0) + ;Traverse pointer chain to retrieve data type of pointed-to field +"RTN","BMXSQL5",175,0) + N BMXFILE +"RTN","BMXSQL5",176,0) + I $P(BMXGNOD1,U,2)'["P" Q BMXGNOD1 +"RTN","BMXSQL5",177,0) + S BMXFILE=$P(BMXGNOD1,U,2) +"RTN","BMXSQL5",178,0) + S BMXFILE=+$P(BMXFILE,"P",2) +"RTN","BMXSQL5",179,0) + S BMXGNOD1=$G(^DD(BMXFILE,".01",0)) +"RTN","BMXSQL5",180,0) + S BMXGNOD1=$$PTYPE(BMXGNOD1) +"RTN","BMXSQL5",181,0) + Q BMXGNOD1 +"RTN","BMXSQL6") +0^103^B130304448 +"RTN","BMXSQL6",1,0) +BMXSQL6 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; 7/20/2009 +"RTN","BMXSQL6",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXSQL6",3,0) + ; Line EOR+3 used a 2 argument form of $Q which is not +"RTN","BMXSQL6",4,0) + ; in the M 95 standard. Replaced this with a call to $$LAST, +"RTN","BMXSQL6",5,0) + ; a new Extrinsic in this routine. +"RTN","BMXSQL6",6,0) + ; +"RTN","BMXSQL6",7,0) + ; +"RTN","BMXSQL6",8,0) +WRITE ;EP +"RTN","BMXSQL6",9,0) + N BMXFN,C,BMXN,BMXGF,BMXA,BMXFLDF,N,A,IEN0,I +"RTN","BMXSQL6",10,0) + N BMXCNT,BMXCNTB,BMXLEN,BMXLTMP,BMXNUM,BMXORD,BMXTYP +"RTN","BMXSQL6",11,0) + N BMXCFN,BMXCFNX,F,BMXROOT,BMXCID,BMXZ ;From MAKEC +"RTN","BMXSQL6",12,0) + N BMXREC,BMXCHAIN ;TODO: COMMENT AFTER TESTING +"RTN","BMXSQL6",13,0) + N BMXIENS +"RTN","BMXSQL6",14,0) + ;Set up FIELD value for GETS^DIQ call +"RTN","BMXSQL6",15,0) + ; BMXFLD("NAME")="FILE#^FIELD#" +"RTN","BMXSQL6",16,0) + ; Need: BMXFLDN(FieldNumber) +"RTN","BMXSQL6",17,0) + ; and : BMXFLDO(SelectOrder) +"RTN","BMXSQL6",18,0) + ; Get file number -- for now just use first file in array +"RTN","BMXSQL6",19,0) + ; TODO: Set up same main file and related files here and in enumerator +"RTN","BMXSQL6",20,0) + S C=0,BMXN="" +"RTN","BMXSQL6",21,0) + N F +"RTN","BMXSQL6",22,0) + S BMXGF=0 +"RTN","BMXSQL6",23,0) + S F=0 F S F=$O(BMXF(F)) Q:F="" S BMXFN=BMXF(F) D +"RTN","BMXSQL6",24,0) + . S C=0,BMXN=-1 F S BMXN=$O(BMXFLDO(BMXN)) Q:BMXN="" D +"RTN","BMXSQL6",25,0) + . . Q:$P(BMXFLDO(BMXN),U)'=BMXFN +"RTN","BMXSQL6",26,0) + . . I $P(BMXFLDO(BMXN),U,2)=".001" S BMXGF=BMXGF+1 Q +"RTN","BMXSQL6",27,0) + . . S C=C+1 +"RTN","BMXSQL6",28,0) + . . S $P(BMXGF(BMXFN),";",C)=$P(BMXFLDO(BMXN),U,2) +"RTN","BMXSQL6",29,0) + . . S:'$D(BMXGF(BMXFN,"INTERNAL")) BMXGF(BMXFN,"INTERNAL")="E" +"RTN","BMXSQL6",30,0) + . . I $P(BMXFLDO(BMXN),U,3)="I" S BMXGF(BMXFN,"INTERNAL")="IE" +"RTN","BMXSQL6",31,0) + . . S BMXGF=BMXGF+1 +"RTN","BMXSQL6",32,0) + . . Q +"RTN","BMXSQL6",33,0) + . Q +"RTN","BMXSQL6",34,0) + ; +"RTN","BMXSQL6",35,0) + I BMXGF>1 K BMXTK("DISTINCT") ;Distinct supported for only one field +"RTN","BMXSQL6",36,0) + S N=0,BMXFLDF=0,I=1,BMXNUM=0 +"RTN","BMXSQL6",37,0) + D FIELDS +"RTN","BMXSQL6",38,0) + D MAKEC +"RTN","BMXSQL6",39,0) + ; +"RTN","BMXSQL6",40,0) + ; +"RTN","BMXSQL6",41,0) + I BMXCOL D COLTYPE^BMXSQL,ERRTACK^BMXSQL(I) Q ;Column info only +"RTN","BMXSQL6",42,0) + ; +"RTN","BMXSQL6",43,0) + S BMXA="A" +"RTN","BMXSQL6",44,0) + N G,R +"RTN","BMXSQL6",45,0) + ;---> Loop through results global +"RTN","BMXSQL6",46,0) + F S N=$O(^BMXTMP($J,N)) Q:'+N D +"RTN","BMXSQL6",47,0) + . K A +"RTN","BMXSQL6",48,0) + . S R=0 F S R=$O(BMXFO(R)) Q:'+R D ;For each file in ORDER array +"RTN","BMXSQL6",49,0) + . . S IEN0=0 +"RTN","BMXSQL6",50,0) + . . S BMXFN=BMXFO(R) +"RTN","BMXSQL6",51,0) + . . Q:$D(BMXMFL(BMXFN,"MULT")) +"RTN","BMXSQL6",52,0) + . . I R=1 S IEN0=^BMXTMP($J,N) ;Primary file +"RTN","BMXSQL6",53,0) + . . I R>1,$D(BMXFJ("JOIN",BMXFN)) D ;Joined file +"RTN","BMXSQL6",54,0) + . . . S IEN0=0 +"RTN","BMXSQL6",55,0) + . . . S G=BMXFJ("JOIN",BMXFN) +"RTN","BMXSQL6",56,0) + . . . S V=BMXFF(G,"JOIN","IEN") +"RTN","BMXSQL6",57,0) + . . . S @V=^BMXTMP($J,N) +"RTN","BMXSQL6",58,0) + . . . X BMXFF(G,"JOIN") +"RTN","BMXSQL6",59,0) + . . I +IEN0 D ;Removed $D(BMXGF(BMXFN)) for mult fld on extdnd ptr +"RTN","BMXSQL6",60,0) + . . . D SUBFILE(BMXFN) +"RTN","BMXSQL6",61,0) + . . I +IEN0,$D(BMXFLDN(BMXFN,.001)) D SETIEN(IEN0,BMXFN) +"RTN","BMXSQL6",62,0) + . . ; +"RTN","BMXSQL6",63,0) + . . I 0,R>1,$D(BMXMFL(BMXFN,"MULT")) D ;Multiple field +"RTN","BMXSQL6",64,0) + . . . Q:'+IEN0 +"RTN","BMXSQL6",65,0) + . . . Q:'$D(BMXGF(BMXFN)) ;Intervening multiple +"RTN","BMXSQL6",66,0) + . . . ;Call GETS for each subentry in multiple +"RTN","BMXSQL6",67,0) + . . . X BMXMFL(BMXFN,"EXEC") +"RTN","BMXSQL6",68,0) + . S F=0,BMXCNT=0 +"RTN","BMXSQL6",69,0) + . ; +"RTN","BMXSQL6",70,0) + . D RECORD +"RTN","BMXSQL6",71,0) + . D OUT +"RTN","BMXSQL6",72,0) + ; +"RTN","BMXSQL6",73,0) + ; +"RTN","BMXSQL6",74,0) + ;---> Tack on Error Delimiter and any error. +"RTN","BMXSQL6",75,0) + S I=I+1 +"RTN","BMXSQL6",76,0) + D ERRTACK^BMXSQL(I) +"RTN","BMXSQL6",77,0) + D COLTYPE^BMXSQL +"RTN","BMXSQL6",78,0) + Q +"RTN","BMXSQL6",79,0) + ; +"RTN","BMXSQL6",80,0) +SETIEN(BMXIEN,BMXFN) ; +"RTN","BMXSQL6",81,0) + ;B ;SETIEN +"RTN","BMXSQL6",82,0) + Q:'$D(BMXFLDN(BMXFN,.001)) +"RTN","BMXSQL6",83,0) + Q:'+BMXIEN +"RTN","BMXSQL6",84,0) + S A(BMXFN,BMXIEN_",",.001,"E")=BMXIEN +"RTN","BMXSQL6",85,0) + Q +"RTN","BMXSQL6",86,0) + ; +"RTN","BMXSQL6",87,0) +SUBFILE(BMXFN) ; +"RTN","BMXSQL6",88,0) + ;Execute GETS for Any fields in BMXGF(SUBFILE) +"RTN","BMXSQL6",89,0) + ; +"RTN","BMXSQL6",90,0) + ;If the subfile itself has subfiles, call SUBFILE(BMXSUBFN) +"RTN","BMXSQL6",91,0) + ; (Loop through BMXMFL(BMXFN,"SUBFILE",BMXSUBFN)) +"RTN","BMXSQL6",92,0) + I $D(BMXMFL(BMXFN,"SUBFILE")) D +"RTN","BMXSQL6",93,0) + . N BMXSUBFN +"RTN","BMXSQL6",94,0) + . S BMXSUBFN=0 +"RTN","BMXSQL6",95,0) + . F S BMXSUBFN=$O(BMXMFL(BMXFN,"SUBFILE",BMXSUBFN)) Q:'+BMXSUBFN D SUBFILE(BMXSUBFN) +"RTN","BMXSQL6",96,0) + . Q +"RTN","BMXSQL6",97,0) + ; +"RTN","BMXSQL6",98,0) + I $D(BMXGF(BMXFN)) D +"RTN","BMXSQL6",99,0) + . I '$D(BMXMFL(BMXFN,"MULT")) S BMXMSCR=1 D GETS^DIQ(BMXFN,IEN0_",",BMXGF(BMXFN),BMXGF(BMXFN,"INTERNAL"),BMXA) Q +"RTN","BMXSQL6",100,0) + . E X BMXMFL(BMXFN,"EXEC") Q +"RTN","BMXSQL6",101,0) + ; +"RTN","BMXSQL6",102,0) + ; +"RTN","BMXSQL6",103,0) + Q +"RTN","BMXSQL6",104,0) + ; +"RTN","BMXSQL6",105,0) +FIELDS ;---> Write Field Names +"RTN","BMXSQL6",106,0) + ;Field name is TAAAAANAME +"RTN","BMXSQL6",107,0) + ;Where T is the field type (T=Text; D=Date) +"RTN","BMXSQL6",108,0) + ; AAAAA is the field size (see NUMCHAR routine) +"RTN","BMXSQL6",109,0) + ; NAME is the field name +"RTN","BMXSQL6",110,0) + N BMXNUM,BMXFNUM,BMXFNAM,R +"RTN","BMXSQL6",111,0) + K BMXLEN,BMXTYP +"RTN","BMXSQL6",112,0) + S BMXFLDF=1 +"RTN","BMXSQL6",113,0) + S BMXNUM=0 +"RTN","BMXSQL6",114,0) + ;B ;In FIELDS sub +"RTN","BMXSQL6",115,0) + D ;:$D(A) +"RTN","BMXSQL6",116,0) + . I BMXNUM S ^BMXTEMP($J,I)="IEN^",BMXLEN(I)=10,BMXTYP(I)="T",I=I+1 ;TODO: Change from text to number +"RTN","BMXSQL6",117,0) + . S BMXFNUM=0 +"RTN","BMXSQL6",118,0) + . S BMXFNAM=0 +"RTN","BMXSQL6",119,0) + . F R=0:1:(BMXFLDO-1) S BMXFN=$P(BMXFLDO(R),U),BMXFNUM=$P(BMXFLDO(R),U,2) D +"RTN","BMXSQL6",120,0) + . . ;S BMXFNAM=$P(^DD(BMXFN,BMXFNUM,0),"^") ;Get type here +"RTN","BMXSQL6",121,0) + . . S BMXFNAM=BMXFLDN(BMXFN,BMXFNUM) +"RTN","BMXSQL6",122,0) + . . I $P(BMXFLDO(R),U,3)="I" S BMXFNAM="INTERNAL["_BMXFNAM_"]" +"RTN","BMXSQL6",123,0) + . . S BMXFNAM=$TR(BMXFNAM," ","_") +"RTN","BMXSQL6",124,0) + . . I BMXF>1 S BMXFNAM=$TR($P(BMXFNX(BMXFN),".")," ","_")_"."_BMXFNAM +"RTN","BMXSQL6",125,0) + . . S BMXTYP(I)="T" +"RTN","BMXSQL6",126,0) + . . S:$P(BMXFLDO(R),U,5)="D" BMXTYP(I)="D" +"RTN","BMXSQL6",127,0) + . . S:$P(BMXFLDO(R),U,5)="I" BMXTYP(I)="I" +"RTN","BMXSQL6",128,0) + . . S BMXLEN(I)=0 ;Start with length zero +"RTN","BMXSQL6",129,0) + . . ;I $D(BMXFLDA(BMXFN,BMXFNUM)) S BMXFNAM=BMXFLDA(BMXFN,BMXFNUM) +"RTN","BMXSQL6",130,0) + . . I $P(BMXFLDO(R),U,6)]"" S BMXFNAM=$P(BMXFLDO(R),U,6) +"RTN","BMXSQL6",131,0) + . . S ^BMXTEMP($J,I)=BMXFNAM_"^" +"RTN","BMXSQL6",132,0) + . . S I=I+1 +"RTN","BMXSQL6",133,0) + . S ^BMXTEMP($J,I-1)=$E(^BMXTEMP($J,I-1),1,$L(^BMXTEMP($J,I-1))-1)_$C(30) +"RTN","BMXSQL6",134,0) + Q +"RTN","BMXSQL6",135,0) + ; +"RTN","BMXSQL6",136,0) +OUT ; +"RTN","BMXSQL6",137,0) + ;Output to BMXTEMP($J +"RTN","BMXSQL6",138,0) + Q:'$D(BMXREC) +"RTN","BMXSQL6",139,0) + N J,K,L,BMXLENT +"RTN","BMXSQL6",140,0) + S J=0 F S J=$O(BMXREC(J)) Q:'+J D +"RTN","BMXSQL6",141,0) + . S K=0 F S K=$O(BMXREC(J,K)) Q:'+K D +"RTN","BMXSQL6",142,0) + . . I +$O(BMXREC(J,K,0)) D Q ;WP +"RTN","BMXSQL6",143,0) + . . . S L=0,BMXLENT=0 F S L=$O(BMXREC(J,K,L)) Q:'+L D +"RTN","BMXSQL6",144,0) + . . . . S:'$D(^BMXTEMP($J,I)) ^BMXTEMP($J,I)="" +"RTN","BMXSQL6",145,0) + . . . . S:$L(^BMXTEMP($J,I))>250 I=I+1,^BMXTEMP($J,I)="" +"RTN","BMXSQL6",146,0) + . . . . S ^BMXTEMP($J,I)=^BMXTEMP($J,I)_BMXREC(J,K,L) +"RTN","BMXSQL6",147,0) + . . . . S BMXLENT=BMXLENT+$L(BMXREC(J,K,L)) +"RTN","BMXSQL6",148,0) + . . . I BMXLEN(K)250 I=I+1,^BMXTEMP($J,I)="" +"RTN","BMXSQL6",151,0) + . . I $G(BMXTK("DISTINCT"))="TRUE",BMXREC(J,K)]"" Q:$D(^BMXTEMP($J,"DISTINCT",BMXREC(J,K))) +"RTN","BMXSQL6",152,0) + . . S ^BMXTEMP($J,I)=^BMXTEMP($J,I)_BMXREC(J,K) +"RTN","BMXSQL6",153,0) + . . S:$L(BMXREC(J,K))>BMXLEN(K) BMXLEN(K)=$L(BMXREC(J,K)) +"RTN","BMXSQL6",154,0) + . . I $G(BMXTK("DISTINCT"))="TRUE" S ^BMXTEMP($J,"DISTINCT",BMXREC(J,K))="" +"RTN","BMXSQL6",155,0) + Q +"RTN","BMXSQL6",156,0) + ; +"RTN","BMXSQL6",157,0) +RECORD ; +"RTN","BMXSQL6",158,0) + ;For each chain +"RTN","BMXSQL6",159,0) + N C,BMXCQ,BMXLCQ,BMXCQN,BMXLCQN,BMXTRACK,BMXNODE,BMXCNAME,BMXWP +"RTN","BMXSQL6",160,0) + K BMXREC,BMXCHAIN ;TODO: REMOVE AFTER TESTING +"RTN","BMXSQL6",161,0) + D BLDCHN +"RTN","BMXSQL6",162,0) + S BMXREC=0 +"RTN","BMXSQL6",163,0) + D RECINI +"RTN","BMXSQL6",164,0) + S C=0 F S C=$O(BMXCHAIN(C)) Q:'+C D +"RTN","BMXSQL6",165,0) + . ;New chain +"RTN","BMXSQL6",166,0) + . ;Go to the end of the chain, writing record pieces as you go +"RTN","BMXSQL6",167,0) + . ;At the end of the chain, write end-of-record marker,increment record counter, copy previous record +"RTN","BMXSQL6",168,0) + . K BMXTRACK +"RTN","BMXSQL6",169,0) + . S BMXCNAME="BMXCHAIN("_C_")" +"RTN","BMXSQL6",170,0) + . S BMXCQN="" +"RTN","BMXSQL6",171,0) + . S BMXCQ=BMXCNAME F S BMXCQ=$Q(@BMXCQ) Q:BMXCQ="" Q:$P(BMXCQ,",")'=("BMXCHAIN("_C) D +"RTN","BMXSQL6",172,0) + . . S BMXNODE=@BMXCQ +"RTN","BMXSQL6",173,0) + . . I $P(BMXNODE,U,2)="" Q +"RTN","BMXSQL6",174,0) + . . S BMXWP=$P(BMXNODE,U,3) +"RTN","BMXSQL6",175,0) + . . S BMXLCQ=$L(BMXCQ,",") +"RTN","BMXSQL6",176,0) + . . S BMXCQN=$Q(@BMXCQ) +"RTN","BMXSQL6",177,0) + . . S BMXLCQN=$L(BMXCQN,",") +"RTN","BMXSQL6",178,0) + . . I BMXWP="W" D +"RTN","BMXSQL6",179,0) + . . . S BMXREC(BMXREC,$P(BMXNODE,U,2),$P(BMXNODE,U,4))=$P(BMXNODE,U) +"RTN","BMXSQL6",180,0) + . . . S BMXTRACK(BMXLCQ-1,$P(BMXNODE,U,2))=BMXNODE +"RTN","BMXSQL6",181,0) + . . E D +"RTN","BMXSQL6",182,0) + . . . S BMXREC(BMXREC,$P(BMXNODE,U,2))=$P(BMXNODE,U)_U +"RTN","BMXSQL6",183,0) + . . . S BMXTRACK(BMXLCQ,$P(BMXNODE,U,2))=BMXNODE +"RTN","BMXSQL6",184,0) + . . I BMXCQN="" D EOR Q +"RTN","BMXSQL6",185,0) + . . I $P(BMXCQN,",")'=("BMXCHAIN("_C) D EOR Q +"RTN","BMXSQL6",186,0) + . . I BMXLCQN>BMXLCQ Q +"RTN","BMXSQL6",187,0) + . . I (BMXLCQN>$S(BMXWP="W":7,1:6)) D Q +"RTN","BMXSQL6",188,0) + . . . I ($P(BMXCQ,",",1,BMXLCQ-2)=$P(BMXCQN,",",1,BMXLCQN-2)) Q +"RTN","BMXSQL6",189,0) + . . . D EOR ;End of chain +"RTN","BMXSQL6",190,0) + Q +"RTN","BMXSQL6",191,0) + ; +"RTN","BMXSQL6",192,0) +RECINI ; +"RTN","BMXSQL6",193,0) + N J +"RTN","BMXSQL6",194,0) + S BMXREC=BMXREC+1 +"RTN","BMXSQL6",195,0) + F J=1:1:BMXFLDO D +"RTN","BMXSQL6",196,0) + . I $P(BMXFLDO(J-1),U,4)="W" S BMXREC(BMXREC,J,999999)="^" Q +"RTN","BMXSQL6",197,0) + . S BMXREC(BMXREC,J)="^" +"RTN","BMXSQL6",198,0) + Q +"RTN","BMXSQL6",199,0) + ; +"RTN","BMXSQL6",200,0) +EOR ; +"RTN","BMXSQL6",201,0) + ;B ;EOR +"RTN","BMXSQL6",202,0) + N J,K,L,M,I,N +"RTN","BMXSQL6",203,0) + ; S M=$Q(BMXREC(9999999),-1) //SMH - Another Cacheism +"RTN","BMXSQL6",204,0) + S M=$$LAST("BMXREC") +"RTN","BMXSQL6",205,0) + S @M=$TR(@M,"^",$C(30)) +"RTN","BMXSQL6",206,0) + Q:BMXCQN="" +"RTN","BMXSQL6",207,0) + I BMXCQN'="" D RECINI +"RTN","BMXSQL6",208,0) + ;K BMXTRACK(BMXLCQ) ;Also kill all track levels between current and next level +"RTN","BMXSQL6",209,0) + F K BMXTRACK($O(BMXTRACK(999999),-1)) Q:$O(BMXTRACK(9999999),-1)'>BMXLCQN +"RTN","BMXSQL6",210,0) + S J=0 F S J=$O(BMXTRACK(J)) Q:'+J D ;Level +"RTN","BMXSQL6",211,0) + . S K=0 F S K=$O(BMXTRACK(J,K)) Q:'+K D ;Order +"RTN","BMXSQL6",212,0) + . . I $D(BMXTRACK(J,K)) S BMXNODE=BMXTRACK(J,K) S BMXREC(BMXREC,$P(BMXNODE,U,2))=$P(BMXNODE,U)_U +"RTN","BMXSQL6",213,0) + . . S L=0 F S L=$O(BMXTRACK(J,K,L)) Q:'+L D ;wp node +"RTN","BMXSQL6",214,0) + . . . I $D(BMXTRACK(J,K,L)) S BMXNODE=BMXTRACK(J,K,L) S BMXREC(BMXREC,$P(BMXNODE,U,2),L)=$P(BMXNODE,U) +"RTN","BMXSQL6",215,0) + Q +"RTN","BMXSQL6",216,0) + ; +"RTN","BMXSQL6",217,0) +BLDCHN ; +"RTN","BMXSQL6",218,0) + N B +"RTN","BMXSQL6",219,0) + D MAKEB +"RTN","BMXSQL6",220,0) + ;D MAKEC +"RTN","BMXSQL6",221,0) + D BUILD +"RTN","BMXSQL6",222,0) + Q +"RTN","BMXSQL6",223,0) + ; +"RTN","BMXSQL6",224,0) +MAKEC ; +"RTN","BMXSQL6",225,0) + ;MAKE Chain +"RTN","BMXSQL6",226,0) + ;How many chains are there? +"RTN","BMXSQL6",227,0) + S BMXZ=0 S BMXCID=1 K BMXCFN +"RTN","BMXSQL6",228,0) + ; +"RTN","BMXSQL6",229,0) + ; +"RTN","BMXSQL6",230,0) + ;Create BMXCHNP(BMXCID) +"RTN","BMXSQL6",231,0) + S F=0 F S F=$O(BMXMFL(F)) Q:'+F I '$D(BMXMFL("SUBFILE",F)),$D(BMXMFL("PARENT",F)) S BMXMFL("BOTTOM",F)="" +"RTN","BMXSQL6",232,0) + N BMXCB,BMXCHNP,BMXP +"RTN","BMXSQL6",233,0) + S BMXCID=0,BMXCB=0,BMXCHNP=0 +"RTN","BMXSQL6",234,0) + I $D(BMXMFL("BOTTOM")) F S BMXCB=$O(BMXMFL("BOTTOM",BMXCB)) Q:'BMXCB D +"RTN","BMXSQL6",235,0) + . S BMXCID=BMXCID+1,BMXCHNP=BMXCID +"RTN","BMXSQL6",236,0) + . S BMXCHNP(BMXCID)=BMXCB +"RTN","BMXSQL6",237,0) + . S BMXP=BMXCB +"RTN","BMXSQL6",238,0) + . F Q:'$D(BMXMFL("PARENT",BMXP)) S BMXP=BMXMFL("PARENT",BMXP) S BMXCHNP(BMXCID)=BMXP_U_BMXCHNP(BMXCID) +"RTN","BMXSQL6",239,0) + ; +"RTN","BMXSQL6",240,0) + N J,K,L,M +"RTN","BMXSQL6",241,0) + ;Create BMXMFL("BASE")="FILE1^FILE2^...^FILEN" +"RTN","BMXSQL6",242,0) + S F=0,M=0,BMXMFL("BASE")="" F S F=$O(BMXMFL(F)) Q:'+F I (('$D(BMXMFL("PARENT",F)))&('$D(BMXMFL(F,"SUBFILE"))))!(BMXFO(1)=F) S M=M+1,$P(BMXMFL("BASE"),U,M)=F ;Changed to make BMXFO(1) always a member of the base +"RTN","BMXSQL6",243,0) + ; +"RTN","BMXSQL6",244,0) + ;Create BMXCFN(BMXCID,BMXZ,FILE) +"RTN","BMXSQL6",245,0) + I BMXCID=0 S BMXCID=1 +"RTN","BMXSQL6",246,0) + S J=0,BMXZ=0 F J=1:1:BMXCID D +"RTN","BMXSQL6",247,0) + . I BMXMFL("BASE")]"" F L=1:1:$L(BMXMFL("BASE"),"^") S F=$P(BMXMFL("BASE"),"^",L) D +"RTN","BMXSQL6",248,0) + . . S BMXZ=BMXZ+100 +"RTN","BMXSQL6",249,0) + . . S BMXCFN(J,BMXZ,F)="" +"RTN","BMXSQL6",250,0) + . I +BMXCHNP F K=1:1:$L(BMXCHNP(J),"^") S F=$P(BMXCHNP(J),"^",K) D +"RTN","BMXSQL6",251,0) + . . Q:F=BMXFO(1) ;BMXFO(1) Is always a member of the base +"RTN","BMXSQL6",252,0) + . . S BMXZ=BMXZ+100 +"RTN","BMXSQL6",253,0) + . . S BMXCFN(J,BMXZ,F)="" +"RTN","BMXSQL6",254,0) + ; +"RTN","BMXSQL6",255,0) + ; +"RTN","BMXSQL6",256,0) + ;B ;FIXCFN +"RTN","BMXSQL6",257,0) + D FIXCFN +"RTN","BMXSQL6",258,0) + Q +"RTN","BMXSQL6",259,0) + ; +"RTN","BMXSQL6",260,0) +BUILD ;Building BMXCHAIN( +"RTN","BMXSQL6",261,0) + N BMXIEN,BMXCID,BMXFLD,BMXCS,BMXINT,BMXCFNC,BMXCFIEN +"RTN","BMXSQL6",262,0) + S BMXCID=0,BMXIEN=0 +"RTN","BMXSQL6",263,0) + F S BMXCID=$O(BMXCFN(BMXCID)) Q:'+BMXCID D +"RTN","BMXSQL6",264,0) + . S BMXCFNC=0 F S BMXCFNC=$O(BMXCFN(BMXCID,BMXCFNC)) Q:'+BMXCFNC S BMXCFN=+BMXCFN(BMXCID,BMXCFNC) D +"RTN","BMXSQL6",265,0) + . . S BMXIEN=0 F S BMXIEN=$O(B(BMXCFN,BMXIEN)) Q:BMXIEN="" D +"RTN","BMXSQL6",266,0) + . . . S $P(BMXCFN(BMXCID,BMXCFNC),U,2)=BMXIEN +"RTN","BMXSQL6",267,0) + . . . S BMXFLD=0 F S BMXFLD=$O(B(BMXCFN,BMXIEN,BMXFLD)) Q:'+BMXFLD D +"RTN","BMXSQL6",268,0) + . . . . S BMXINT="D" F S BMXINT=$O(B(BMXCFN,BMXIEN,BMXFLD,BMXINT)) Q:BMXINT="" D +"RTN","BMXSQL6",269,0) + . . . . . Q:'$D(BMXFLDOX(BMXCFN,BMXFLD,BMXINT)) +"RTN","BMXSQL6",270,0) + . . . . . I $P(BMXFLDO(BMXFLDOX(BMXCFN,BMXFLD,BMXINT)),U,4)="W" D MCWP Q +"RTN","BMXSQL6",271,0) + . . . . . D FIXIEN +"RTN","BMXSQL6",272,0) + . . . . . S BMXCS="BMXCHAIN("_BMXCID_","_$S($L(BMXIEN,",")=2:1,1:2)_","_BMXCFIEN_","_BMXFLD_","_$C(34)_BMXINT_$C(34)_")" +"RTN","BMXSQL6",273,0) + . . . . . S @BMXCS=B(BMXCFN,BMXIEN,BMXFLD,BMXINT)_U_(BMXFLDOX(BMXCFN,BMXFLD,BMXINT)+1) +"RTN","BMXSQL6",274,0) + Q +"RTN","BMXSQL6",275,0) + ; +"RTN","BMXSQL6",276,0) +FIXIEN ; +"RTN","BMXSQL6",277,0) + N BMXC,BMXCFN1,BMXOFF +"RTN","BMXSQL6",278,0) + S BMXC=BMXCFNC +"RTN","BMXSQL6",279,0) + S BMXCFIEN=BMXCFN_","_$P(BMXIEN,",",$L(BMXIEN,",")) +"RTN","BMXSQL6",280,0) + S BMXOFF=1 +"RTN","BMXSQL6",281,0) + F S BMXC=$O(BMXCFN(BMXCID,BMXC),-1) Q:'+BMXC D +"RTN","BMXSQL6",282,0) + . S BMXCFN1=+BMXCFN(BMXCID,BMXC) +"RTN","BMXSQL6",283,0) + . I '$D(BMXMFL(BMXCFN,"OTM")) D +"RTN","BMXSQL6",284,0) + . . I '$D(BMXMFL(BMXCFN1,"SUBFILE",BMXCFN)) Q +"RTN","BMXSQL6",285,0) + . . S BMXCFIEN=BMXCFN1_","_$P(BMXIEN,",",$L(BMXIEN,",")-BMXOFF)_","_BMXCFIEN +"RTN","BMXSQL6",286,0) + . I $D(BMXMFL(BMXCFN,"OTM")) D +"RTN","BMXSQL6",287,0) + . . I '$D(BMXMFL(BMXCFN1,"SUBFILE",BMXCFN)) Q +"RTN","BMXSQL6",288,0) + . . S BMXCFIEN=BMXCFN1_$P(BMXCFN(BMXCID,BMXC),U,2)_","_BMXCFIEN +"RTN","BMXSQL6",289,0) + . S BMXOFF=BMXOFF+1 +"RTN","BMXSQL6",290,0) + ; +"RTN","BMXSQL6",291,0) + ; +"RTN","BMXSQL6",292,0) + Q +"RTN","BMXSQL6",293,0) + ; +"RTN","BMXSQL6",294,0) +FIXCFN ; +"RTN","BMXSQL6",295,0) + N J,K,L +"RTN","BMXSQL6",296,0) + S J=0 F S J=$O(BMXCFN(J)) Q:'+J D +"RTN","BMXSQL6",297,0) + . S K=0 F S K=$O(BMXCFN(J,K)) Q:'+K D +"RTN","BMXSQL6",298,0) + . . S L=0 F S L=$O(BMXCFN(J,K,L)) Q:'+L D +"RTN","BMXSQL6",299,0) + . . . K BMXCFN(J,K,L) +"RTN","BMXSQL6",300,0) + . . . S BMXCFN(J,K)=L +"RTN","BMXSQL6",301,0) + ; +"RTN","BMXSQL6",302,0) + Q +"RTN","BMXSQL6",303,0) + ; +"RTN","BMXSQL6",304,0) +MCWP ; +"RTN","BMXSQL6",305,0) + ;MAKEC Process WP Field +"RTN","BMXSQL6",306,0) + N BMXIENL,BMXWP +"RTN","BMXSQL6",307,0) + S BMXIENL=1 +"RTN","BMXSQL6",308,0) + S:$L(BMXIEN,",")>2 BMXIENL=2 +"RTN","BMXSQL6",309,0) + S BMXWP=0 +"RTN","BMXSQL6",310,0) + ; +"RTN","BMXSQL6",311,0) + F S BMXWP=$O(B(BMXCFN,BMXIEN,BMXFLD,BMXWP)) Q:'+BMXWP D +"RTN","BMXSQL6",312,0) + . S BMXCS="BMXCHAIN("_BMXCID_","_BMXIENL_","_BMXCFN_BMXIEN_","_BMXFLD_","_$C(34)_BMXINT_$C(34)_","_BMXWP_")" +"RTN","BMXSQL6",313,0) + . S @BMXCS=B(BMXCFN,BMXIEN,BMXFLD,BMXWP)_U_(BMXFLDOX(BMXCFN,BMXFLD,BMXINT)+1)_U_"W"_U_BMXWP +"RTN","BMXSQL6",314,0) + Q +"RTN","BMXSQL6",315,0) + ; +"RTN","BMXSQL6",316,0) + ; +"RTN","BMXSQL6",317,0) +MAKEB ; +"RTN","BMXSQL6",318,0) + N BMXFILE,BMXIEN,BMXFLD,BMXINT +"RTN","BMXSQL6",319,0) + N BMXSUB,BMXIENR +"RTN","BMXSQL6",320,0) + S BMXFILE=0 F S BMXFILE=$O(A(BMXFILE)) Q:'+BMXFILE D +"RTN","BMXSQL6",321,0) + . S BMXIEN=0 F S BMXIEN=$O(A(BMXFILE,BMXIEN)) Q:'+BMXIEN D +"RTN","BMXSQL6",322,0) + . . S BMXFLD=0 F S BMXFLD=$O(A(BMXFILE,BMXIEN,BMXFLD)) Q:'+BMXFLD D +"RTN","BMXSQL6",323,0) + . . . S BMXINT=0 F S BMXINT=$O(A(BMXFILE,BMXIEN,BMXFLD,BMXINT)) Q:BMXINT="" D +"RTN","BMXSQL6",324,0) + . . . . S BMXIENR=$$REVERSE(BMXIEN) +"RTN","BMXSQL6",325,0) + . . . . S BMXSUB="B("_BMXFILE_","_$C(34)_BMXIENR_$C(34)_","_BMXFLD_","_$C(34)_BMXINT_$C(34)_")" +"RTN","BMXSQL6",326,0) + . . . . I $D(BMXFLDOX(BMXFILE,BMXFLD,BMXINT)),$P(BMXFLDO(BMXFLDOX(BMXFILE,BMXFLD,BMXINT)),U,5)="D" D Q +"RTN","BMXSQL6",327,0) + . . . . . S @BMXSUB=$TR(A(BMXFILE,BMXIEN,BMXFLD,BMXINT),"@"," ") +"RTN","BMXSQL6",328,0) + . . . . S @BMXSUB=A(BMXFILE,BMXIEN,BMXFLD,BMXINT) +"RTN","BMXSQL6",329,0) + Q +"RTN","BMXSQL6",330,0) + ; +"RTN","BMXSQL6",331,0) +REVERSE(BMXIEN) ; +"RTN","BMXSQL6",332,0) + N J,T,C +"RTN","BMXSQL6",333,0) + S C=1 +"RTN","BMXSQL6",334,0) + F J=$L(BMXIEN,","):-1:1 D +"RTN","BMXSQL6",335,0) + . S $P(T,",",C)=$P(BMXIEN,",",J) +"RTN","BMXSQL6",336,0) + . S C=C+1 +"RTN","BMXSQL6",337,0) + Q T +"RTN","BMXSQL6",338,0) +LAST(VAR) ; Get last entry in an array //SMH new code +"RTN","BMXSQL6",339,0) + N SUB1 S SUB1=$O(@VAR@(""),-1) +"RTN","BMXSQL6",340,0) + N SUB2 S SUB2=$O(@VAR@(SUB1,""),-1) +"RTN","BMXSQL6",341,0) + N SUB3 S SUB3=$O(@VAR@(SUB1,SUB2,""),-1) +"RTN","BMXSQL6",342,0) + I SUB3="" Q $NA(@VAR@(SUB1,SUB2)) +"RTN","BMXSQL6",343,0) + E Q $NA(@VAR@(SUB1,SUB2,SUB3)) +"RTN","BMXSQL7") +0^104^B65321243 +"RTN","BMXSQL7",1,0) +BMXSQL7 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; +"RTN","BMXSQL7",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXSQL7",3,0) + ; +"RTN","BMXSQL7",4,0) + ; +"RTN","BMXSQL7",5,0) +CHKCR(BMXFNUM,BMXFLDNU,BMXRET) ;Returns cross reference to iterate on for related file +"RTN","BMXSQL7",6,0) + N BMXREF,BMXHIT,BMXRNOD,BMXTMP,BMXTMPV,BMXTMPI,BMXTMPP,BMXPFFN,BMXPFF,Q +"RTN","BMXSQL7",7,0) + N BMXHIT,BMXREF,BMXGL,BMXNOD,BMXRNAM,BMXTMPL,BMXTMPN,BMXTST +"RTN","BMXSQL7",8,0) + ; +"RTN","BMXSQL7",9,0) + S BMXNOD=^DD(BMXFNUM,BMXFLDNU,0) +"RTN","BMXSQL7",10,0) + S BMXGL=^DIC(BMXFNUM,0,"GL") ;Subfile global +"RTN","BMXSQL7",11,0) + S BMXREF=0,BMXHIT=0,Q=$C(34),BMXRET="" +"RTN","BMXSQL7",12,0) + F S BMXREF=$O(^DD(BMXFNUM,BMXFLDNU,1,BMXREF)) Q:'+BMXREF D Q:BMXHIT +"RTN","BMXSQL7",13,0) + . Q:'$D(^DD(BMXFNUM,BMXFLDNU,1,BMXREF,0)) +"RTN","BMXSQL7",14,0) + . S BMXRNOD=^DD(BMXFNUM,BMXFLDNU,1,BMXREF,0) +"RTN","BMXSQL7",15,0) + . Q:$P(BMXRNOD,U,3)]"" +"RTN","BMXSQL7",16,0) + . S BMXRNAM=$P(BMXRNOD,U,2) +"RTN","BMXSQL7",17,0) + . S BMXTMP=BMXGL_Q_BMXRNAM_Q_")" +"RTN","BMXSQL7",18,0) + . S BMXTST=$P(BMXTMP,")")_",IEN0," +"RTN","BMXSQL7",19,0) + . Q:'$D(@BMXTMP) +"RTN","BMXSQL7",20,0) + . S BMXTMPV=0,BMXTMPV=$O(@BMXTMP@(BMXTMPV)) +"RTN","BMXSQL7",21,0) + . Q:BMXTMPV="" +"RTN","BMXSQL7",22,0) + . S BMXTMP=BMXGL_Q_BMXRNAM_Q_","_Q_BMXTMPV_Q_")" +"RTN","BMXSQL7",23,0) + . S BMXTMPI=0,BMXTMPI=$O(@BMXTMP@(BMXTMPI)) +"RTN","BMXSQL7",24,0) + . S BMXTMP=$S(BMXGL[",":$P(BMXGL,",")_")",1:$P(BMXGL,"(")) +"RTN","BMXSQL7",25,0) + . Q:'$D(@BMXTMP@(BMXTMPI)) +"RTN","BMXSQL7",26,0) + . S BMXTMPL=$P(BMXNOD,U,4) +"RTN","BMXSQL7",27,0) + . S BMXTMPP=$P(BMXTMPL,";",2) +"RTN","BMXSQL7",28,0) + . S BMXTMPL=$P(BMXTMPL,";") +"RTN","BMXSQL7",29,0) + . Q:BMXTMPL="" +"RTN","BMXSQL7",30,0) + . S BMXTMP=BMXGL_BMXTMPI_")" +"RTN","BMXSQL7",31,0) + . Q:'$D(@BMXTMP@(BMXTMPL)) +"RTN","BMXSQL7",32,0) + . S BMXTMPN=@BMXTMP@(BMXTMPL) +"RTN","BMXSQL7",33,0) + . S BMXTMPP=$P(BMXTMPN,"^",BMXTMPP) +"RTN","BMXSQL7",34,0) + . I BMXTMPP=BMXTMPV S BMXRET=BMXTST,BMXHIT=1 +"RTN","BMXSQL7",35,0) + Q BMXHIT +"RTN","BMXSQL7",36,0) + ; +"RTN","BMXSQL7",37,0) + ; +"RTN","BMXSQL7",38,0) +WHERE ;EP - WHERE-clause processing +"RTN","BMXSQL7",39,0) + ; +"RTN","BMXSQL7",40,0) + ;Set up the defualt iterator in BMXX(1) to scan the entire file. +"RTN","BMXSQL7",41,0) + ;For now, just use first file in the FROM group +"RTN","BMXSQL7",42,0) + ;Later, pick the smallest file if more than one file +"RTN","BMXSQL7",43,0) + ; +"RTN","BMXSQL7",44,0) + ;Set up BMXFF array for each expression element +"RTN","BMXSQL7",45,0) + ; BMXFF(n)=FILENAME^FIELDNAME^OPERATOR^VALUE^FILENUMBER^FIELDNUMBER +"RTN","BMXSQL7",46,0) + ; ^FILE GLOBAL^FIELD DATA LOCATION +"RTN","BMXSQL7",47,0) + ; BMXFF(n,0)=Field descriptor ^DD(FILE,FIELD,0) +"RTN","BMXSQL7",48,0) + ; +"RTN","BMXSQL7",49,0) + N BMXGL,BMXOP,BMXTYP,BMXV,BMXV1,BMXV2,BMXFILE,BMXTMP +"RTN","BMXSQL7",50,0) + N BMXINTNL,BMXTMPLT +"RTN","BMXSQL7",51,0) + N BMXIEN +"RTN","BMXSQL7",52,0) + S BMXGL=^DIC(BMXFO(1),0,"GL") +"RTN","BMXSQL7",53,0) + S BMXX=1 +"RTN","BMXSQL7",54,0) + S BMXX(1)="S D0=0 F S D0=$O("_BMXGL_"D0)) Q:'+D0 Q:BMXM>BMXXMAX " +"RTN","BMXSQL7",55,0) + S BMXTMP=BMXGL +"RTN","BMXSQL7",56,0) + I BMXTMP["," S BMXTMP=$TR(BMXTMP,",",")") +"RTN","BMXSQL7",57,0) + E S BMXTMP=$P(BMXTMP,"(",1) +"RTN","BMXSQL7",58,0) + I $D(@BMXTMP@("B")) D +"RTN","BMXSQL7",59,0) + . S BMXX(1)="S BMXTMP=0 F S BMXTMP=$O("_BMXGL_$C(34)_"B"_$C(34)_",BMXTMP)) Q:BMXTMP="""" S D0=0 F S D0=$O("_BMXGL_$C(34)_"B"_$C(34)_",BMXTMP,D0)) Q:'+D0 Q:BMXM>BMXXMAX " +"RTN","BMXSQL7",60,0) + ; +"RTN","BMXSQL7",61,0) + ;--->BMXFF array: +"RTN","BMXSQL7",62,0) + ; +"RTN","BMXSQL7",63,0) + S T=$G(BMXTK("WHERE")) +"RTN","BMXSQL7",64,0) + S BMXFF=0,C=0 +"RTN","BMXSQL7",65,0) + Q:'+T +"RTN","BMXSQL7",66,0) + F S T=$O(BMXTK(T)) Q:'+T Q:T=$G(BMXTK("ORDER BY")) Q:T=$G(BMXTK("GROUP BY")) D Q:$D(BMXERR) +"RTN","BMXSQL7",67,0) + . ;Get the file of the field +"RTN","BMXSQL7",68,0) + . I "AND^OR^(^)"[BMXTK(T) D Q +"RTN","BMXSQL7",69,0) + . . S C=C+1 +"RTN","BMXSQL7",70,0) + . . S BMXFF(C)=BMXTK(T) +"RTN","BMXSQL7",71,0) + . . S BMXFF=C +"RTN","BMXSQL7",72,0) + . S BMXTK(T)=$TR(BMXTK(T),"_"," ") +"RTN","BMXSQL7",73,0) + . S BMXTK(T)=$TR(BMXTK(T),"'","") +"RTN","BMXSQL7",74,0) + . S BMXINTNL=0 +"RTN","BMXSQL7",75,0) + . S BMXTMPLT=0 +"RTN","BMXSQL7",76,0) + . S BMXIEN=0 +"RTN","BMXSQL7",77,0) + . I BMXTK(T)["INTERNAL[" S BMXINTNL=1,BMXTK(T)=$P(BMXTK(T),"[",2),BMXTK(T)=$P(BMXTK(T),"]",1) +"RTN","BMXSQL7",78,0) + . I BMXTK(T)["TEMPLATE[" S BMXTMPLT=1,BMXTK(T)=$P(BMXTK(T),"[",2),BMXTK(T)=$P(BMXTK(T),"]",1),BMXIEN=1 +"RTN","BMXSQL7",79,0) + . I BMXTK(T)["BMXIEN" S BMXIEN=1 +"RTN","BMXSQL7",80,0) + . S BMXFILE=$$FLDFILE^BMXSQL2(BMXTK(T)) +"RTN","BMXSQL7",81,0) + . Q:$D(BMXERR) +"RTN","BMXSQL7",82,0) + . S C=C+1 +"RTN","BMXSQL7",83,0) + . S BMXFF=C ;This is a count of the where fields +"RTN","BMXSQL7",84,0) + . I BMXFILE]"" D +"RTN","BMXSQL7",85,0) + . . S $P(BMXFF(C),U,1)=$P(BMXFILE,U,1) ;FILENAME +"RTN","BMXSQL7",86,0) + . . S $P(BMXFF(C),U,2)=$P(BMXFILE,U,2) ;FIELDNAME +"RTN","BMXSQL7",87,0) + . . S $P(BMXFF(C),U,5)=$P(BMXFILE,U,3) ;FILENUMBER +"RTN","BMXSQL7",88,0) + . . S $P(BMXFF(C),U,6)=$P(BMXFILE,U,4) ;FIELDNUMBER +"RTN","BMXSQL7",89,0) + . . I $P(BMXFILE,U,3),$D(^DIC($P(BMXFILE,U,3),0,"GL")) S $P(BMXFF(C),U,7)=^DIC($P(BMXFILE,U,3),0,"GL") +"RTN","BMXSQL7",90,0) + . . I BMXIEN S BMXFF(C,0)="IEN",BMXFF(C,"IEN")=1,BMXFF(C,"TYPE")="IEN" +"RTN","BMXSQL7",91,0) + . . E S BMXFF(C,0)=$S(+$P(BMXFILE,U,3):^DD($P(BMXFILE,U,3),$P(BMXFILE,U,4),0),1:"") +"RTN","BMXSQL7",92,0) + . . I BMXINTNL S BMXFF(C,"INTERNAL")=1 +"RTN","BMXSQL7",93,0) + . ; +"RTN","BMXSQL7",94,0) + . ;If BMXFF(C) is a pointer, traverse pointer chain to retrieve type +"RTN","BMXSQL7",95,0) + . I $P(BMXFF(C,0),U,2)["P" D +"RTN","BMXSQL7",96,0) + . . ;B ;WHERE Pointer Type +"RTN","BMXSQL7",97,0) + . . N BMXFILN,BMXFLDN,BMXDD +"RTN","BMXSQL7",98,0) + . . S BMXDD=BMXFF(C,0) +"RTN","BMXSQL7",99,0) + . . F Q:$P(BMXDD,U,2)'["P" D:$P(BMXDD,U,2)["P" +"RTN","BMXSQL7",100,0) + . . . S BMXFILN=$P(BMXDD,U,2) +"RTN","BMXSQL7",101,0) + . . . S BMXFILN=+$P(BMXFILN,"P",2) +"RTN","BMXSQL7",102,0) + . . . S BMXDD=^DD(BMXFILN,".01",0) +"RTN","BMXSQL7",103,0) + . . S BMXFF(C,"TYPE")=$S($P(BMXDD,U,2)["D":"DATE",$P(BMXDD,U,2)["S":"SET",1:"OTHER") +"RTN","BMXSQL7",104,0) + . . I BMXFF(C,"TYPE")="SET" S $P(BMXFF(C,"TYPE"),U,2)=$P(BMXDD,U,3) +"RTN","BMXSQL7",105,0) + . ;B ;WHERE Set Type +"RTN","BMXSQL7",106,0) + . I ($P(BMXFF(C,0),U,2)["S")!($P($G(BMXFF(C,"TYPE")),U)="SET") D ;Set +"RTN","BMXSQL7",107,0) + . . N BMXSET,BMXSETP +"RTN","BMXSQL7",108,0) + . . I $P(BMXFF(C,0),U,2)["S" D +"RTN","BMXSQL7",109,0) + . . . S BMXFF(C,"TYPE")="SET" +"RTN","BMXSQL7",110,0) + . . . S $P(BMXFF(C,"TYPE"),U,2)=$P(BMXFF(C,0),U,3) +"RTN","BMXSQL7",111,0) + . . S BMXSET=$P(BMXFF(C,"TYPE"),U,2) +"RTN","BMXSQL7",112,0) + . . F J=1:1:$L(BMXSET,";") D +"RTN","BMXSQL7",113,0) + . . . S BMXSETP=$P(BMXSET,";",J) +"RTN","BMXSQL7",114,0) + . . . Q:BMXSETP="" +"RTN","BMXSQL7",115,0) + . . . S BMXFF(C,"SET",$P(BMXSETP,":",2))=$P(BMXSETP,":") +"RTN","BMXSQL7",116,0) + . ; +"RTN","BMXSQL7",117,0) + . ;Set up comparisons based on operators +"RTN","BMXSQL7",118,0) + . S T=T+1 +"RTN","BMXSQL7",119,0) + . S BMXOP=BMXTK(T) +"RTN","BMXSQL7",120,0) + . I BMXTMPLT S BMXOP="=" +"RTN","BMXSQL7",121,0) + . I "^<^>^=^[^<>^>=^<=^LIKE"[BMXOP D Q +"RTN","BMXSQL7",122,0) + . . S $P(BMXFF(C),U,3)=BMXTK(T) +"RTN","BMXSQL7",123,0) + . . ;Get the comparison value +"RTN","BMXSQL7",124,0) + . . S T=T+1 +"RTN","BMXSQL7",125,0) + . . S BMXTMP=BMXTK(T) +"RTN","BMXSQL7",126,0) + . . S BMXTMP=$TR(BMXTMP,"'","") +"RTN","BMXSQL7",127,0) + . . I BMXOP="LIKE" S BMXTMP=$P(BMXTMP,"%"),$P(BMXFF(C),U,4)=BMXTMP Q +"RTN","BMXSQL7",128,0) + . . I BMXTMPLT D TMPLATE Q +"RTN","BMXSQL7",129,0) + . . I BMXTMP="*" S T=T+1,BMXTMP=BMXTK(T) D OTM Q +"RTN","BMXSQL7",130,0) + . . I BMXTMP[".",BMXTK(T)'["'" D ;This is a join ;TODO: Extended pointers +"RTN","BMXSQL7",131,0) + . . . ;Setting BMXFJ("JOIN" +"RTN","BMXSQL7",132,0) + . . . S BMXTMP=BMXTK(T) +"RTN","BMXSQL7",133,0) + . . . I $D(BMXF($P(BMXTMP,"."))),BMXF($P(BMXTMP,"."))=BMXFO(1) D Q +"RTN","BMXSQL7",134,0) + . . . . S BMXTMP=BMXTK(T-2) +"RTN","BMXSQL7",135,0) + . . . . D OTM +"RTN","BMXSQL7",136,0) + . . . N BMXJN +"RTN","BMXSQL7",137,0) + . . . S BMXFF(C,"JOIN")="Pointer chain" +"RTN","BMXSQL7",138,0) + . . . S BMXJN=+$P($P(BMXFF(C,0),U,2),"P",2) +"RTN","BMXSQL7",139,0) + . . . S BMXFJ("JOIN",+$P($P(BMXFF(C,0),U,2),"P",2))=C +"RTN","BMXSQL7",140,0) + . . . S:+$P($P(BMXFF(C,0),U,2),"P",2)=2 BMXFJ("JOIN",9000001)=C ;IHS Only -- auto join PATIENT to VA PATIENT +"RTN","BMXSQL7",141,0) + . . I ($P(BMXFF(C,0),U,2)["D")!($G(BMXFF(C,"TYPE"))="DATE") D ;Date +"RTN","BMXSQL7",142,0) + . . . Q:$D(BMXFF(C,"INTERNAL")) +"RTN","BMXSQL7",143,0) + . . . I BMXTMP]"" S X=BMXTMP,%DT="T" D ^%DT S BMXTMP=Y +"RTN","BMXSQL7",144,0) + . . I $P($G(BMXFF(C,"TYPE")),U)="SET" D +"RTN","BMXSQL7",145,0) + . . . Q:$D(BMXFF(C,"INTERNAL")) +"RTN","BMXSQL7",146,0) + . . . Q:BMXTMP="" +"RTN","BMXSQL7",147,0) + . . . I $G(BMXFF(C,"SET",BMXTMP))="" S BMXTMP="ZZZZZZ" Q +"RTN","BMXSQL7",148,0) + . . . S BMXTMP=$G(BMXFF(C,"SET",BMXTMP)) +"RTN","BMXSQL7",149,0) + . . S $P(BMXFF(C),U,4)=BMXTMP +"RTN","BMXSQL7",150,0) + . . Q +"RTN","BMXSQL7",151,0) + . I BMXOP="BETWEEN" D +"RTN","BMXSQL7",152,0) + . . S $P(BMXFF(C),U,3)="BETWEEN" +"RTN","BMXSQL7",153,0) + . . ;Get the comparison value +"RTN","BMXSQL7",154,0) + . . S T=T+1 +"RTN","BMXSQL7",155,0) + . . S BMXV1=BMXTK(T) +"RTN","BMXSQL7",156,0) + . . S:BMXV1["'" BMXV1=$P(BMXV1,"'",2) +"RTN","BMXSQL7",157,0) + . . S T=T+1 +"RTN","BMXSQL7",158,0) + . . I BMXTK(T)'="AND" S BMXERR="'BETWEEN' VALUES NOT SPECIFIED" D ERROR Q +"RTN","BMXSQL7",159,0) + . . S T=T+1 +"RTN","BMXSQL7",160,0) + . . S BMXV2=BMXTK(T) +"RTN","BMXSQL7",161,0) + . . S:BMXV2["'" BMXV2=$P(BMXV2,"'",2) +"RTN","BMXSQL7",162,0) + . . I ($P(BMXFF(C,0),U,2)["D")!($G(BMXFF(C,"TYPE"))="DATE") D ;Date +"RTN","BMXSQL7",163,0) + . . . Q:$D(BMXFF(C,"INTERNAL")) +"RTN","BMXSQL7",164,0) + . . . S X=BMXV1,%DT="T" D ^%DT S BMXV1=Y +"RTN","BMXSQL7",165,0) + . . . S X=BMXV2,%DT="T" D ^%DT S BMXV2=Y +"RTN","BMXSQL7",166,0) + . . I BMXV1>BMXV2 S BMXTMP=BMXV1,BMXV1=BMXV2,BMXV2=BMXTMP +"RTN","BMXSQL7",167,0) + . . S $P(BMXFF(C),U,4)=BMXV1_"~"_BMXV2 +"RTN","BMXSQL7",168,0) + . . Q +"RTN","BMXSQL7",169,0) + . I $P(BMXFF(C),U,3)="" S BMXERR="INVALID OPERATOR" D ERROR Q +"RTN","BMXSQL7",170,0) + . I $D(BMXTK(T+1)),BMXTK(T+1)["[INDEX:" D +"RTN","BMXSQL7",171,0) + . . S T=T+1 +"RTN","BMXSQL7",172,0) + . . N BMXIND +"RTN","BMXSQL7",173,0) + . . S BMXIND=$P(BMXTK(T),"INDEX:",2) +"RTN","BMXSQL7",174,0) + . . S:BMXIND["]" BMXIND=$P(BMXIND,"]") +"RTN","BMXSQL7",175,0) + . . S:BMXIND["'" BMXIND=$P(BMXIND,"'",2) +"RTN","BMXSQL7",176,0) + . . S BMXFF("INDEX")=BMXIND +"RTN","BMXSQL7",177,0) + . Q +"RTN","BMXSQL7",178,0) + ; +"RTN","BMXSQL7",179,0) + Q:$D(BMXERR) +"RTN","BMXSQL7",180,0) + D JOIN^BMXSQL4 +"RTN","BMXSQL7",181,0) + Q +"RTN","BMXSQL7",182,0) + ; +"RTN","BMXSQL7",183,0) +TMPLATE ; +"RTN","BMXSQL7",184,0) + N BMXTNUM,BMXTNOD +"RTN","BMXSQL7",185,0) + I BMXTMP["[" S BMXTMP=$P(BMXTMP,"[",2),BMXTMP=$P(BMXTMP,"]") +"RTN","BMXSQL7",186,0) + S BMXTMP=$TR(BMXTMP,"_"," ") +"RTN","BMXSQL7",187,0) + ;Test template validity +"RTN","BMXSQL7",188,0) + I '$D(^DIBT("B",BMXTMP)) S BMXERR="TEMPLATE NOT FOUND" D ERROR Q +"RTN","BMXSQL7",189,0) + S BMXTNUM=$O(^DIBT("B",BMXTMP,0)) +"RTN","BMXSQL7",190,0) + I '$D(^DIBT(BMXTNUM,0)) S BMXERR="TEMPLATE NOT FOUND" D ERROR Q +"RTN","BMXSQL7",191,0) + S BMXTNOD=^DIBT(BMXTNUM,0) +"RTN","BMXSQL7",192,0) + I $P(BMXTNOD,U,4)'=$P(BMXFF(C),U,5) S BMXERR="TEMPLATE DOES NOT MATCH FILE" D ERROR Q +"RTN","BMXSQL7",193,0) + I '$D(^DIBT(BMXTNUM,1)) S BMXERR="TEMPLATE HAS NO ENTRIES" D ERROR Q +"RTN","BMXSQL7",194,0) + S BMXFF(C,0)="IEN",BMXFF(C,"IEN")="TEMPLATE",BMXFF(C,"TYPE")="IEN" +"RTN","BMXSQL7",195,0) + S $P(BMXFF(C),U,4)=BMXTMP +"RTN","BMXSQL7",196,0) + ; +"RTN","BMXSQL7",197,0) + Q +"RTN","BMXSQL7",198,0) + ; +"RTN","BMXSQL7",199,0) +OTM ;One-To-Many +"RTN","BMXSQL7",200,0) + N BMXUPFN,BMXSUBFN,BMXA,BMXB,BMXSUBFLD,BMXFNAM +"RTN","BMXSQL7",201,0) + I BMXTMP["INTERNAL[" S BMXTMP=$P(BMXTMP,"INTERNAL[",2),BMXTMP=$P(BMXTMP,"]") +"RTN","BMXSQL7",202,0) + S BMXUPFN=BMXFO(1) +"RTN","BMXSQL7",203,0) + S BMXA=$TR($P(BMXTMP,"."),"_"," ") +"RTN","BMXSQL7",204,0) + S BMXB=$TR($P(BMXTMP,".",2),"_"," ") +"RTN","BMXSQL7",205,0) + S BMXFNAM=BMXB ;Required by SETMFL. Won't work if filename BMXB [ "." +"RTN","BMXSQL7",206,0) + ;Get the subfile +"RTN","BMXSQL7",207,0) + I '$D(BMXF(BMXA)) S BMXERR="Related File Not Found" Q +"RTN","BMXSQL7",208,0) + S BMXSUBFN=BMXF(BMXA) +"RTN","BMXSQL7",209,0) + I '$D(^DD(BMXSUBFN,0)) S BMXERR="Related file not found" Q +"RTN","BMXSQL7",210,0) + ;Get the field that points to the main file +"RTN","BMXSQL7",211,0) + I '$D(^DD(BMXSUBFN,"B",BMXB)) S BMXERR="Related field not found" Q +"RTN","BMXSQL7",212,0) + S BMXSUBFLD=$O(^DD(BMXSUBFN,"B",BMXB,0)) +"RTN","BMXSQL7",213,0) + I '+BMXSUBFLD S BMXERR="Related field not found" Q +"RTN","BMXSQL7",214,0) + ; +"RTN","BMXSQL7",215,0) + ;Find a normal index on that field +"RTN","BMXSQL7",216,0) + ;Set up for call to CHKCR^BMXSQL7 +"RTN","BMXSQL7",217,0) + N BMXEXEC +"RTN","BMXSQL7",218,0) + I '$$CHKCR^BMXSQL7(BMXSUBFN,BMXSUBFLD,.BMXEXEC) S BMXERR="Related File not indexed" Q +"RTN","BMXSQL7",219,0) + ; +"RTN","BMXSQL7",220,0) + ; +"RTN","BMXSQL7",221,0) + S BMXFF(C,"JOIN")="One-to-many Join" +"RTN","BMXSQL7",222,0) + ; +"RTN","BMXSQL7",223,0) + ;Call SETMFL^BMXSQL5 to set up the iteration code +"RTN","BMXSQL7",224,0) + D SETMFL^BMXSQL5(BMXUPFN,BMXSUBFN,BMXEXEC,1,1) +"RTN","BMXSQL7",225,0) + ; +"RTN","BMXSQL7",226,0) + ; +"RTN","BMXSQL7",227,0) + ;Upfile is the mainfile, Subfile is the related file +"RTN","BMXSQL7",228,0) + ;BMXOFF is 1 but What is BMXGL? +"RTN","BMXSQL7",229,0) + ; +"RTN","BMXSQL7",230,0) + Q +"RTN","BMXSQL7",231,0) + ; +"RTN","BMXSQL7",232,0) +ERROR Q +"RTN","BMXSQL91") +0^105^B25109398 +"RTN","BMXSQL91",1,0) +BMXSQL91 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; +"RTN","BMXSQL91",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXSQL91",3,0) + ; +"RTN","BMXSQL91",4,0) + ;Below is dead code, but keep for later +"RTN","BMXSQL91",5,0) +SETX2 ;Don't need this unless porting to machine with +"RTN","BMXSQL91",6,0) + ;local variable size limitations +"RTN","BMXSQL91",7,0) + N F,LVL,ROOT,START +"RTN","BMXSQL91",8,0) + S LVL=1,START=1 +"RTN","BMXSQL91",9,0) + S ROOT="BMXY" +"RTN","BMXSQL91",10,0) + F F=1:1:BMXFF D Q:$D(BMXERR) +"RTN","BMXSQL91",11,0) + . S BMX=BMXFF(F) +"RTN","BMXSQL91",12,0) + . I BMX="(" D Q ;Increment level +"RTN","BMXSQL91",13,0) + . . S LVL=LVL+1 +"RTN","BMXSQL91",14,0) + . . ;S ROOT=$S(ROOT["(":$P(ROOT,")")_","_0_")",1:ROOT_"("_0_")") +"RTN","BMXSQL91",15,0) + . . ;Get operator following close paren corresponding to this open +"RTN","BMXSQL91",16,0) + . . ;If op = OR then set up FOR loop in zeroeth node +"RTN","BMXSQL91",17,0) + . . ;if op = AND then set up +"RTN","BMXSQL91",18,0) + . I BMX=")" D Q ;Decrement level +"RTN","BMXSQL91",19,0) + . . S LVL=LVL-1 +"RTN","BMXSQL91",20,0) + . . I LVL=1,$D(BMXFF(F+1)),BMXFF(F+1)="&" D Q +"RTN","BMXSQL91",21,0) + . . . S BMXX=BMXX+1 +"RTN","BMXSQL91",22,0) + . . . S BMXX(BMXX)="" +"RTN","BMXSQL91",23,0) + . . . F J=START:1:F S BMXX(BMXX)=BMXX(BMXX)_BMXFF(J) +"RTN","BMXSQL91",24,0) + . . . S START=F+2 +"RTN","BMXSQL91",25,0) + . . . ;S BMXX(BMXX)="I "_BMXX(BMXX)_" X BMXX("_BMXX+1_")" +"RTN","BMXSQL91",26,0) + . I BMX="AND" D Q ;Chain to previous expression at current level +"RTN","BMXSQL91",27,0) + . I BMX="OR" D Q ;Create FOR-loop to execute screens +"RTN","BMXSQL91",28,0) + ; +"RTN","BMXSQL91",29,0) + Q +"RTN","BMXSQL91",30,0) + ; +"RTN","BMXSQL91",31,0) + ; +"RTN","BMXSQL91",32,0) + ;S F=0 F S F=$O(BMXMFL(F)) Q:'+F S:'$D(BMXMFL(F,"SUBFILE")) BMXMFL("NOSUBFILE",F)="" +"RTN","BMXSQL91",33,0) + ;I $D(BMXMFL("NOSUBFILE")) S F=0 F S F=$O(BMXMFL("NOSUBFILE",F)) Q:'+F D MAKEC1 +"RTN","BMXSQL91",34,0) + ;I $D(BMXMFL("SUBFILE")) S F=0 F S F=$O(BMXMFL("SUBFILE",F)) Q:'+F D MAKEC1 ;S BMXROOTZ=BMXZ+100 +"RTN","BMXSQL91",35,0) + ; +"RTN","BMXSQL91",36,0) + Q +"RTN","BMXSQL91",37,0) +MAKEC1 ; +"RTN","BMXSQL91",38,0) + I '$D(BMXMFL(F,"SUBFILE")),'$D(BMXMFL(F,"MULT")) S BMXZ=BMXZ+100,BMXCFN(BMXCID,BMXZ,F)="" Q +"RTN","BMXSQL91",39,0) + Q:'$D(BMXMFL(F,"SUBFILE")) +"RTN","BMXSQL91",40,0) + Q:$D(BMXMFL(F,"MULT")) +"RTN","BMXSQL91",41,0) + S BMXROOT=F +"RTN","BMXSQL91",42,0) + S BMXROOTZ=BMXZ+100 +"RTN","BMXSQL91",43,0) + S BMXROOTC=BMXCID +"RTN","BMXSQL91",44,0) + D MCNT(F) +"RTN","BMXSQL91",45,0) + Q +"RTN","BMXSQL91",46,0) + ; +"RTN","BMXSQL91",47,0) +MCNT(F) ; +"RTN","BMXSQL91",48,0) + N S +"RTN","BMXSQL91",49,0) + ;B ;MCNT +"RTN","BMXSQL91",50,0) + I '$D(BMXMFL(F,"SUBFILE")) D MCNT2 Q +"RTN","BMXSQL91",51,0) + S S=0 F S S=$O(BMXMFL(F,"SUBFILE",S)) Q:'+S S:'$D(BMXCFN(BMXCID,BMXZ,F)) BMXZ=BMXZ+100,BMXCFN(BMXCID,BMXZ,F)="" S BMXZ=BMXZ+100,BMXCFN(BMXCID,BMXZ,S)="",BMXCFNX(S,F)="" D MCNT(S) +"RTN","BMXSQL91",52,0) + Q +"RTN","BMXSQL91",53,0) + ; +"RTN","BMXSQL91",54,0) +MCNT2 ; +"RTN","BMXSQL91",55,0) + ;B ;Back-chain +"RTN","BMXSQL91",56,0) + ;TODO: RESTART HERE -- $O(BMXCFN(BMXCID,0)) NEEDS TO BE CHANGED TO SOMETHING BESIDES 0 +"RTN","BMXSQL91",57,0) + N BMXFTOP,BMXFBACK +"RTN","BMXSQL91",58,0) + F S BMXFTOP=$O(BMXCFN(BMXROOTC,BMXROOTZ,0)) Q:BMXFTOP=BMXROOT S BMXFBACK=$O(BMXCFNX(BMXFTOP,0)) S BMXROOTZ=BMXROOTZ-1,BMXCFN(BMXCID,BMXROOTZ,BMXFBACK)="" +"RTN","BMXSQL91",59,0) + S BMXCID=BMXCID+1,BMXROOTC=BMXCID +"RTN","BMXSQL91",60,0) + ;Get the root files +"RTN","BMXSQL91",61,0) + I $D(BMXMFL("NOSUBFILE")) D +"RTN","BMXSQL91",62,0) + . N F +"RTN","BMXSQL91",63,0) + . S F=0 F S F=$O(BMXMFL("NOSUBFILE",F)) Q:'+F D +"RTN","BMXSQL91",64,0) + . . Q:$D(BMXMFL(F,"MULT")) +"RTN","BMXSQL91",65,0) + . . Q:F=BMXROOT +"RTN","BMXSQL91",66,0) + . . S BMXZ=BMXZ+100 +"RTN","BMXSQL91",67,0) + . . S BMXCFN(BMXCID,BMXZ,F)="" +"RTN","BMXSQL91",68,0) + S BMXROOTZ=BMXZ+100 +"RTN","BMXSQL91",69,0) + Q +"RTN","BMXSQL91",70,0) + ; +"RTN","BMXSQL91",71,0) + ; +"RTN","BMXSQL91",72,0) +ITER ;Iterate through result array A +"RTN","BMXSQL91",73,0) + S BMXCNT=BMXFLDO ;Field count +"RTN","BMXSQL91",74,0) + S F=0 +"RTN","BMXSQL91",75,0) + S:BMXNUM ^BMXTEMP($J,I)=IEN0_"^" +"RTN","BMXSQL91",76,0) + S BMXCNTB=0 +"RTN","BMXSQL91",77,0) + S BMXORD=BMXNUM +"RTN","BMXSQL91",78,0) + N BMXONOD +"RTN","BMXSQL91",79,0) + N BMXINT +"RTN","BMXSQL91",80,0) + ;B ;WRITE Before REORG +"RTN","BMXSQL91",81,0) + N M,N S N=0 +"RTN","BMXSQL91",82,0) + D REORG +"RTN","BMXSQL91",83,0) + ;B ;WRITE After REORG +"RTN","BMXSQL91",84,0) + F S N=$O(M(N)) Q:'+N D +"RTN","BMXSQL91",85,0) + . S O=0 +"RTN","BMXSQL91",86,0) + . F O=1:1:$L(M(N),U) S BMXFLDO(O-1,"IEN0")=$P(M(N),U,O) +"RTN","BMXSQL91",87,0) + . S BMXORD=BMXNUM +"RTN","BMXSQL91",88,0) + . D OA +"RTN","BMXSQL91",89,0) + Q +"RTN","BMXSQL91",90,0) + ; +"RTN","BMXSQL91",91,0) +REORG N R,IEN,J,CONT,TEST +"RTN","BMXSQL91",92,0) + F R=0:1:BMXFLDO-1 S IEN(R)=0 +"RTN","BMXSQL91",93,0) + F J=1:1 D Q:'CONT +"RTN","BMXSQL91",94,0) + . S CONT=0 +"RTN","BMXSQL91",95,0) + . F R=1:1:BMXFLDO D +"RTN","BMXSQL91",96,0) + . . S TEST=$O(A(+BMXFLDO(R-1),IEN(R-1))) +"RTN","BMXSQL91",97,0) + . . I +TEST S IEN(R-1)=TEST,CONT=1 +"RTN","BMXSQL91",98,0) + . . S $P(M(J),U,R)=IEN(R-1) +"RTN","BMXSQL91",99,0) + . Q +"RTN","BMXSQL91",100,0) + I M(J)=M(J-1) K M(J) +"RTN","BMXSQL91",101,0) + Q +"RTN","BMXSQL91",102,0) + ; +"RTN","BMXSQL91",103,0) + ; +"RTN","BMXSQL91",104,0) +OA ; +"RTN","BMXSQL91",105,0) + I $D(A) F R=0:1:(BMXFLDO-1) S F=$P(BMXFLDO(R),U,2),BMXFN=$P(BMXFLDO(R),U),BMXINT=$P(BMXFLDO(R),U,3) D S:(R+1)BMXLEN(BMXORD) BMXLEN(BMXORD)=BMXLTMP +"RTN","BMXSQL91",121,0) + . . . Q +"RTN","BMXSQL91",122,0) + . . D ;It's a multiple. Implement in next phase +"RTN","BMXSQL91",123,0) + . . . ;S BMXMCT=BMXMCT+1 +"RTN","BMXSQL91",124,0) + . . . ;S BMXMCT(BMXMCT)=BMXFN_U_F +"RTN","BMXSQL91",125,0) + . . . Q ;Process A( for multiple field +"RTN","BMXSQL91",126,0) + . . Q +"RTN","BMXSQL91",127,0) + . E D ;Not a multiple +"RTN","BMXSQL91",128,0) + . . S I=I+1 +"RTN","BMXSQL91",129,0) + . . I $G(BMXTK("DISTINCT"))="TRUE" D Q +"RTN","BMXSQL91",130,0) + . . . Q:A(BMXFN,IEN0,F,BMXINT)="" +"RTN","BMXSQL91",131,0) + . . . I $D(^BMXTMPD($J,A(BMXFN,IEN0,F,BMXINT))) Q +"RTN","BMXSQL91",132,0) + . . . S ^BMXTMPD($J,A(BMXFN,IEN0,F,BMXINT))="" +"RTN","BMXSQL91",133,0) + . . . S ^BMXTEMP($J,I)=A(BMXFN,IEN0,F,BMXINT) +"RTN","BMXSQL91",134,0) + . . . S:$L(A(BMXFN,IEN0,F,BMXINT))>BMXLEN(BMXORD) BMXLEN(BMXORD)=$L(A(BMXFN,IEN0,F,BMXINT)) +"RTN","BMXSQL91",135,0) + . . . Q +"RTN","BMXSQL91",136,0) + . . S ^BMXTEMP($J,I)=A(BMXFN,IEN0,F,BMXINT) +"RTN","BMXSQL91",137,0) + . . S:$L(A(BMXFN,IEN0,F,BMXINT))>BMXLEN(BMXORD) BMXLEN(BMXORD)=$L(A(BMXFN,IEN0,F,BMXINT)) +"RTN","BMXSQL91",138,0) + . Q +"RTN","BMXSQL91",139,0) + ;---> Set data in result global. +"RTN","BMXSQL91",140,0) + I $D(^BMXTEMP($J,I)) S ^BMXTEMP($J,I)=^BMXTEMP($J,I)_$C(30) +"RTN","BMXSQL91",141,0) +ZZZ Q +"RTN","BMXTABLE") +0^106^B130270 +"RTN","BMXTABLE",1,0) +BMXTABLE ; IHS/OIT/HMW - BMX RETURN ENTIRE TABLE ; +"RTN","BMXTABLE",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXTABLE",3,0) + ; +"RTN","BMXTABLE",4,0) +TABLE(BMXGBL,BMXFL,BMXMX) ;EP +"RTN","BMXTABLE",5,0) + ; +"RTN","BMXTABLE",6,0) + D FIND^BMXFIND(.BMXGBL,BMXFL,"*",,,BMXMX,,,,1) +"RTN","BMXTABLE",7,0) + Q +"RTN","BMXTRS") +0^107^B1202427 +"RTN","BMXTRS",1,0) +BMXTRS ; IHS/OIT/HMW - UPPERCASE-LOWERCASE ; +"RTN","BMXTRS",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXTRS",3,0) + ; +"RTN","BMXTRS",4,0) +T(X) ;EP +"RTN","BMXTRS",5,0) + ;---> Translate word to mixed case. +"RTN","BMXTRS",6,0) + ; +"RTN","BMXTRS",7,0) + N BMXWORD,I +"RTN","BMXTRS",8,0) + I '$D(X) Q "" +"RTN","BMXTRS",9,0) + I X="^" Q X +"RTN","BMXTRS",10,0) + I X=" " Q X +"RTN","BMXTRS",11,0) + ;-----> REMOVE LEADING INAPPROPRIATE CHARACTERS IF PRESENT. +"RTN","BMXTRS",12,0) + F Q:$E(X)'?1P S X=$E(X,2,99) +"RTN","BMXTRS",13,0) + ;-----> CHANGE FIRST LETTER TO UPPERCASE: +"RTN","BMXTRS",14,0) + S BMXWORD=$E(X) +"RTN","BMXTRS",15,0) + I $E(BMXWORD)?1L S BMXWORD=$C($A($E(BMXWORD))-32) +"RTN","BMXTRS",16,0) + ;-----> DO NEXT CHARACTER +"RTN","BMXTRS",17,0) + F I=2:1:$L(X) D CHAR +"RTN","BMXTRS",18,0) + ;-----> REMOVE TRAILING SPACE OR QUOTE. +"RTN","BMXTRS",19,0) + F Q:""" "'[$E(BMXWORD,$L(BMXWORD)) D +"RTN","BMXTRS",20,0) + .S BMXWORD=$E(BMXWORD,1,($L(BMXWORD)-1)) +"RTN","BMXTRS",21,0) + ;-----> RESET X EQUAL TO RESULT +"RTN","BMXTRS",22,0) +EOJ ; +"RTN","BMXTRS",23,0) + Q BMXWORD +"RTN","BMXTRS",24,0) + ; +"RTN","BMXTRS",25,0) +CHAR ; +"RTN","BMXTRS",26,0) + ;-----> IF THE CHARACTER IS UPPERCASE AND PREVIOUS CHARACTER IS NOT +"RTN","BMXTRS",27,0) + ;-----> PUNCTUATION (EXCEPT FOR AN APOSTROPHY) OR A SPACE, +"RTN","BMXTRS",28,0) + ;-----> THEN CHANGE CHARACTER TO LOWERCASE: +"RTN","BMXTRS",29,0) + I ($E(X,I)?1U)&(($E(X,I-1)'?1P)!($E(X,I-1)="'")) D Q +"RTN","BMXTRS",30,0) + .S BMXWORD=BMXWORD_$C($A($E(X,I))+32) +"RTN","BMXTRS",31,0) + ; +"RTN","BMXTRS",32,0) + ;-----> IF THE CHARACTER IS LOWERCASE AND PREVIOUS CHARACTER IS +"RTN","BMXTRS",33,0) + ;-----> PUNCTUATION (BUT NOT AN APOSTROPHY) OR A SPACE, THEN CHANGE +"RTN","BMXTRS",34,0) + ;-----> CHARACTER TO UPPERCASE: +"RTN","BMXTRS",35,0) + I $E(X,I)?1L,$E(X,I-1)?1P,$E(X,I-1)'="'" D Q +"RTN","BMXTRS",36,0) + .S BMXWORD=BMXWORD_$C($A($E(X,I))-32) +"RTN","BMXTRS",37,0) + ; +"RTN","BMXTRS",38,0) + ;-----> ADD CHARACTER TO BMXWORD STRING WITHOUT MODIFICATION. +"RTN","BMXTRS",39,0) + ;-----> "\" PLACED BEFORE A LETTER FORCES IT TO BE UPPERCASE; +"RTN","BMXTRS",40,0) + ;-----> HERE REMOVE ANY "\"'s. +"RTN","BMXTRS",41,0) + I $E(X,I)'="\" S BMXWORD=BMXWORD_$E(X,I) +"RTN","BMXTRS",42,0) + Q +"RTN","BMXUTL1") +0^108^B39816098 +"RTN","BMXUTL1",1,0) +BMXUTL1 ; IHS/OIT/HMW - UTIL: PATIENT DEMOGRAPHICS ; +"RTN","BMXUTL1",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXUTL1",3,0) + ;;Stolen from:* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER * +"RTN","BMXUTL1",4,0) + ;; UTILITY: PATIENT DEMOGRAPHICS. +"RTN","BMXUTL1",5,0) + ; +"RTN","BMXUTL1",6,0) + ; +"RTN","BMXUTL1",7,0) + ;---------- +"RTN","BMXUTL1",8,0) +NAME(DFN,ORDER) ;EP +"RTN","BMXUTL1",9,0) + ;---> Return text of Patient Name. +"RTN","BMXUTL1",10,0) + ;---> Parameters: +"RTN","BMXUTL1",11,0) + ; 1 - DFN (req) Patient's IEN (DFN). +"RTN","BMXUTL1",12,0) + ; 2 - ORDER (opt) ""/0=Last,First 2=First Only +"RTN","BMXUTL1",13,0) + ; 1=First Last 3=Last Only +"RTN","BMXUTL1",14,0) + ; +"RTN","BMXUTL1",15,0) + Q:'$G(DFN) "NO PATIENT" +"RTN","BMXUTL1",16,0) + Q:'$D(^DPT(DFN,0)) "Unknown" +"RTN","BMXUTL1",17,0) + N X S X=$P(^DPT(DFN,0),U) +"RTN","BMXUTL1",18,0) + Q:'$G(ORDER) X +"RTN","BMXUTL1",19,0) + S X=$$FL(X) +"RTN","BMXUTL1",20,0) + Q:ORDER=1 X +"RTN","BMXUTL1",21,0) + Q:ORDER=2 $P(X," ") +"RTN","BMXUTL1",22,0) + Q:ORDER=3 $P(X," ",2) +"RTN","BMXUTL1",23,0) + Q "UNKNOWN ORDER" +"RTN","BMXUTL1",24,0) + ; +"RTN","BMXUTL1",25,0) + ; +"RTN","BMXUTL1",26,0) + ;---------- +"RTN","BMXUTL1",27,0) +FL(X) ;EP +"RTN","BMXUTL1",28,0) + ;---> Switch First and Last Names. +"RTN","BMXUTL1",29,0) + Q $P($P(X,",",2)," ")_" "_$P(X,",") +"RTN","BMXUTL1",30,0) + ; +"RTN","BMXUTL1",31,0) + ; +"RTN","BMXUTL1",32,0) + ;---------- +"RTN","BMXUTL1",33,0) +DOB(DFN) ;EP +"RTN","BMXUTL1",34,0) + ;---> Return Patient's Date of Birth in Fileman format. +"RTN","BMXUTL1",35,0) + ;---> Parameters: +"RTN","BMXUTL1",36,0) + ; 1 - DFN (req) Patient's IEN (DFN). +"RTN","BMXUTL1",37,0) + ; +"RTN","BMXUTL1",38,0) + Q:'$G(DFN) "NO PATIENT" +"RTN","BMXUTL1",39,0) + Q:'$P($G(^DPT(DFN,0)),U,3) "NOT ENTERED" +"RTN","BMXUTL1",40,0) + Q $P(^DPT(DFN,0),U,3) +"RTN","BMXUTL1",41,0) + ; +"RTN","BMXUTL1",42,0) + ; +"RTN","BMXUTL1",43,0) + ;---------- +"RTN","BMXUTL1",44,0) +DOBF(DFN,BMXDT,BMXNOA) ;EP +"RTN","BMXUTL1",45,0) + ;---> Date of Birth formatted "09-Sep-1994 (35 Months)" +"RTN","BMXUTL1",46,0) + ;---> Parameters: +"RTN","BMXUTL1",47,0) + ; 1 - DFN (req) Patient's IEN (DFN). +"RTN","BMXUTL1",48,0) + ; 2 - BMXDT (opt) Date on which Age should be calculated. +"RTN","BMXUTL1",49,0) + ; 3 - BMXNOA (opt) 1=No age (don't append age). +"RTN","BMXUTL1",50,0) + ; +"RTN","BMXUTL1",51,0) + N X,Y +"RTN","BMXUTL1",52,0) + S X=$$DOB($G(DFN)) +"RTN","BMXUTL1",53,0) + Q:'X X +"RTN","BMXUTL1",54,0) + S X=$$TXDT1^BMXUTL5(X) +"RTN","BMXUTL1",55,0) + Q:$G(BMXNOA) X +"RTN","BMXUTL1",56,0) + S Y=$$AGEF(DFN,$G(BMXDT)) +"RTN","BMXUTL1",57,0) + S:Y["DECEASED" Y="DECEASED" +"RTN","BMXUTL1",58,0) + S X=X_" ("_Y_")" +"RTN","BMXUTL1",59,0) + Q X +"RTN","BMXUTL1",60,0) + ; +"RTN","BMXUTL1",61,0) + ; +"RTN","BMXUTL1",62,0) + ;---------- +"RTN","BMXUTL1",63,0) +AGE(DFN,BMXZ,BMXDT) ;EP +"RTN","BMXUTL1",64,0) + ;---> Return Patient's Age. +"RTN","BMXUTL1",65,0) + ;---> Parameters: +"RTN","BMXUTL1",66,0) + ; 1 - DFN (req) IEN in PATIENT File. +"RTN","BMXUTL1",67,0) + ; 2 - BMXZ (opt) BMXZ=1,2,3 1=years, 2=months, 3=days. +"RTN","BMXUTL1",68,0) + ; 2 will be assumed if not passed. +"RTN","BMXUTL1",69,0) + ; 3 - BMXDT (opt) Date on which Age should be calculated. +"RTN","BMXUTL1",70,0) + ; +"RTN","BMXUTL1",71,0) + N BMXDOB,X,X1,X2 S:$G(BMXZ)="" BMXZ=2 +"RTN","BMXUTL1",72,0) + Q:'$G(DFN) "NO PATIENT" +"RTN","BMXUTL1",73,0) + S BMXDOB=$$DOB(DFN) +"RTN","BMXUTL1",74,0) + Q:'BMXDOB "Unknown" +"RTN","BMXUTL1",75,0) + I '$G(BMXDT)&($$DECEASED(DFN)) D Q X +"RTN","BMXUTL1",76,0) + .S X="DECEASED: "_$$TXDT1^BMXUTL5(+^DPT(DFN,.35)) +"RTN","BMXUTL1",77,0) + S:'$G(DT) DT=$$DT^XLFDT +"RTN","BMXUTL1",78,0) + S:'$G(BMXDT) BMXDT=DT +"RTN","BMXUTL1",79,0) + Q:BMXDT 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 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&(BMXD2BMXM1 S BMXAGEM=BMXAGEM+BMXM2-BMXM1 +"RTN","BMXUTL1",95,0) + I BMXM2 Age in Days. +"RTN","BMXUTL1",100,0) + S X1=BMXDT,X2=BMXDOB +"RTN","BMXUTL1",101,0) + D ^%DTC +"RTN","BMXUTL1",102,0) + Q X +"RTN","BMXUTL1",103,0) + ; +"RTN","BMXUTL1",104,0) + ; +"RTN","BMXUTL1",105,0) + ;---------- +"RTN","BMXUTL1",106,0) +AGEF(DFN,BMXDT) ;EP +"RTN","BMXUTL1",107,0) + ;---> Age formatted "35 Months" or "23 Years" +"RTN","BMXUTL1",108,0) + ;---> Parameters: +"RTN","BMXUTL1",109,0) + ; 1 - DFN (req) Patient's IEN (DFN). +"RTN","BMXUTL1",110,0) + ; 2 - BMXDT (opt) Date on which Age should be calculated. +"RTN","BMXUTL1",111,0) + ; +"RTN","BMXUTL1",112,0) + N Y +"RTN","BMXUTL1",113,0) + S Y=$$AGE(DFN,2,$G(BMXDT)) +"RTN","BMXUTL1",114,0) + Q:Y["DECEASED" Y +"RTN","BMXUTL1",115,0) + Q:Y["NOT BORN" Y +"RTN","BMXUTL1",116,0) + ; +"RTN","BMXUTL1",117,0) + ;---> If over 60 months, return years. +"RTN","BMXUTL1",118,0) + Q:Y>60 $$AGE(DFN,1,$G(BMXDT))_" years" +"RTN","BMXUTL1",119,0) + ; +"RTN","BMXUTL1",120,0) + ;---> If under 1 month return days. +"RTN","BMXUTL1",121,0) + I Y<1 S Y=$$AGE(DFN,3,$G(BMXDT)) Q Y_$S(Y=1:" day",1:" days") +"RTN","BMXUTL1",122,0) + ; +"RTN","BMXUTL1",123,0) + ;---> Return months +"RTN","BMXUTL1",124,0) + Q Y_$S(Y=1:" month",1:" months") +"RTN","BMXUTL1",125,0) + ; +"RTN","BMXUTL1",126,0) + ; +"RTN","BMXUTL1",127,0) + ;---------- +"RTN","BMXUTL1",128,0) +DECEASED(DFN,BMXDT) ;EP +"RTN","BMXUTL1",129,0) + ;---> Return 1 if patient is deceased, 0 if not deceased. +"RTN","BMXUTL1",130,0) + ;---> Parameters: +"RTN","BMXUTL1",131,0) + ; 1 - DFN (req) Patient's IEN (DFN). +"RTN","BMXUTL1",132,0) + ; 2 - BMXDT (opt) If BMXDT=1 return Date of Death (Fileman format). +"RTN","BMXUTL1",133,0) + ; +"RTN","BMXUTL1",134,0) + Q:'$G(DFN) 0 +"RTN","BMXUTL1",135,0) + N X S X=+$G(^DPT(DFN,.35)) +"RTN","BMXUTL1",136,0) + Q:'X 0 +"RTN","BMXUTL1",137,0) + Q:'$G(BMXDT) 1 +"RTN","BMXUTL1",138,0) + Q X +"RTN","BMXUTL1",139,0) + ; +"RTN","BMXUTL1",140,0) + ; +"RTN","BMXUTL1",141,0) + ;---------- +"RTN","BMXUTL1",142,0) +SEX(DFN,PRON) ;EP +"RTN","BMXUTL1",143,0) + ;---> Return "F" is patient is female, "M" if male. +"RTN","BMXUTL1",144,0) + ;---> Parameters: +"RTN","BMXUTL1",145,0) + ; 1 - DFN (req) Patient's IEN (DFN). +"RTN","BMXUTL1",146,0) + ; 2 - PRON (opt) Pronoun: 1=he/she, 2=him/her,3=his,her +"RTN","BMXUTL1",147,0) + ; +"RTN","BMXUTL1",148,0) + Q:'$G(DFN) "" +"RTN","BMXUTL1",149,0) + Q:'$D(^DPT(DFN,0)) "" +"RTN","BMXUTL1",150,0) + N X S X=$P(^DPT(DFN,0),U,2) +"RTN","BMXUTL1",151,0) + Q:'$G(PRON) X +"RTN","BMXUTL1",152,0) + I PRON=1 Q $S(X="F":"she",1:"he") +"RTN","BMXUTL1",153,0) + I PRON=2 Q $S(X="F":"her",1:"him") +"RTN","BMXUTL1",154,0) + I PRON=3 Q $S(X="F":"her",1:"his") +"RTN","BMXUTL1",155,0) + Q X +"RTN","BMXUTL1",156,0) + ; +"RTN","BMXUTL1",157,0) + ; +"RTN","BMXUTL1",158,0) + ;---------- +"RTN","BMXUTL1",159,0) +SEXW(DFN) ;EP +"RTN","BMXUTL1",160,0) + ;---> Return Patient sex: "Female"/"Male". +"RTN","BMXUTL1",161,0) + ;---> Parameters: +"RTN","BMXUTL1",162,0) + ; 1 - DFN (req) Patient's IEN (DFN). +"RTN","BMXUTL1",163,0) + ; +"RTN","BMXUTL1",164,0) + Q:$$SEX(DFN)="M" "Male" +"RTN","BMXUTL1",165,0) + Q:$$SEX(DFN)="F" "Female" +"RTN","BMXUTL1",166,0) + Q "Unknown" +"RTN","BMXUTL1",167,0) + ; +"RTN","BMXUTL1",168,0) + ; +"RTN","BMXUTL1",169,0) + ;---------- +"RTN","BMXUTL1",170,0) +NAMAGE(DFN) ;EP +"RTN","BMXUTL1",171,0) + ;---> Return Patient Name concatenated with age. +"RTN","BMXUTL1",172,0) + ;---> Parameters: +"RTN","BMXUTL1",173,0) + ; 1 - DFN (req) Patient's IEN (DFN). +"RTN","BMXUTL1",174,0) + ; +"RTN","BMXUTL1",175,0) + Q:'$G(DFN) "NO PATIENT" +"RTN","BMXUTL1",176,0) + Q $$NAME(DFN)_" ("_$$AGE(DFN)_"y/o)" +"RTN","BMXUTL1",177,0) + ; +"RTN","BMXUTL1",178,0) + ; +"RTN","BMXUTL1",179,0) + ;---------- +"RTN","BMXUTL1",180,0) +SSN(DFN) ;EP +"RTN","BMXUTL1",181,0) + ;---> Return Social Security Number (SSN). +"RTN","BMXUTL1",182,0) + ;---> Parameters: +"RTN","BMXUTL1",183,0) + ; 1 - DFN (req) Patient's IEN (DFN). +"RTN","BMXUTL1",184,0) + N X +"RTN","BMXUTL1",185,0) + Q:'$G(DFN) "NO PATIENT" +"RTN","BMXUTL1",186,0) + Q:'$D(^DPT(DFN,0)) "Unknown" +"RTN","BMXUTL1",187,0) + S X=$P(^DPT(DFN,0),U,9) +"RTN","BMXUTL1",188,0) + Q:X']"" "Unknown" +"RTN","BMXUTL1",189,0) + Q X +"RTN","BMXUTL1",190,0) + ; +"RTN","BMXUTL1",191,0) + ; +"RTN","BMXUTL1",192,0) + ;---------- +"RTN","BMXUTL1",193,0) +HRCN(DFN,DUZ2,AGD) ;EP +"RTN","BMXUTL1",194,0) + ;---> Return IHS Health Record Number. +"RTN","BMXUTL1",195,0) + ;---> Parameters: +"RTN","BMXUTL1",196,0) + ; 1 - DFN (req) Patient's IEN (DFN). +"RTN","BMXUTL1",197,0) + ; 2 - DUZ2 (opt) User's Site/Location IEN. If no DUZ2 +"RTN","BMXUTL1",198,0) + ; provided, function will look for DUZ(2). +"RTN","BMXUTL1",199,0) + ; 3 - AGD (opt) If AGD=1 return HRCN with no dashes. +"RTN","BMXUTL1",200,0) + ; +"RTN","BMXUTL1",201,0) + ; +"RTN","BMXUTL1",202,0) + S:'$G(DUZ2) DUZ2=$G(DUZ(2)) +"RTN","BMXUTL1",203,0) + Q:'$G(DFN)!('$G(DUZ2)) "Unknown1" +"RTN","BMXUTL1",204,0) + Q:'$D(^AUPNPAT(DFN,41,DUZ2,0)) "Unknown2" +"RTN","BMXUTL1",205,0) + Q:'+$P(^AUPNPAT(DFN,41,DUZ2,0),"^",2) "Unknown3" +"RTN","BMXUTL1",206,0) + N Y S Y=$P(^AUPNPAT(DFN,41,DUZ2,0),"^",2) +"RTN","BMXUTL1",207,0) + Q:$G(AGD) Y +"RTN","BMXUTL1",208,0) + Q:'+Y Y +"RTN","BMXUTL1",209,0) + I $L(Y)=7 D Q Y +"RTN","BMXUTL1",210,0) + .S Y=$TR("123-45-67",1234567,Y) +"RTN","BMXUTL1",211,0) + S Y=$E("00000",0,6-$L(Y))_Y +"RTN","BMXUTL1",212,0) + S Y=$TR("12-34-56",123456,Y) +"RTN","BMXUTL1",213,0) + Q Y +"RTN","BMXUTL1",214,0) + ; +"RTN","BMXUTL1",215,0) + ; +"RTN","BMXUTL1",216,0) + ;---------- +"RTN","BMXUTL1",217,0) +PHONE(AGDFN,AGOFF) ;EP +"RTN","BMXUTL1",218,0) + ;---> Return patient's home phone number. +"RTN","BMXUTL1",219,0) + ;---> Parameters: +"RTN","BMXUTL1",220,0) + ; 1 - AGDFN (req) Patient's IEN (DFN). +"RTN","BMXUTL1",221,0) + ; 2 - AGOFF (opt) =1 will return Patient's Office Phone. +"RTN","BMXUTL1",222,0) + ; +"RTN","BMXUTL1",223,0) + Q:'$G(AGDFN) "Error: No DFN" +"RTN","BMXUTL1",224,0) + Q $P($G(^DPT(AGDFN,.13)),U,$S($G(AGOFF):2,1:1)) +"RTN","BMXUTL1",225,0) + ; +"RTN","BMXUTL1",226,0) + ; +"RTN","BMXUTL1",227,0) + ;---------- +"RTN","BMXUTL1",228,0) +STREET(DFN) ;EP +"RTN","BMXUTL1",229,0) + ;---> Return patient's street address. +"RTN","BMXUTL1",230,0) + ;---> Parameters: +"RTN","BMXUTL1",231,0) + ; 1 - DFN (req) Patient's IEN (DFN). +"RTN","BMXUTL1",232,0) + ; +"RTN","BMXUTL1",233,0) + Q:'$G(DFN) "No Patient" +"RTN","BMXUTL1",234,0) + Q:'$D(^DPT(DFN,.11)) "" +"RTN","BMXUTL1",235,0) + Q:$P(^DPT(DFN,.11),U)="" "" +"RTN","BMXUTL1",236,0) + Q $P(^DPT(DFN,.11),U) +"RTN","BMXUTL1",237,0) + ; +"RTN","BMXUTL1",238,0) + ; +"RTN","BMXUTL1",239,0) + ;---------- +"RTN","BMXUTL1",240,0) +CITY(DFN) ;EP +"RTN","BMXUTL1",241,0) + ;---> Return patient's city. +"RTN","BMXUTL1",242,0) + ;---> Parameters: +"RTN","BMXUTL1",243,0) + ; 1 - DFN (req) Patient's IEN (DFN). +"RTN","BMXUTL1",244,0) + ; +"RTN","BMXUTL1",245,0) + Q:'$G(DFN) "No Patient" +"RTN","BMXUTL1",246,0) + Q:'$D(^DPT(DFN,.11)) "" +"RTN","BMXUTL1",247,0) + Q:$P(^DPT(DFN,.11),U,4)="" "" +"RTN","BMXUTL1",248,0) + Q $P(^DPT(DFN,.11),U,4) +"RTN","BMXUTL1",249,0) + ; +"RTN","BMXUTL1",250,0) + ; +"RTN","BMXUTL1",251,0) + ;---------- +"RTN","BMXUTL1",252,0) +STATE(DFN,NOTEXT) ;EP +"RTN","BMXUTL1",253,0) + ;---> Return patient's state. +"RTN","BMXUTL1",254,0) + ;---> Parameters: +"RTN","BMXUTL1",255,0) + ; 1 - DFN (req) Patient's IEN (DFN). +"RTN","BMXUTL1",256,0) + ; 2 - NOTEXT (opt) If NOTEXT=1 return only the State IEN. +"RTN","BMXUTL1",257,0) + ; If NOTEXT=2 return IEN|Text. +"RTN","BMXUTL1",258,0) + ; +"RTN","BMXUTL1",259,0) + Q:'$G(DFN) "" +"RTN","BMXUTL1",260,0) + N Y S Y=$P($G(^DPT(DFN,.11)),U,5) +"RTN","BMXUTL1",261,0) + Q:$G(NOTEXT)=1 Y +"RTN","BMXUTL1",262,0) + Q:$G(NOTEXT)=2 Y_"|"_$$GET^BMXG(1,Y) +"RTN","BMXUTL1",263,0) + Q $$GET^BMXG(1,Y) +"RTN","BMXUTL1",264,0) + ; +"RTN","BMXUTL1",265,0) + ; +"RTN","BMXUTL1",266,0) + ;---------- +"RTN","BMXUTL1",267,0) +ZIP(DFN) ;EP +"RTN","BMXUTL1",268,0) + ;---> Return patient's zipcode. +"RTN","BMXUTL1",269,0) + ;---> Parameters: +"RTN","BMXUTL1",270,0) + ; 1 - DFN (req) Patient's IEN (DFN). +"RTN","BMXUTL1",271,0) + ; +"RTN","BMXUTL1",272,0) + Q:'$G(DFN) "No Patient" +"RTN","BMXUTL1",273,0) + Q:'$D(^DPT(DFN,.11)) "" +"RTN","BMXUTL1",274,0) + Q:$P(^DPT(DFN,.11),U,6)="" "" +"RTN","BMXUTL1",275,0) + Q $P(^DPT(DFN,.11),U,6) +"RTN","BMXUTL1",276,0) + ; +"RTN","BMXUTL1",277,0) + ; +"RTN","BMXUTL1",278,0) + ;---------- +"RTN","BMXUTL1",279,0) +CTYSTZ(DFN) ;EP +"RTN","BMXUTL1",280,0) + ;---> Return patient's city, state zip. +"RTN","BMXUTL1",281,0) + ;---> Parameters: +"RTN","BMXUTL1",282,0) + ; 1 - DFN (req) Patient's IEN (DFN). +"RTN","BMXUTL1",283,0) + ; +"RTN","BMXUTL1",284,0) + Q:'$G(DFN) "No Patient" +"RTN","BMXUTL1",285,0) + Q $$CITY(DFN)_", "_$$STATE(DFN)_" "_$$ZIP(DFN) +"RTN","BMXUTL1",286,0) + ; +"RTN","BMXUTL1",287,0) + ; +"RTN","BMXUTL1",288,0) +CURCOM(DFN,NOTEXT) ;EP +"RTN","BMXUTL1",289,0) + ;---> Return patient's Current Community IEN or Text. +"RTN","BMXUTL1",290,0) + ;---> (Item 6 on page 1 of Registration). +"RTN","BMXUTL1",291,0) + ;---> Parameters: +"RTN","BMXUTL1",292,0) + ; 1 - DFN (req) Patient's IEN (DFN). +"RTN","BMXUTL1",293,0) + ; 2 - NOTEXT (opt) If NOTEXT=1 return only the Current Comm IEN. +"RTN","BMXUTL1",294,0) + ; If NOTEXT=2 return IEN|Text. +"RTN","BMXUTL1",295,0) + ; +"RTN","BMXUTL1",296,0) + Q:'$G(DFN) "No Patient" +"RTN","BMXUTL1",297,0) + Q:'$D(^AUPNPAT(DFN,11)) "" ;"Unknown1" +"RTN","BMXUTL1",298,0) + ; +"RTN","BMXUTL1",299,0) + N X,Y,Z +"RTN","BMXUTL1",300,0) + S X=^AUPNPAT(DFN,11) +"RTN","BMXUTL1",301,0) + ;---> Set Y=Pointer (IEN in ^AUTTCOM, piece 17), Z=Text (piece 18). +"RTN","BMXUTL1",302,0) + S Y=$P(X,U,17),Z=$P(X,U,18) +"RTN","BMXUTL1",303,0) + ;---> If both Pointer and Text are null, return "Unknown2". +"RTN","BMXUTL1",304,0) + Q:('Y&(Z="")) "" ;"Unknown2" +"RTN","BMXUTL1",305,0) + ; +"RTN","BMXUTL1",306,0) + ;---> If Y is null or a bad pointer, set Y="". +"RTN","BMXUTL1",307,0) + I Y<1!('$D(^AUTTCOM(+Y,0))) S Y="" +"RTN","BMXUTL1",308,0) + ; +"RTN","BMXUTL1",309,0) + ;---> If no valid pointer and if Text (pc 18) exists in the +"RTN","BMXUTL1",310,0) + ;---> Community file, then set Y=IEN in ^AUTTCOM(. +"RTN","BMXUTL1",311,0) + I Y<1,$D(^AUTTCOM("B",Z)) S Y=$O(^AUTTCOM("B",Z,0)) +"RTN","BMXUTL1",312,0) + ; +"RTN","BMXUTL1",313,0) + Q:'$D(^AUTTCOM(+Y,0)) "" ;"Unknown3" +"RTN","BMXUTL1",314,0) + Q:$G(NOTEXT)=1 Y +"RTN","BMXUTL1",315,0) + Q:$G(NOTEXT)=2 Y_"|"_$$GET^BMXG(2,Y) +"RTN","BMXUTL1",316,0) + Q $$GET^BMXG(2,Y) +"RTN","BMXUTL1",317,0) + ; +"RTN","BMXUTL1",318,0) + ; +"RTN","BMXUTL1",319,0) + ;---------- +"RTN","BMXUTL1",320,0) +PERSON(X,ORDER) ;EP +"RTN","BMXUTL1",321,0) + ;---> Return person's name from File #200. +"RTN","BMXUTL1",322,0) + ;---> Parameters: +"RTN","BMXUTL1",323,0) + ; 1 - X (req) Person's IEN in New Person File #200. +"RTN","BMXUTL1",324,0) + ; 2 - ORDER (opt) ""/0=Last,First 1=First Last +"RTN","BMXUTL1",325,0) + ; +"RTN","BMXUTL1",326,0) + Q:'X "Unknown" +"RTN","BMXUTL1",327,0) + Q:'$D(^VA(200,X,0)) "Unknown" +"RTN","BMXUTL1",328,0) + N Y S Y=$P(^VA(200,X,0),U) +"RTN","BMXUTL1",329,0) + Q:'$G(ORDER) Y +"RTN","BMXUTL1",330,0) + Q $$FL(Y) +"RTN","BMXUTL2") +0^109^B1806952 +"RTN","BMXUTL2",1,0) +BMXUTL2 ; IHS/OIT/HMW - UTIL: PATIENT INFO ; +"RTN","BMXUTL2",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXUTL2",3,0) + ;;Stolen from:* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER * +"RTN","BMXUTL2",4,0) + ;; UTILITY: PATIENT FUNCTIONS: CONTRAS, INPATIENT, HIDOSE. +"RTN","BMXUTL2",5,0) + ; +"RTN","BMXUTL2",6,0) +NEXTAPPT(BMXDFN) ;EP +"RTN","BMXUTL2",7,0) + ;---> Return patient's next appointment from Scheduling Package. +"RTN","BMXUTL2",8,0) + ;---> Parameters: +"RTN","BMXUTL2",9,0) + ; 1 - BMXDFN (req) Patient's IEN (BMXDFN). +"RTN","BMXUTL2",10,0) + ; +"RTN","BMXUTL2",11,0) + Q:'$G(BMXDFN) "" +"RTN","BMXUTL2",12,0) + Q:'$D(^DPT(BMXDFN)) "" +"RTN","BMXUTL2",13,0) + ; +"RTN","BMXUTL2",14,0) + N BMXAPPT,BMXDT,BMXYES +"RTN","BMXUTL2",15,0) + S BMXDT=DT+.2400,BMXYES=0 +"RTN","BMXUTL2",16,0) + F S BMXDT=$O(^DPT(BMXDFN,"S",BMXDT)) Q:'BMXDT!(BMXYES) D +"RTN","BMXUTL2",17,0) + .N BMXDATA,BMXOI,X +"RTN","BMXUTL2",18,0) + .S BMXDATA=$G(^DPT(BMXDFN,"S",BMXDT,0)) +"RTN","BMXUTL2",19,0) + .Q:BMXDATA="" +"RTN","BMXUTL2",20,0) + .; +"RTN","BMXUTL2",21,0) + .;---> Quit if appointment is cancelled. +"RTN","BMXUTL2",22,0) + .Q:$P(BMXDATA,U,2)["C" +"RTN","BMXUTL2",23,0) + .; +"RTN","BMXUTL2",24,0) + .S X=0 F S X=$O(^SC(+BMXDATA,"S",BMXDT,1,X)) Q:'X D +"RTN","BMXUTL2",25,0) + ..Q:+$G(^SC(+BMXDATA,"S",BMXDT,1,X,0))'=BMXDFN +"RTN","BMXUTL2",26,0) + ..S BMXYES=BMXDT_U_+BMXDATA +"RTN","BMXUTL2",27,0) + ; +"RTN","BMXUTL2",28,0) + Q:'BMXYES "" +"RTN","BMXUTL2",29,0) + ; +"RTN","BMXUTL2",30,0) + S BMXAPPT=$$FMTE^XLFDT(+BMXYES,"1P")_" with " +"RTN","BMXUTL2",31,0) + S BMXAPPT=BMXAPPT_$P($G(^SC($P(BMXYES,U,2),0)),U) +"RTN","BMXUTL2",32,0) + Q BMXAPPT +"RTN","BMXUTL5") +0^110^B16165811 +"RTN","BMXUTL5",1,0) +BMXUTL5 ; IHS/OIT/HMW - DATE FORMAT ; +"RTN","BMXUTL5",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXUTL5",3,0) + ;;Stolen from:* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER * +"RTN","BMXUTL5",4,0) + ;; UTILITY: SETVARS, CENTERT, COPYLET, +"RTN","BMXUTL5",5,0) + ;; UPPERCASE XREFS, DATE FORMATS, PADS/SPACES. +"RTN","BMXUTL5",6,0) + ; +"RTN","BMXUTL5",7,0) + ; +"RTN","BMXUTL5",8,0) + ;---------- +"RTN","BMXUTL5",9,0) +SETVARS ;EP +"RTN","BMXUTL5",10,0) + ;---> Set standard variables. +"RTN","BMXUTL5",11,0) + D ^XBKVAR +"RTN","BMXUTL5",12,0) + S:'$D(IOF) IOF="#" +"RTN","BMXUTL5",13,0) + Q +"RTN","BMXUTL5",14,0) + ; +"RTN","BMXUTL5",15,0) + ; +"RTN","BMXUTL5",16,0) + ;---------- +"RTN","BMXUTL5",17,0) +PHONFIX(X) ;EP +"RTN","BMXUTL5",18,0) + ;---> Remove parentheses from Phone#. +"RTN","BMXUTL5",19,0) + ;---> Parameters: +"RTN","BMXUTL5",20,0) + ; 1 - X (req) Input Phone Number; returned without parentheses. +"RTN","BMXUTL5",21,0) + ; +"RTN","BMXUTL5",22,0) + Q:$G(X)="" +"RTN","BMXUTL5",23,0) + S X=$TR(X,"(","") +"RTN","BMXUTL5",24,0) + S X=$TR(X,")","-") +"RTN","BMXUTL5",25,0) + S X=$TR(X,"/","-") +"RTN","BMXUTL5",26,0) + S:X["- " X=$P(X,"- ")_"-"_$P(X,"- ",2) +"RTN","BMXUTL5",27,0) + S:$E(X,4)=" " $E(X,4)="-" +"RTN","BMXUTL5",28,0) + S:X["--" X=$P(X,"--")_"-"_$P(X,"--",2) +"RTN","BMXUTL5",29,0) + S:X?7N X=$E(X,1,3)_"-"_$E(X,4,7) +"RTN","BMXUTL5",30,0) + Q +"RTN","BMXUTL5",31,0) + ; +"RTN","BMXUTL5",32,0) + ; +"RTN","BMXUTL5",33,0) + ;---------- +"RTN","BMXUTL5",34,0) +CENTERT(TEXT,X) ;EP +"RTN","BMXUTL5",35,0) + ;---> Pad TEXT with leading spaces to center in 80 columns. +"RTN","BMXUTL5",36,0) + ;---> Parameters: +"RTN","BMXUTL5",37,0) + ; 1 - TEXT (req) Text to be centered. +"RTN","BMXUTL5",38,0) + ; 2 - X (opt) Columns to adjust to the right. +"RTN","BMXUTL5",39,0) + ; +"RTN","BMXUTL5",40,0) + S:$G(TEXT)="" TEXT="* NO TEXT SUPPLIED *" +"RTN","BMXUTL5",41,0) + S:'$G(X) X=39 +"RTN","BMXUTL5",42,0) + N I +"RTN","BMXUTL5",43,0) + F I=1:1:(X-($L(TEXT)/2)) S TEXT=" "_TEXT +"RTN","BMXUTL5",44,0) + Q +"RTN","BMXUTL5",45,0) + ; +"RTN","BMXUTL5",46,0) + ; +"RTN","BMXUTL5",47,0) + ;---------- +"RTN","BMXUTL5",48,0) +UPPER(X) ;EP +"RTN","BMXUTL5",49,0) + ;---> Translate X to all uppercase. +"RTN","BMXUTL5",50,0) + ;---> Parameters: +"RTN","BMXUTL5",51,0) + ; 1 - X (req) Value to be translated into all uppercase. +"RTN","BMXUTL5",52,0) + ; +"RTN","BMXUTL5",53,0) + S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") +"RTN","BMXUTL5",54,0) + Q X +"RTN","BMXUTL5",55,0) + ; +"RTN","BMXUTL5",56,0) + ; +"RTN","BMXUTL5",57,0) + ;---------- +"RTN","BMXUTL5",58,0) +UPXREF(X,AGGBL) ;EP +"RTN","BMXUTL5",59,0) + ;---> Set uppercase xref for X. Called from M xrefs on mixed case +"RTN","BMXUTL5",60,0) + ;---> fields where an all uppercase lookup is needed. +"RTN","BMXUTL5",61,0) + ;---> Parameters: +"RTN","BMXUTL5",62,0) + ; 1 - X (req) The value that should be xrefed in uppercase. +"RTN","BMXUTL5",63,0) + ; 2 - AGGBL (req) The global root of the file. +"RTN","BMXUTL5",64,0) + ; +"RTN","BMXUTL5",65,0) + ;---> Variables: +"RTN","BMXUTL5",66,0) + ; 1 - DA (req) IEN of the entry being xrefed. +"RTN","BMXUTL5",67,0) + ; +"RTN","BMXUTL5",68,0) + Q:'$D(AGGBL) Q:$G(X)="" Q:'$G(DA) +"RTN","BMXUTL5",69,0) + S @(AGGBL_"""U"",$E($$UPPER(X),1,30),DA)")="" +"RTN","BMXUTL5",70,0) + Q +"RTN","BMXUTL5",71,0) + ; +"RTN","BMXUTL5",72,0) + ; +"RTN","BMXUTL5",73,0) + ;---------- +"RTN","BMXUTL5",74,0) +KUPXREF(X,AGGBL) ;EP +"RTN","BMXUTL5",75,0) + ;---> Kill uppercase xref for X. Called from M xrefs on mixed case +"RTN","BMXUTL5",76,0) + ;---> fields where an all uppercase lookup is needed. +"RTN","BMXUTL5",77,0) + ;---> Parameters: +"RTN","BMXUTL5",78,0) + ; 1 - X (req) The value that should be xrefed in uppercase. +"RTN","BMXUTL5",79,0) + ; 2 - AGGBL (req) The global root of the file. +"RTN","BMXUTL5",80,0) + ; +"RTN","BMXUTL5",81,0) + ;---> Variables: +"RTN","BMXUTL5",82,0) + ; 1 - DA (req) IEN of the entry being xrefed. +"RTN","BMXUTL5",83,0) + ; +"RTN","BMXUTL5",84,0) + Q:'$D(AGGBL) Q:$G(X)="" Q:'$G(DA) +"RTN","BMXUTL5",85,0) + K @(AGGBL_"""U"",$E($$UPPER(X),1,30),DA)") +"RTN","BMXUTL5",86,0) + Q +"RTN","BMXUTL5",87,0) + ; +"RTN","BMXUTL5",88,0) + ; +"RTN","BMXUTL5",89,0) + ;---------- +"RTN","BMXUTL5",90,0) +SLDT2(DATE) ;EP +"RTN","BMXUTL5",91,0) + ;---> CONVERT FILEMAN INTERNAL DATE TO "SLASH" FORMAT: MM/DD/YYYY. +"RTN","BMXUTL5",92,0) + ;---> DATE=DATE IN FILEMAN FORMAT. +"RTN","BMXUTL5",93,0) + Q:'$G(DATE) "NO DATE" +"RTN","BMXUTL5",94,0) + S DATE=$P(DATE,".") +"RTN","BMXUTL5",95,0) + Q:$L(DATE)'=7 DATE +"RTN","BMXUTL5",96,0) + Q:'$E(DATE,4,5) $E(DATE,1,3)+1700 +"RTN","BMXUTL5",97,0) + Q:'$E(DATE,6,7) $E(DATE,4,5)_"/"_$E(DATE,2,3) +"RTN","BMXUTL5",98,0) + Q $E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_($E(DATE,1,3)+1700) +"RTN","BMXUTL5",99,0) + ; +"RTN","BMXUTL5",100,0) + ; +"RTN","BMXUTL5",101,0) + ;---------- +"RTN","BMXUTL5",102,0) +SLDT1(DATE) ;EP +"RTN","BMXUTL5",103,0) + ;---> CONVERT FILEMAN INTERNAL DATE TO "SLASH" FORMAT: +"RTN","BMXUTL5",104,0) + ;---> MM/DD/YYYY @TIME +"RTN","BMXUTL5",105,0) + N Y +"RTN","BMXUTL5",106,0) + Q:'$D(DATE) "NO DATE" +"RTN","BMXUTL5",107,0) + S Y=DATE,DATE=$P(DATE,".") +"RTN","BMXUTL5",108,0) + Q:'DATE "NO DATE" +"RTN","BMXUTL5",109,0) + Q:$L(DATE)'=7 DATE +"RTN","BMXUTL5",110,0) + Q:'$E(DATE,4,5) $E(DATE,1,3)+1700 +"RTN","BMXUTL5",111,0) + Q:'$E(DATE,6,7) $E(DATE,4,5)_"/"_$E(DATE,2,3) +"RTN","BMXUTL5",112,0) + D DD^%DT S:Y["@" Y=" @ "_$P($P(Y,"@",2),":",1,2) +"RTN","BMXUTL5",113,0) + Q $E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_($E(DATE,1,3)+1700)_Y +"RTN","BMXUTL5",114,0) + ; +"RTN","BMXUTL5",115,0) + ; +"RTN","BMXUTL5",116,0) + ;---------- +"RTN","BMXUTL5",117,0) +NOSLDT(DATE) ;EP +"RTN","BMXUTL5",118,0) + ;---> CONVERT FILEMAN INTERNAL DATE TO "NO SLASH" FORMAT: MMDDYYYY. +"RTN","BMXUTL5",119,0) + ;---> DATE=DATE IN FILEMAN FORMAT. +"RTN","BMXUTL5",120,0) + Q:'$G(DATE) "NO DATE" +"RTN","BMXUTL5",121,0) + S DATE=$P(DATE,".") +"RTN","BMXUTL5",122,0) + Q:$L(DATE)'=7 DATE +"RTN","BMXUTL5",123,0) + Q $E(DATE,4,5)_$E(DATE,6,7)_($E(DATE,1,3)+1700) +"RTN","BMXUTL5",124,0) + ; +"RTN","BMXUTL5",125,0) + ; +"RTN","BMXUTL5",126,0) + ;---------- +"RTN","BMXUTL5",127,0) +IMMSDT(DATE) ;EP +"RTN","BMXUTL5",128,0) + ;---> Convert Immserve Date (format MMDDYYYY) TO FILEMAN +"RTN","BMXUTL5",129,0) + ;---> Internal format. +"RTN","BMXUTL5",130,0) + ;---> NOTE: This code is copied into routine ^AGPATUP1 for speed. +"RTN","BMXUTL5",131,0) + ;---> Any changes here should also be made to the call in ^AGPATUP1. +"RTN","BMXUTL5",132,0) + Q:'$G(DATE) "NO DATE" +"RTN","BMXUTL5",133,0) + Q ($E(DATE,5,9)-1700)_$E(DATE,1,2)_$E(DATE,3,4) +"RTN","BMXUTL5",134,0) + ; +"RTN","BMXUTL5",135,0) + ; +"RTN","BMXUTL5",136,0) + ;---------- +"RTN","BMXUTL5",137,0) +TXDT1(DATE,TIME) ;EP +"RTN","BMXUTL5",138,0) + ;---> Return external date in format: DD-Mmm-YYYY@HH:MM, from Fileman +"RTN","BMXUTL5",139,0) + ;---> internal YYYMMDD.HHMM +"RTN","BMXUTL5",140,0) + ;---> Parameters: +"RTN","BMXUTL5",141,0) + ; 1 - DATE (req) Internal Fileman date. +"RTN","BMXUTL5",142,0) + ; 2 - TIME (opt) +"RTN","BMXUTL5",143,0) + ; +"RTN","BMXUTL5",144,0) + Q:'$G(DATE) "NO DATE" +"RTN","BMXUTL5",145,0) + N X,Y,Z +"RTN","BMXUTL5",146,0) + S X="Jan^Feb^Mar^Apr^May^Jun^Jul^Aug^Sep^Oct^Nov^Dec" +"RTN","BMXUTL5",147,0) + S Y=$E(DATE,6,7)_"-"_$P(X,U,$E(DATE,4,5))_"-"_($E(DATE,1,3)+1700) +"RTN","BMXUTL5",148,0) + S:'$E(DATE,6,7) Y=$E(Y,4,99) +"RTN","BMXUTL5",149,0) + S:'$E(DATE,4,5) Y=$E(DATE,1,3)+1700 +"RTN","BMXUTL5",150,0) + Q:'$G(TIME) Y +"RTN","BMXUTL5",151,0) + S Z=$P(DATE,".",2) +"RTN","BMXUTL5",152,0) + Q:'Z Y +"RTN","BMXUTL5",153,0) + Q Y_" @"_$E(Z,1,2)_":"_$$PAD($E(Z,3,4),2,"0") +"RTN","BMXUTL5",154,0) + ; +"RTN","BMXUTL5",155,0) + ; +"RTN","BMXUTL5",156,0) + ;---------- +"RTN","BMXUTL5",157,0) +TXDT(DATE) ;EP +"RTN","BMXUTL5",158,0) + ;---> CONVERT FILEMAN INTERNAL DATE TO "TEXT" FORMAT: MMM DD,YYYY. +"RTN","BMXUTL5",159,0) + N Y +"RTN","BMXUTL5",160,0) + Q:'$D(DATE) "NO DATE" +"RTN","BMXUTL5",161,0) + S Y=DATE D DD^%DT +"RTN","BMXUTL5",162,0) + I Y[", " S Y=$P(Y,", ")_","_$P(Y,", ",2) +"RTN","BMXUTL5",163,0) + I Y["@" S Y=$P(Y,"@")_" "_$P($P(Y,"@",2),":",1,2) +"RTN","BMXUTL5",164,0) + Q Y +"RTN","BMXUTL5",165,0) + ; +"RTN","BMXUTL5",166,0) + ; +"RTN","BMXUTL5",167,0) + ;---------- +"RTN","BMXUTL5",168,0) +NOW() ;EP +"RTN","BMXUTL5",169,0) + ;---> Return Current Date and Time in external format. +"RTN","BMXUTL5",170,0) + N %H,X,Y,Z +"RTN","BMXUTL5",171,0) + S %H=$H +"RTN","BMXUTL5",172,0) + D YX^%DTC +"RTN","BMXUTL5",173,0) + I Y["@" S Y=$P($P(Y,"@",2),":",1,2) +"RTN","BMXUTL5",174,0) + S Z=$$TXDT1(X) +"RTN","BMXUTL5",175,0) + S:Y]"" Z=Z_" @"_Y +"RTN","BMXUTL5",176,0) + Q Z +"RTN","BMXUTL5",177,0) + ; +"RTN","BMXUTL5",178,0) + ; +"RTN","BMXUTL5",179,0) + ;---------- +"RTN","BMXUTL5",180,0) +PAD(D,L,C) ;EP +"RTN","BMXUTL5",181,0) + ;---> Pad the length of data to a total of L characters +"RTN","BMXUTL5",182,0) + ;---> by adding spaces to the end of the data. +"RTN","BMXUTL5",183,0) + ; Example: S X=$$PAD("MIKE",7) X="MIKE " (Added 3 spaces.) +"RTN","BMXUTL5",184,0) + ;---> Parameters: +"RTN","BMXUTL5",185,0) + ; 1 - D (req) Data to be padded. +"RTN","BMXUTL5",186,0) + ; 2 - L (req) Total length of resulting data. +"RTN","BMXUTL5",187,0) + ; 3 - C (opt) Character to pad with (default=space). +"RTN","BMXUTL5",188,0) + ; +"RTN","BMXUTL5",189,0) + Q:'$D(D) "" +"RTN","BMXUTL5",190,0) + S:'$G(L) L=$L(D) +"RTN","BMXUTL5",191,0) + S:$G(C)="" C=" " +"RTN","BMXUTL5",192,0) + Q $E(D_$$REPEAT^XLFSTR(C,L),1,L) +"RTN","BMXUTL5",193,0) + ; +"RTN","BMXUTL5",194,0) + ; +"RTN","BMXUTL5",195,0) + ;---------- +"RTN","BMXUTL5",196,0) +SP(N,C) ;EP +"RTN","BMXUTL5",197,0) + ;---> Return N spaces or other character. +"RTN","BMXUTL5",198,0) + ; Example: S X=$$SP(5)_X Pads the front of X with 5 spaces. +"RTN","BMXUTL5",199,0) + ;---> Parameters: +"RTN","BMXUTL5",200,0) + ; 1 - N (req) Number of spaces to be returned as extrinsic var. +"RTN","BMXUTL5",201,0) + ; 2 - C (opt) Character to pad with (default=space). +"RTN","BMXUTL5",202,0) + ; +"RTN","BMXUTL5",203,0) + Q:$G(N)<1 "" +"RTN","BMXUTL5",204,0) + S:$G(C)="" C=" " +"RTN","BMXUTL5",205,0) + Q $$PAD(C,N,C) +"RTN","BMXUTL5",206,0) + ; +"RTN","BMXUTL5",207,0) + ; +"RTN","BMXUTL5",208,0) + ;---------- +"RTN","BMXUTL5",209,0) +STRIP(X) ;EP +"RTN","BMXUTL5",210,0) + ;---> Strip any punctuation characters from the beginning of X, +"RTN","BMXUTL5",211,0) + ;---> including spaces. +"RTN","BMXUTL5",212,0) + ;---> Parameters: +"RTN","BMXUTL5",213,0) + ; 1 - X (req) String of characters. +"RTN","BMXUTL5",214,0) + ; +"RTN","BMXUTL5",215,0) + Q:$G(X)="" "" +"RTN","BMXUTL5",216,0) + F Q:$E(X)'?1P S X=$E(X,2,99) +"RTN","BMXUTL5",217,0) + Q X +"RTN","BMXUTL6") +0^111^B582471 +"RTN","BMXUTL6",1,0) +BMXUTL6 ; IHS/OIT/HMW - BMXNET INSTALLATION CALLS ; +"RTN","BMXUTL6",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXUTL6",3,0) + ; +"RTN","BMXUTL6",4,0) + ; +"RTN","BMXUTL6",5,0) +POST ;EP - Called from BMX Installation postinit +"RTN","BMXUTL6",6,0) + ; +"RTN","BMXUTL6",7,0) + ;Add BMX AV CODE to XUS SIGNON broker option +"RTN","BMXUTL6",8,0) + N BMXFDA,BMXIEN,BMXMSG,BMXIENS,BMXMENN,BMXAVI +"RTN","BMXUTL6",9,0) + S BMXAVI=$O(^XWB(8994,"B","BMX AV CODE",0)) +"RTN","BMXUTL6",10,0) + Q:'+BMXAVI +"RTN","BMXUTL6",11,0) + S BMXIENS=$O(^DIC(19,"B","XUS SIGNON",0)) +"RTN","BMXUTL6",12,0) + Q:'+BMXIENS +"RTN","BMXUTL6",13,0) + ; +"RTN","BMXUTL6",14,0) + S BMXIENS="?+2,"_BMXIENS_"," +"RTN","BMXUTL6",15,0) + S BMXFDA(19.05,BMXIENS,.01)=BMXAVI +"RTN","BMXUTL6",16,0) + K BMXIEN,BMXMSG +"RTN","BMXUTL6",17,0) + S DIC(0)="" +"RTN","BMXUTL6",18,0) + D UPDATE^DIE("","BMXFDA","BMXIEN","BMXMSG") +"RTN","BMXUTL6",19,0) + Q +"RTN","BMXUTL6",20,0) + ; +"RTN","BMXUTL6",21,0) + ; +"RTN","BMXUTL6",22,0) + ; +"RTN","BMXUTL6",23,0) + ;Create BMXNET,APPLICATION user and set attributes +"RTN","BMXUTL6",24,0) + ; +"RTN","BMXUTL6",25,0) + ;N BMXFDA,BMXIEN,BMXMSG,BMXIENS,BMXMENN +"RTN","BMXUTL6",26,0) + ;S BMXIENS = "?+1," +"RTN","BMXUTL6",27,0) + ;S BMXFDA(200,BMXIENS,.01)="BMXNET,APPLICATION" +"RTN","BMXUTL6",28,0) + ;S BMXFDA(200,BMXIENS,2)="1_(a>yr}:3x3ja9\8vbH" +"RTN","BMXUTL6",29,0) + ;S BMXFDA(200,BMXIENS,11)="$;HOSs|:3w25lLD}Be=" +"RTN","BMXUTL6",30,0) + ;S BMXFDA(200,BMXIENS,11.2)="88888,88888" +"RTN","BMXUTL6",31,0) + ;S BMXMENN=$O(^DIC(19,"B","BMXRPC",0)) +"RTN","BMXUTL6",32,0) + ;I +BMXMENN S BMXFDA(200.03,"?+2,?+1,",.01)=BMXMENN +"RTN","BMXUTL6",33,0) + ;K BMXIEN,BMXMSG +"RTN","BMXUTL6",34,0) + ;S DIC(0)="" +"RTN","BMXUTL6",35,0) + ;D UPDATE^DIE("","BMXFDA","BMXIEN","BMXMSG") +"RTN","BMXUTL6",36,0) + Q +"RTN","BMXUTL7") +0^117^B65930 +"RTN","BMXUTL7",1,0) +BMXUTL7 ; IHS/OIT/HMW - BMXNET INSTALLATION CALLS ; 7/25/11 9:52am +"RTN","BMXUTL7",2,0) + ;;2.31;BMX;;Jul 25, 2011;Build 16 +"RTN","BMXUTL7",3,0) + ; +"RTN","BMXUTL7",4,0) + ; +"RTN","BMXUTL7",5,0) +ENV ;EP Environment Check +"RTN","BMXUTL7",6,0) + I $G(XPDENV)=1 D +"RTN","BMXUTL7",7,0) + . S XPDDIQ("XPZ1")=0 +"RTN","BMXUTL7",8,0) + . S XPDDIQ("XPZ2")=0 +"SEC","^DIC",90093.1,90093.1,0,"AUDIT") +@ +"SEC","^DIC",90093.1,90093.1,0,"DD") +@ +"SEC","^DIC",90093.1,90093.1,0,"DEL") +@ +"SEC","^DIC",90093.1,90093.1,0,"LAYGO") +@ +"SEC","^DIC",90093.1,90093.1,0,"RD") +@ +"SEC","^DIC",90093.1,90093.1,0,"WR") +@ +"SEC","^DIC",90093.2,90093.2,0,"AUDIT") +@ +"SEC","^DIC",90093.2,90093.2,0,"DD") +@ +"SEC","^DIC",90093.2,90093.2,0,"DEL") +@ +"SEC","^DIC",90093.2,90093.2,0,"LAYGO") +@ +"SEC","^DIC",90093.2,90093.2,0,"RD") +@ +"SEC","^DIC",90093.2,90093.2,0,"WR") +@ +"SEC","^DIC",90093.5,90093.5,0,"AUDIT") +@ +"SEC","^DIC",90093.5,90093.5,0,"DD") +@ +"SEC","^DIC",90093.5,90093.5,0,"DEL") +# +"SEC","^DIC",90093.5,90093.5,0,"LAYGO") +# +"SEC","^DIC",90093.5,90093.5,0,"RD") +# +"SEC","^DIC",90093.5,90093.5,0,"WR") +# +"SEC","^DIC",90093.9,90093.9,0,"AUDIT") +@ +"SEC","^DIC",90093.9,90093.9,0,"DD") +@ +"SEC","^DIC",90093.9,90093.9,0,"DEL") +# +"SEC","^DIC",90093.9,90093.9,0,"LAYGO") +# +"SEC","^DIC",90093.9,90093.9,0,"RD") +# +"SEC","^DIC",90093.9,90093.9,0,"WR") +# +"SEC","^DIC",90093.98,90093.98,0,"AUDIT") +@ +"SEC","^DIC",90093.98,90093.98,0,"DD") +@ +"SEC","^DIC",90093.98,90093.98,0,"DEL") +@ +"SEC","^DIC",90093.98,90093.98,0,"LAYGO") +@ +"SEC","^DIC",90093.98,90093.98,0,"RD") +@ +"SEC","^DIC",90093.98,90093.98,0,"WR") +@ +"SEC","^DIC",90093.99,90093.99,0,"AUDIT") +@ +"SEC","^DIC",90093.99,90093.99,0,"DD") +@ +"SEC","^DIC",90093.99,90093.99,0,"DEL") +@ +"SEC","^DIC",90093.99,90093.99,0,"LAYGO") +@ +"SEC","^DIC",90093.99,90093.99,0,"RD") +@ +"SEC","^DIC",90093.99,90093.99,0,"WR") +@ +"VER") +8.0^22.0 +"^DD",90093.1,90093.1,0) +FIELD^^.03^3 +"^DD",90093.1,90093.1,0,"DT") +3031229 +"^DD",90093.1,90093.1,0,"IX","B",90093.1,.01) + +"^DD",90093.1,90093.1,0,"NM","BMX USER") + +"^DD",90093.1,90093.1,0,"VRPK") +BMX +"^DD",90093.1,90093.1,.01,0) +WINIDENT^RF^^0;1^K:$L(X)>30!($L(X)<3)!'(X'?1P.E) X +"^DD",90093.1,90093.1,.01,1,0) +^.1 +"^DD",90093.1,90093.1,.01,1,1,0) +90093.1^B +"^DD",90093.1,90093.1,.01,1,1,1) +S ^BMXUSER("B",$E(X,1,30),DA)="" +"^DD",90093.1,90093.1,.01,1,1,2) +K ^BMXUSER("B",$E(X,1,30),DA) +"^DD",90093.1,90093.1,.01,3) +Answer must be 3-30 characters in length. +"^DD",90093.1,90093.1,.01,"DT") +3031229 +"^DD",90093.1,90093.1,.02,0) +USER^P200'^VA(200,^0;2^Q +"^DD",90093.1,90093.1,.02,3) +Enter the User +"^DD",90093.1,90093.1,.02,"DT") +3031229 +"^DD",90093.1,90093.1,.03,0) +V ENCRYPTED^F^^0;3^K:$L(X)>30!($L(X)<1) X +"^DD",90093.1,90093.1,.03,3) +Answer must be 1-30 characters in length. +"^DD",90093.1,90093.1,.03,"DT") +3030909 +"^DD",90093.2,90093.2,0) +FIELD^^.03^3 +"^DD",90093.2,90093.2,0,"DT") +3040226 +"^DD",90093.2,90093.2,0,"IX","B",90093.2,.01) + +"^DD",90093.2,90093.2,0,"NM","BMX APPLICATION") + +"^DD",90093.2,90093.2,0,"VRPK") +BMX +"^DD",90093.2,90093.2,.01,0) +MAJOR VERSION^RF^^0;1^K:$L(X)>30!($L(X)<1)!'(X'?1P.E) X +"^DD",90093.2,90093.2,.01,1,0) +^.1 +"^DD",90093.2,90093.2,.01,1,1,0) +90093.2^B +"^DD",90093.2,90093.2,.01,1,1,1) +S ^BMXAPPL("B",$E(X,1,30),DA)="" +"^DD",90093.2,90093.2,.01,1,1,2) +K ^BMXAPPL("B",$E(X,1,30),DA) +"^DD",90093.2,90093.2,.01,3) +Answer must be 1-30 characters in length. +"^DD",90093.2,90093.2,.01,"DT") +3040226 +"^DD",90093.2,90093.2,.02,0) +MINOR VERSION^RF^^0;2^K:$L(X)>30!($L(X)<1)!'(X'?1P.E) X +"^DD",90093.2,90093.2,.02,3) +Answer must be 1-30 characters in length. +"^DD",90093.2,90093.2,.02,"DT") +3040226 +"^DD",90093.2,90093.2,.03,0) +BUILD^D^^0;3^S %DT="ETXR" D ^%DT S X=Y K:Y<1 X +"^DD",90093.2,90093.2,.03,"DT") +3040226 +"^DD",90093.5,90093.5,0) +FIELD^^.04^4 +"^DD",90093.5,90093.5,0,"DT") +3040919 +"^DD",90093.5,90093.5,0,"IX","B",90093.5,.01) + +"^DD",90093.5,90093.5,0,"NM","BMXNET MONITOR") + +"^DD",90093.5,90093.5,0,"VRPK") +BMX +"^DD",90093.5,90093.5,.01,0) +PORT^RNJ5,0^^0;1^K:+X'=X!(X>99999)!(X<1000)!(X?.E1"."1N.N) X +"^DD",90093.5,90093.5,.01,1,0) +^.1 +"^DD",90093.5,90093.5,.01,1,1,0) +90093.5^B +"^DD",90093.5,90093.5,.01,1,1,1) +S ^BMXMON("B",$E(X,1,30),DA)="" +"^DD",90093.5,90093.5,.01,1,1,2) +K ^BMXMON("B",$E(X,1,30),DA) +"^DD",90093.5,90093.5,.01,3) +Type a Number between 1000 and 99999, 0 Decimal Digits +"^DD",90093.5,90093.5,.01,"DT") +3040919 +"^DD",90093.5,90093.5,.02,0) +ENABLED^S^1:YES;0:NO;^0;2^Q +"^DD",90093.5,90093.5,.02,3) +ANSWER YES IF PORT IS ENABLED +"^DD",90093.5,90093.5,.02,21,0) +^^1^1^3040919^ +"^DD",90093.5,90093.5,.02,21,1,0) +ANSWER YES IF PORT IS ENABLED +"^DD",90093.5,90093.5,.02,"DT") +3040919 +"^DD",90093.5,90093.5,.03,0) +INTEGRATED SECURITY^S^1:YES;0:NO;^0;3^Q +"^DD",90093.5,90093.5,.03,3) +ANSWER YES IF INTEGRATED SECURITY ENABLED +"^DD",90093.5,90093.5,.03,21,0) +^^1^1^3040919^ +"^DD",90093.5,90093.5,.03,21,1,0) +ANSWER YES IF INTEGRATED SECURITY ENABLED +"^DD",90093.5,90093.5,.03,"DT") +3040919 +"^DD",90093.5,90093.5,.04,0) +SESSION NAMESPACE^F^^0;4^K:$L(X)>30!($L(X)<3) X +"^DD",90093.5,90093.5,.04,3) +Sessions will be spawned in this namespace. +"^DD",90093.5,90093.5,.04,21,0) +^^1^1^3040919^ +"^DD",90093.5,90093.5,.04,21,1,0) +Sessions will be spawned in this namespace. +"^DD",90093.5,90093.5,.04,"DT") +3040919 +"^DD",90093.9,90093.9,0) +FIELD^^1100^9 +"^DD",90093.9,90093.9,0,"DT") +3051207 +"^DD",90093.9,90093.9,0,"IX","AUSRP",90093.9,.08) + +"^DD",90093.9,90093.9,0,"IX","B",90093.9,.01) + +"^DD",90093.9,90093.9,0,"NM","BMX GUI REPORT") + +"^DD",90093.9,90093.9,0,"VRPK") +BMX +"^DD",90093.9,90093.9,.01,0) +NAME^RF^^0;1^K:$L(X)>30!($L(X)<3)!'(X'?1P.E) X +"^DD",90093.9,90093.9,.01,1,0) +^.1 +"^DD",90093.9,90093.9,.01,1,1,0) +90093.9^B +"^DD",90093.9,90093.9,.01,1,1,1) +S ^BMXGUIR("B",$E(X,1,30),DA)="" +"^DD",90093.9,90093.9,.01,1,1,2) +K ^BMXGUIR("B",$E(X,1,30),DA) +"^DD",90093.9,90093.9,.01,3) +Answer must be 3-30 characters in length. +"^DD",90093.9,90093.9,.01,"DT") +3041004 +"^DD",90093.9,90093.9,.02,0) +USER WHO REQUESTED REPORT^P200'^VA(200,^0;2^Q +"^DD",90093.9,90093.9,.02,"DT") +3041004 +"^DD",90093.9,90093.9,.03,0) +START TIME^D^^0;3^S %DT="ET" D ^%DT S X=Y K:Y<1 X +"^DD",90093.9,90093.9,.03,1,0) +^.1^^0 +"^DD",90093.9,90093.9,.03,"DT") +3050920 +"^DD",90093.9,90093.9,.04,0) +END TIME^D^^0;4^S %DT="ET" D ^%DT S X=Y K:Y<1 X +"^DD",90093.9,90093.9,.04,"DT") +3041008 +"^DD",90093.9,90093.9,.05,0) +OUTPUT TYPE^S^1:Individual Reports;2:EPI File;3:Cumulative Reports;4:Individual and Cumulative Reports;^0;5^Q +"^DD",90093.9,90093.9,.05,"DT") +3041011 +"^DD",90093.9,90093.9,.06,0) +OPTION NAME^F^^0;6^K:$L(X)>60!($L(X)<1) X +"^DD",90093.9,90093.9,.06,3) +Answer must be 1-60 characters in length. +"^DD",90093.9,90093.9,.06,"DT") +3051021 +"^DD",90093.9,90093.9,.07,0) +REPORT STATUS^S^R:RUNNING;Q:QUEUED;C:COMPLETED;^0;7^Q +"^DD",90093.9,90093.9,.07,"DT") +3050915 +"^DD",90093.9,90093.9,.08,0) +PACKAGE^P9.4'^DIC(9.4,^0;8^Q +"^DD",90093.9,90093.9,.08,1,0) +^.1 +"^DD",90093.9,90093.9,.08,1,1,0) +90093.9^AUSRP^MUMPS +"^DD",90093.9,90093.9,.08,1,1,1) +S ^BMXGUIR("AUSRP",$P(^BMXGUIR(DA,0),"^",2),X,(9999999.9999-$P(^BMXGUIR(DA,0),"^",3)),DA)="" +"^DD",90093.9,90093.9,.08,1,1,2) +K ^BMXGUIR("AUSRP",$P(^BMXGUIR(DA,0),"^",2),X,(9999999.9999-$P(^BMXGUIR(DA,0),"^",3)),DA) +"^DD",90093.9,90093.9,.08,1,1,"DT") +3051207 +"^DD",90093.9,90093.9,.08,"DT") +3051207 +"^DD",90093.9,90093.9,1100,0) +OUTPUT^90093.911^^11;0 +"^DD",90093.9,90093.911,0) +OUTPUT SUB-FIELD^^.01^1 +"^DD",90093.9,90093.911,0,"NM","OUTPUT") + +"^DD",90093.9,90093.911,0,"UP") +90093.9 +"^DD",90093.9,90093.911,.01,0) +OUTPUT^W^^0;1^Q +"^DD",90093.9,90093.911,.01,"DT") +3041004 +"^DD",90093.98,90093.98,0) +FIELD^^1^4 +"^DD",90093.98,90093.98,0,"DT") +3050622 +"^DD",90093.98,90093.98,0,"IX","B",90093.98,.01) + +"^DD",90093.98,90093.98,0,"NM","BMX ADO LOG") + +"^DD",90093.98,90093.98,0,"VRPK") +BMX +"^DD",90093.98,90093.98,.01,0) +TRANSACTION TIMESTAMP^RD^^0;1^S %DT="ESTXR" D ^%DT S X=Y K:Y<1 X +"^DD",90093.98,90093.98,.01,1,0) +^.1 +"^DD",90093.98,90093.98,.01,1,1,0) +90093.98^B +"^DD",90093.98,90093.98,.01,1,1,1) +S ^BMXADOL("B",$E(X,1,30),DA)="" +"^DD",90093.98,90093.98,.01,1,1,2) +K ^BMXADOL("B",$E(X,1,30),DA) +"^DD",90093.98,90093.98,.01,3) + +"^DD",90093.98,90093.98,.01,"DT") +3050622 +"^DD",90093.98,90093.98,.02,0) +FILE NUMBER^F^^0;2^K:$L(X)>20!($L(X)<1) X +"^DD",90093.98,90093.98,.02,3) +Answer must be 1-20 characters in length. +"^DD",90093.98,90093.98,.02,"DT") +3050622 +"^DD",90093.98,90093.98,.03,0) +DAS^F^^0;3^K:$L(X)>30!($L(X)<1) X +"^DD",90093.98,90093.98,.03,3) +Answer must be 1-30 characters in length. +"^DD",90093.98,90093.98,.03,"DT") +3050622 +"^DD",90093.98,90093.98,1,0) +DATA^90093.981^^1;0 +"^DD",90093.98,90093.981,0) +DATA SUB-FIELD^^.01^1 +"^DD",90093.98,90093.981,0,"DT") +3050622 +"^DD",90093.98,90093.981,0,"NM","DATA") + +"^DD",90093.98,90093.981,0,"UP") +90093.98 +"^DD",90093.98,90093.981,.01,0) +DATA^W^^0;1^Q +"^DD",90093.98,90093.981,.01,"DT") +3050622 +"^DD",90093.99,90093.99,0) +FIELD^^2^5 +"^DD",90093.99,90093.99,0,"DT") +3040908 +"^DD",90093.99,90093.99,0,"IX","B",90093.99,.01) + +"^DD",90093.99,90093.99,0,"NM","BMX ADO SCHEMA") + +"^DD",90093.99,90093.99,0,"PT",19707.44,.03) + +"^DD",90093.99,90093.99,0,"PT",19707.46,.02) + +"^DD",90093.99,90093.99,0,"PT",19707.48,.01) + +"^DD",90093.99,90093.99,0,"PT",91707.49,.01) + +"^DD",90093.99,90093.99,0,"VRPK") +BMX +"^DD",90093.99,90093.99,.01,0) +SCHEMA NAME^RF^^0;1^K:$L(X)>30!(X?.N)!($L(X)<3)!'(X'?1P.E) X +"^DD",90093.99,90093.99,.01,1,0) +^.1 +"^DD",90093.99,90093.99,.01,1,1,0) +90093.99^B +"^DD",90093.99,90093.99,.01,1,1,1) +S ^BMXADO("B",$E(X,1,30),DA)="" +"^DD",90093.99,90093.99,.01,1,1,2) +K ^BMXADO("B",$E(X,1,30),DA) +"^DD",90093.99,90093.99,.01,3) +NAME MUST BE 3-30 CHARACTERS, NOT NUMERIC OR STARTING WITH PUNCTUATION +"^DD",90093.99,90093.99,.02,0) +FILE OR SUBFILE NUMBER^NJ22,9^^0;2^K:+X'=X!(X>999999999999)!(X<0)!(X?.E1"."10N.N) X +"^DD",90093.99,90093.99,.02,3) +Type a Number between 0 and 999999999999, 9 Decimal Digits +"^DD",90093.99,90093.99,.02,"DT") +3040414 +"^DD",90093.99,90093.99,.03,0) +DATASET IS READ ONLY^S^1:YES;0:NO;^0;3^Q +"^DD",90093.99,90093.99,.03,"DT") +3040420 +"^DD",90093.99,90093.99,1,0) +FIELD NUMBER^90093.991^^1;0 +"^DD",90093.99,90093.99,2,0) +VIEW^90093.992^^2;0 +"^DD",90093.99,90093.991,0) +FIELD NUMBER SUB-FIELD^^3^12 +"^DD",90093.99,90093.991,0,"DT") +3040707 +"^DD",90093.99,90093.991,0,"IX","B",90093.991,.01) + +"^DD",90093.99,90093.991,0,"NM","FIELD NUMBER") + +"^DD",90093.99,90093.991,0,"UP") +90093.99 +"^DD",90093.99,90093.991,.01,0) +FIELD NUMBER^MF^^0;1^K:$L(X)>30!($L(X)<1) X +"^DD",90093.99,90093.991,.01,1,0) +^.1 +"^DD",90093.99,90093.991,.01,1,1,0) +90093.991^B +"^DD",90093.99,90093.991,.01,1,1,1) +S ^BMXADO(DA(1),1,"B",$E(X,1,30),DA)="" +"^DD",90093.99,90093.991,.01,1,1,2) +K ^BMXADO(DA(1),1,"B",$E(X,1,30),DA) +"^DD",90093.99,90093.991,.01,3) +Answer must be 1-30 characters in length. +"^DD",90093.99,90093.991,.01,"DT") +3040528 +"^DD",90093.99,90093.991,.02,0) +DATA TYPE^S^T:TEXT;D:DATE;I:INTEGER;N:NUMBER;^0;2^Q +"^DD",90093.99,90093.991,.02,"DT") +3040413 +"^DD",90093.99,90093.991,.03,0) +FIELD LENGTH^F^^0;3^K:$L(X)>5!($L(X)<1) X +"^DD",90093.99,90093.991,.03,3) +Answer must be 1-5 characters in length. +"^DD",90093.99,90093.991,.03,"DT") +3040413 +"^DD",90093.99,90093.991,.04,0) +COLUMN HEADER^F^^0;4^K:$L(X)>30!($L(X)<1) X +"^DD",90093.99,90093.991,.04,3) +Answer must be 1-30 characters in length. +"^DD",90093.99,90093.991,.04,"DT") +3040413 +"^DD",90093.99,90093.991,.05,0) +READ ONLY^S^1:YES;0:NO;^0;5^Q +"^DD",90093.99,90093.991,.05,"DT") +3040413 +"^DD",90093.99,90093.991,.06,0) +KEY FIELD^S^1:YES;0:NO;^0;6^Q +"^DD",90093.99,90093.991,.06,"DT") +3040413 +"^DD",90093.99,90093.991,.07,0) +NULL ALLOWED^S^1:YES;0:NO;^0;7^Q +"^DD",90093.99,90093.991,.07,"DT") +3040413 +"^DD",90093.99,90093.991,.08,0) +IEN AUTOMATICALLY INCLUDED^S^1:YES;0:NO;^0;8^Q +"^DD",90093.99,90093.991,.08,21,0) +^^6^6^3040528^ +"^DD",90093.99,90093.991,.08,21,1,0) +IF THIS IS 'YES', AN 'UPDATE' FIELD WILL AUTOMATTICALLY BE ADDED TO +"^DD",90093.99,90093.991,.08,21,2,0) +THE SCHEMA. THE FIELD'S VALUE IS 'WRITE ONLY', IE IF THE USER SEES AND +"^DD",90093.99,90093.991,.08,21,3,0) +SELECTS A RESOLVED POINTER VALUE, THIS FIELD'S VALUE WILL BE USED TO +"^DD",90093.99,90093.991,.08,21,4,0) +UPDATE RPMS. THE UPDATE FIELD'S VALUE WILL ALWAYS BE `IEN. THE EBCU +"^DD",90093.99,90093.991,.08,21,5,0) +WILL AUTOMATICALLY USE THIS VALUE RATHER THAN THE RESOLVED POINTER +"^DD",90093.99,90093.991,.08,21,6,0) +VALUE TO UPDATE FILEMAN. +"^DD",90093.99,90093.991,.08,"DT") +3040528 +"^DD",90093.99,90093.991,.09,0) +ALWAYS GET INTERNAL VALUE^S^1:YES;0:NO;^0;9^Q +"^DD",90093.99,90093.991,.09,"DT") +3040528 +"^DD",90093.99,90093.991,1,0) +AUTO IDENTIFIER EXTR FUNCT^F^^1;E1,240^K:$L(X)>19!($L(X)<3) X +"^DD",90093.99,90093.991,1,3) +Answer must be 3-19 characters in length. +"^DD",90093.99,90093.991,1,21,0) +^^3^3^3040528^ +"^DD",90093.99,90093.991,1,21,1,0) +IF THIS EXTRINSIC FUNCTION IS DEFINED (EG TAG^ROUTINE), THEN A DISPLAY ONLY +"^DD",90093.99,90093.991,1,21,2,0) +FIELD WILL BE INCLUDED IN THE SCHEMA THAT CONTAINS IDENTIFIERS (OR OTHER +"^DD",90093.99,90093.991,1,21,3,0) +INFO) GENERATED BY THE EXTRINSIC FUNCTION - ID=$$TAG^ROUTINE(DA) +"^DD",90093.99,90093.991,1,"DT") +3040528 +"^DD",90093.99,90093.991,2,0) +SPECIAL UPDATE EP^F^^2;E1,245^K:$L(X)>19!($L(X)<3) X +"^DD",90093.99,90093.991,2,3) +Answer must be 3-19 characters in length. +"^DD",90093.99,90093.991,2,21,0) +^^2^2^3040528^ +"^DD",90093.99,90093.991,2,21,1,0) +IF THE EP EXISTS(EG TAG^ROUTINE), THIS SPECIAL CODE WILL BE USED TO +"^DD",90093.99,90093.991,2,21,2,0) +UPDATE FILEMAN AND THE EBCU'S STD UPDATE MECHANISM WILL BE BYPASSED. +"^DD",90093.99,90093.991,2,"DT") +3040528 +"^DD",90093.99,90093.991,3,0) +EXTR FUNCT FOR TRIGGERED VALUE^F^^3;E1,245^K:$L(X)>240!($L(X)<1) X +"^DD",90093.99,90093.991,3,3) +Answer must be 1-240 characters in length. +"^DD",90093.99,90093.991,3,"DT") +3040707 +"^DD",90093.99,90093.992,0) +VIEW SUB-FIELD^^3^4 +"^DD",90093.99,90093.992,0,"DT") +3040414 +"^DD",90093.99,90093.992,0,"IX","B",90093.992,.01) + +"^DD",90093.99,90093.992,0,"NM","VIEW") + +"^DD",90093.99,90093.992,0,"UP") +90093.99 +"^DD",90093.99,90093.992,.01,0) +VIEW^MF^^0;1^K:$L(X)>30!($L(X)<1) X +"^DD",90093.99,90093.992,.01,1,0) +^.1 +"^DD",90093.99,90093.992,.01,1,1,0) +90093.992^B +"^DD",90093.99,90093.992,.01,1,1,1) +S ^BMXADO(DA(1),2,"B",$E(X,1,30),DA)="" +"^DD",90093.99,90093.992,.01,1,1,2) +K ^BMXADO(DA(1),2,"B",$E(X,1,30),DA) +"^DD",90093.99,90093.992,.01,3) +Answer must be 1-30 characters in length. +"^DD",90093.99,90093.992,.01,21,0) +^^1^1^3040413^ +"^DD",90093.99,90093.992,.01,21,1,0) +Entry points for clooecting data as well as headers +"^DD",90093.99,90093.992,.01,"DT") +3040413 +"^DD",90093.99,90093.992,1,0) +ENTRY POINT^F^^1;E1,240^K:$L(X)>20!($L(X)<1) X +"^DD",90093.99,90093.992,1,3) +Answer must be 1-20 characters in length. +"^DD",90093.99,90093.992,1,"DT") +3040413 +"^DD",90093.99,90093.992,2,0) +PARAMETER^90093.9922^^2;0 +"^DD",90093.99,90093.992,3,0) +DESCRIPTION^90093.9923^^3;0 +"^DD",90093.99,90093.9922,0) +PARAMETER SUB-FIELD^^.02^2 +"^DD",90093.99,90093.9922,0,"DT") +3040413 +"^DD",90093.99,90093.9922,0,"IX","B",90093.9922,.01) + +"^DD",90093.99,90093.9922,0,"NM","PARAMETER") + +"^DD",90093.99,90093.9922,0,"UP") +90093.992 +"^DD",90093.99,90093.9922,.01,0) +PARAMETER^MF^^0;1^K:$L(X)>30!($L(X)<1) X +"^DD",90093.99,90093.9922,.01,1,0) +^.1 +"^DD",90093.99,90093.9922,.01,1,1,0) +90093.9922^B +"^DD",90093.99,90093.9922,.01,1,1,1) +S ^BMXADO(DA(2),2,DA(1),2,"B",$E(X,1,30),DA)="" +"^DD",90093.99,90093.9922,.01,1,1,2) +K ^BMXADO(DA(2),2,DA(1),2,"B",$E(X,1,30),DA) +"^DD",90093.99,90093.9922,.01,3) +Answer must be 1-30 characters in length. +"^DD",90093.99,90093.9922,.01,"DT") +3040413 +"^DD",90093.99,90093.9922,.02,0) +BRIEF DESCRIPTION^F^^0;2^K:$L(X)>200!($L(X)<1) X +"^DD",90093.99,90093.9922,.02,3) +Answer must be 1-200 characters in length. +"^DD",90093.99,90093.9922,.02,"DT") +3040413 +"^DD",90093.99,90093.9923,0) +DESCRIPTION SUB-FIELD^^.01^1 +"^DD",90093.99,90093.9923,0,"DT") +3040414 +"^DD",90093.99,90093.9923,0,"NM","DESCRIPTION") + +"^DD",90093.99,90093.9923,0,"UP") +90093.992 +"^DD",90093.99,90093.9923,.01,0) +DESCRIPTION^W^^0;1^Q +"^DD",90093.99,90093.9923,.01,"DT") +3040414 +"^DIC",90093.1,90093.1,0) +BMX USER^90093.1 +"^DIC",90093.1,90093.1,0,"GL") +^BMXUSER( +"^DIC",90093.1,"B","BMX USER",90093.1) + +"^DIC",90093.2,90093.2,0) +BMX APPLICATION^90093.2 +"^DIC",90093.2,90093.2,0,"GL") +^BMXAPPL( +"^DIC",90093.2,"B","BMX APPLICATION",90093.2) + +"^DIC",90093.5,90093.5,0) +BMXNET MONITOR^90093.5 +"^DIC",90093.5,90093.5,0,"GL") +^BMXMON( +"^DIC",90093.5,"B","BMXNET MONITOR",90093.5) + +"^DIC",90093.9,90093.9,0) +BMX GUI REPORT^90093.9 +"^DIC",90093.9,90093.9,0,"GL") +^BMXGUIR( +"^DIC",90093.9,"B","BMX GUI REPORT",90093.9) + +"^DIC",90093.98,90093.98,0) +BMX ADO LOG^90093.98D +"^DIC",90093.98,90093.98,0,"GL") +^BMXADOL( +"^DIC",90093.98,"B","BMX ADO LOG",90093.98) + +"^DIC",90093.99,90093.99,0) +BMX ADO SCHEMA^90093.99 +"^DIC",90093.99,90093.99,0,"GL") +^BMXADO( +"^DIC",90093.99,"B","BMX ADO SCHEMA",90093.99) + +**END** +**END**